LR_52_P427.KIDs

KIDS Distribution saved on Aug 19, 2013@17:17:24
LR427 AND LA80
**KIDS**:LR*5.2*427^LA*5.2*80^

**INSTALL NAME**
LR*5.2*427
"BLD",7488,0)
LR*5.2*427^LAB SERVICE^0^3130819^y
"BLD",7488,4,0)
^9.64PA^63^4
"BLD",7488,4,61,0)
61
"BLD",7488,4,61,2,0)
^9.641^61^1
"BLD",7488,4,61,2,61,0)
TOPOGRAPHY FIELD  (File-top level)
"BLD",7488,4,61,2,61,1,0)
^9.6411^.01^1
"BLD",7488,4,61,2,61,1,.01,0)
NAME
"BLD",7488,4,61,222)
y^n^p^^^^n^^n
"BLD",7488,4,61,224)

"BLD",7488,4,61.2,0)
61.2
"BLD",7488,4,61.2,2,0)
^9.641^61.2^1
"BLD",7488,4,61.2,2,61.2,0)
ETIOLOGY FIELD  (File-top level)
"BLD",7488,4,61.2,2,61.2,1,0)
^9.6411^.01^1
"BLD",7488,4,61.2,2,61.2,1,.01,0)
NAME
"BLD",7488,4,61.2,222)
y^n^p^^^^n^^n
"BLD",7488,4,61.2,224)

"BLD",7488,4,62,0)
62
"BLD",7488,4,62,2,0)
^9.641^62^1
"BLD",7488,4,62,2,62,0)
COLLECTION SAMPLE  (File-top level)
"BLD",7488,4,62,2,62,1,0)
^9.6411^.01^1
"BLD",7488,4,62,2,62,1,.01,0)
NAME
"BLD",7488,4,62,222)
y^n^p^^^^n^^n
"BLD",7488,4,62,224)

"BLD",7488,4,63,0)
63
"BLD",7488,4,63,2,0)
^9.641^63.37^1
"BLD",7488,4,63,2,63.37,0)
FUNGUS/YEAST  (sub-file)
"BLD",7488,4,63,2,63.37,1,0)
^9.6411^.01^1
"BLD",7488,4,63,2,63.37,1,.01,0)
FUNGUS/YEAST
"BLD",7488,4,63,222)
y^n^p^^^^n^^n
"BLD",7488,4,63,224)

"BLD",7488,4,"APDD",61,61)

"BLD",7488,4,"APDD",61,61,.01)

"BLD",7488,4,"APDD",61.2,61.2)

"BLD",7488,4,"APDD",61.2,61.2,.01)

"BLD",7488,4,"APDD",62,62)

"BLD",7488,4,"APDD",62,62,.01)

"BLD",7488,4,"APDD",63,63.37)

"BLD",7488,4,"APDD",63,63.37,.01)

"BLD",7488,4,"B",61,61)

"BLD",7488,4,"B",61.2,61.2)

"BLD",7488,4,"B",62,62)

"BLD",7488,4,"B",63,63)

"BLD",7488,6.3)
33
"BLD",7488,"ABPKG")
n
"BLD",7488,"KRN",0)
^9.67PA^779.2^20
"BLD",7488,"KRN",.4,0)
.4
"BLD",7488,"KRN",.401,0)
.401
"BLD",7488,"KRN",.402,0)
.402
"BLD",7488,"KRN",.403,0)
.403
"BLD",7488,"KRN",.5,0)
.5
"BLD",7488,"KRN",.84,0)
.84
"BLD",7488,"KRN",3.6,0)
3.6
"BLD",7488,"KRN",3.8,0)
3.8
"BLD",7488,"KRN",9.2,0)
9.2
"BLD",7488,"KRN",9.8,0)
9.8
"BLD",7488,"KRN",9.8,"NM",0)
^9.68A^47^44
"BLD",7488,"KRN",9.8,"NM",1,0)
LRAPLG1^^0^B165428544
"BLD",7488,"KRN",9.8,"NM",2,0)
LRWLST1^^0^B81654382
"BLD",7488,"KRN",9.8,"NM",3,0)
LRAPBR^^0^B6460203
"BLD",7488,"KRN",9.8,"NM",4,0)
LRAPBR1^^0^B133054463
"BLD",7488,"KRN",9.8,"NM",5,0)
LRMIPLOG^^0^B3619644
"BLD",7488,"KRN",9.8,"NM",6,0)
LRVRMI2A^^0^B78174930
"BLD",7488,"KRN",9.8,"NM",7,0)
LRVRMI3^^0^B26579796
"BLD",7488,"KRN",9.8,"NM",8,0)
LRVRMI4^^0^B38736850
"BLD",7488,"KRN",9.8,"NM",9,0)
LRVRMI4A^^0^B96274363
"BLD",7488,"KRN",9.8,"NM",10,0)
LRVRMI2^^0^B35719383
"BLD",7488,"KRN",9.8,"NM",11,0)
LRWU9^^0^B186697780
"BLD",7488,"KRN",9.8,"NM",12,0)
LRLIST^^0^B49008370
"BLD",7488,"KRN",9.8,"NM",13,0)
LRPHSET2^^0^B27649309
"BLD",7488,"KRN",9.8,"NM",14,0)
LRMIVER1^^0^B15654594
"BLD",7488,"KRN",9.8,"NM",15,0)
LRSCTF1^^0^B9071625
"BLD",7488,"KRN",9.8,"NM",17,0)
LRMIPSZ3^^0^B29744803
"BLD",7488,"KRN",9.8,"NM",18,0)
LRVRAP4^^0^B35152791
"BLD",7488,"KRN",9.8,"NM",19,0)
LRRMM^^0^B37494738
"BLD",7488,"KRN",9.8,"NM",21,0)
LRAPPOW^^0^B8842650
"BLD",7488,"KRN",9.8,"NM",22,0)
LRAPBRPW^^0^B10229143
"BLD",7488,"KRN",9.8,"NM",23,0)
LR7OSUM3^^0^B15593166
"BLD",7488,"KRN",9.8,"NM",24,0)
LR7OSUM5^^0^B50074363
"BLD",7488,"KRN",9.8,"NM",25,0)
LRMIUT1^^0^B6714557
"BLD",7488,"KRN",9.8,"NM",26,0)
LRAPBK^^0^B73747615
"BLD",7488,"KRN",9.8,"NM",27,0)
LRMISTF1^^0^B41353920
"BLD",7488,"KRN",9.8,"NM",28,0)
LRMINEW1^^0^B8232594
"BLD",7488,"KRN",9.8,"NM",29,0)
LRMIEDZ2^^0^B69802337
"BLD",7488,"KRN",9.8,"NM",30,0)
LRMIPSZ2^^0^B37459030
"BLD",7488,"KRN",9.8,"NM",31,0)
LR7ORB3^^0^B97650234
"BLD",7488,"KRN",9.8,"NM",32,0)
LRRPL^^0^B139621090
"BLD",7488,"KRN",9.8,"NM",33,0)
LRRPLU^^0^B285265973
"BLD",7488,"KRN",9.8,"NM",34,0)
LR7OR1^^0^B35364190
"BLD",7488,"KRN",9.8,"NM",35,0)
LR7OSMZ2^^0^B47170390
"BLD",7488,"KRN",9.8,"NM",36,0)
LR7OSAP^^0^B68882961
"BLD",7488,"KRN",9.8,"NM",37,0)
LRAPCUM^^0^B22712242
"BLD",7488,"KRN",9.8,"NM",38,0)
LRSPRPTA^^0^B14810851
"BLD",7488,"KRN",9.8,"NM",39,0)
LR7OSUM1^^0^B87418148
"BLD",7488,"KRN",9.8,"NM",40,0)
LRVR0^^0^B127185317
"BLD",7488,"KRN",9.8,"NM",41,0)
LRAPED^^0^B32844009
"BLD",7488,"KRN",9.8,"NM",42,0)
LRAPRES^^0^B184608349
"BLD",7488,"KRN",9.8,"NM",43,0)
LRUDEL^^0^B24276751
"BLD",7488,"KRN",9.8,"NM",44,0)
LRVRMI1A^^0^B12793155
"BLD",7488,"KRN",9.8,"NM",46,0)
LRORDK^^0^B16287441
"BLD",7488,"KRN",9.8,"NM",47,0)
LRWLST12^^0^B67054395
"BLD",7488,"KRN",9.8,"NM","B","LR7OR1",34)

"BLD",7488,"KRN",9.8,"NM","B","LR7ORB3",31)

"BLD",7488,"KRN",9.8,"NM","B","LR7OSAP",36)

"BLD",7488,"KRN",9.8,"NM","B","LR7OSMZ2",35)

"BLD",7488,"KRN",9.8,"NM","B","LR7OSUM1",39)

"BLD",7488,"KRN",9.8,"NM","B","LR7OSUM3",23)

"BLD",7488,"KRN",9.8,"NM","B","LR7OSUM5",24)

"BLD",7488,"KRN",9.8,"NM","B","LRAPBK",26)

"BLD",7488,"KRN",9.8,"NM","B","LRAPBR",3)

"BLD",7488,"KRN",9.8,"NM","B","LRAPBR1",4)

"BLD",7488,"KRN",9.8,"NM","B","LRAPBRPW",22)

"BLD",7488,"KRN",9.8,"NM","B","LRAPCUM",37)

"BLD",7488,"KRN",9.8,"NM","B","LRAPED",41)

"BLD",7488,"KRN",9.8,"NM","B","LRAPLG1",1)

"BLD",7488,"KRN",9.8,"NM","B","LRAPPOW",21)

"BLD",7488,"KRN",9.8,"NM","B","LRAPRES",42)

"BLD",7488,"KRN",9.8,"NM","B","LRLIST",12)

"BLD",7488,"KRN",9.8,"NM","B","LRMIEDZ2",29)

"BLD",7488,"KRN",9.8,"NM","B","LRMINEW1",28)

"BLD",7488,"KRN",9.8,"NM","B","LRMIPLOG",5)

"BLD",7488,"KRN",9.8,"NM","B","LRMIPSZ2",30)

"BLD",7488,"KRN",9.8,"NM","B","LRMIPSZ3",17)

"BLD",7488,"KRN",9.8,"NM","B","LRMISTF1",27)

"BLD",7488,"KRN",9.8,"NM","B","LRMIUT1",25)

"BLD",7488,"KRN",9.8,"NM","B","LRMIVER1",14)

"BLD",7488,"KRN",9.8,"NM","B","LRORDK",46)

"BLD",7488,"KRN",9.8,"NM","B","LRPHSET2",13)

"BLD",7488,"KRN",9.8,"NM","B","LRRMM",19)

"BLD",7488,"KRN",9.8,"NM","B","LRRPL",32)

"BLD",7488,"KRN",9.8,"NM","B","LRRPLU",33)

"BLD",7488,"KRN",9.8,"NM","B","LRSCTF1",15)

"BLD",7488,"KRN",9.8,"NM","B","LRSPRPTA",38)

"BLD",7488,"KRN",9.8,"NM","B","LRUDEL",43)

"BLD",7488,"KRN",9.8,"NM","B","LRVR0",40)

"BLD",7488,"KRN",9.8,"NM","B","LRVRAP4",18)

"BLD",7488,"KRN",9.8,"NM","B","LRVRMI1A",44)

"BLD",7488,"KRN",9.8,"NM","B","LRVRMI2",10)

"BLD",7488,"KRN",9.8,"NM","B","LRVRMI2A",6)

"BLD",7488,"KRN",9.8,"NM","B","LRVRMI3",7)

"BLD",7488,"KRN",9.8,"NM","B","LRVRMI4",8)

"BLD",7488,"KRN",9.8,"NM","B","LRVRMI4A",9)

"BLD",7488,"KRN",9.8,"NM","B","LRWLST1",2)

"BLD",7488,"KRN",9.8,"NM","B","LRWLST12",47)

"BLD",7488,"KRN",9.8,"NM","B","LRWU9",11)

"BLD",7488,"KRN",19,0)
19
"BLD",7488,"KRN",19,"NM",0)
^9.68A^2^2
"BLD",7488,"KRN",19,"NM",1,0)
LRAP VR^^0
"BLD",7488,"KRN",19,"NM",2,0)
LRAPAFIP^^3
"BLD",7488,"KRN",19,"NM","B","LRAP VR",1)

"BLD",7488,"KRN",19,"NM","B","LRAPAFIP",2)

"BLD",7488,"KRN",19.1,0)
19.1
"BLD",7488,"KRN",101,0)
101
"BLD",7488,"KRN",409.61,0)
409.61
"BLD",7488,"KRN",771,0)
771
"BLD",7488,"KRN",779.2,0)
779.2
"BLD",7488,"KRN",870,0)
870
"BLD",7488,"KRN",8989.51,0)
8989.51
"BLD",7488,"KRN",8989.51,"NM",0)
^9.68A^1^1
"BLD",7488,"KRN",8989.51,"NM",1,0)
LR AP DEFAULT ACCESSION NUMBER^^0
"BLD",7488,"KRN",8989.51,"NM","B","LR AP DEFAULT ACCESSION NUMBER",1)

"BLD",7488,"KRN",8989.52,0)
8989.52
"BLD",7488,"KRN",8989.52,"NM",0)
^9.68A^1^1
"BLD",7488,"KRN",8989.52,"NM",1,0)
LR PKG^^0
"BLD",7488,"KRN",8989.52,"NM","B","LR PKG",1)

"BLD",7488,"KRN",8994,0)
8994
"BLD",7488,"KRN","B",.4,.4)

"BLD",7488,"KRN","B",.401,.401)

"BLD",7488,"KRN","B",.402,.402)

"BLD",7488,"KRN","B",.403,.403)

"BLD",7488,"KRN","B",.5,.5)

"BLD",7488,"KRN","B",.84,.84)

"BLD",7488,"KRN","B",3.6,3.6)

"BLD",7488,"KRN","B",3.8,3.8)

"BLD",7488,"KRN","B",9.2,9.2)

"BLD",7488,"KRN","B",9.8,9.8)

"BLD",7488,"KRN","B",19,19)

"BLD",7488,"KRN","B",19.1,19.1)

"BLD",7488,"KRN","B",101,101)

"BLD",7488,"KRN","B",409.61,409.61)

"BLD",7488,"KRN","B",771,771)

"BLD",7488,"KRN","B",779.2,779.2)

"BLD",7488,"KRN","B",870,870)

"BLD",7488,"KRN","B",8989.51,8989.51)

"BLD",7488,"KRN","B",8989.52,8989.52)

"BLD",7488,"KRN","B",8994,8994)

"BLD",7488,"QUES",0)
^9.62^^
"BLD",7488,"REQB",0)
^9.611^1^1
"BLD",7488,"REQB",1,0)
LR*5.2*350^2
"BLD",7488,"REQB","B","LR*5.2*350",1)

"FIA",61)
TOPOGRAPHY FIELD
"FIA",61,0)
^LAB(61,
"FIA",61,0,0)
61I
"FIA",61,0,1)
y^n^p^^^^n^^n
"FIA",61,0,10)

"FIA",61,0,11)

"FIA",61,0,"RLRO")

"FIA",61,0,"VR")
5.2^LR
"FIA",61,61)
1
"FIA",61,61,.01)

"FIA",61.2)
ETIOLOGY FIELD
"FIA",61.2,0)
^LAB(61.2,
"FIA",61.2,0,0)
61.2Is
"FIA",61.2,0,1)
y^n^p^^^^n^^n
"FIA",61.2,0,10)

"FIA",61.2,0,11)

"FIA",61.2,0,"RLRO")

"FIA",61.2,0,"VR")
5.2^LR
"FIA",61.2,61.2)
1
"FIA",61.2,61.2,.01)

"FIA",62)
COLLECTION SAMPLE
"FIA",62,0)
^LAB(62,
"FIA",62,0,0)
62I
"FIA",62,0,1)
y^n^p^^^^n^^n
"FIA",62,0,10)

"FIA",62,0,11)

"FIA",62,0,"RLRO")

"FIA",62,0,"VR")
5.2^LR
"FIA",62,62)
1
"FIA",62,62,.01)

"FIA",63)
LAB DATA
"FIA",63,0)
^LR(
"FIA",63,0,0)
63
"FIA",63,0,1)
y^n^p^^^^n^^n
"FIA",63,0,10)

"FIA",63,0,11)

"FIA",63,0,"RLRO")

"FIA",63,0,"VR")
5.2^LR
"FIA",63,63)
1
"FIA",63,63.05)
1
"FIA",63,63.05,20)

"FIA",63,63.37)
1
"FIA",63,63.37,.01)

"IX",61,61,"AERT",0)
61^AERT^Send ERT alert if needed.^MU^^R^^I^61^^^^^A
"IX",61,61,"AERT",.1,0)
^^2^2^3090609^
"IX",61,61,"AERT",.1,1,0)
Action cross reference for sending ERT alerts when an entry is added or 
"IX",61,61,"AERT",.1,2,0)
modified.
"IX",61,61,"AERT",1)
D TASK^LRERT1(61,DA)
"IX",61,61,"AERT",1.4)
S X=$S('$D(LRFMERTS):1,1:0)
"IX",61,61,"AERT",2)
Q
"IX",61,61,"AERT",2.4)
S X=0
"IX",61,61,"AERT",11.1,0)
^.114IA^2^2
"IX",61,61,"AERT",11.1,1,0)
1^F^61^.01^^^F
"IX",61,61,"AERT",11.1,2,0)
2^F^61^20^^^F
"IX",61.2,61.2,"AERT",0)
61.2^AERT^Send ERT alert if needed.^MU^^R^^I^61.2^^^^^A
"IX",61.2,61.2,"AERT",.1,0)
^^3^3^3080215^^^
"IX",61.2,61.2,"AERT",.1,1,0)
Action cross reference for sending ERT alerts when an entry is added or 
"IX",61.2,61.2,"AERT",.1,2,0)
modified.
"IX",61.2,61.2,"AERT",.1,3,0)

"IX",61.2,61.2,"AERT",1)
D TASK^LRERT1(61.2,DA)
"IX",61.2,61.2,"AERT",1.4)
S X=$S('$D(LRFMERTS):1,1:0)
"IX",61.2,61.2,"AERT",2)
Q
"IX",61.2,61.2,"AERT",2.4)
S X=0
"IX",61.2,61.2,"AERT",11.1,0)
^.114IA^2^2
"IX",61.2,61.2,"AERT",11.1,1,0)
1^F^61.2^.01^^^F
"IX",61.2,61.2,"AERT",11.1,2,0)
2^F^61.2^20^^^F
"IX",62,62,"AERT",0)
62^AERT^Send ERT alert if needed.^MU^^R^^I^62^^^^^A
"IX",62,62,"AERT",.1,0)
^^2^2^3090112^^^
"IX",62,62,"AERT",.1,1,0)
Action cross reference for sending ERT alerts when an entry is added or 
"IX",62,62,"AERT",.1,2,0)
modified.
"IX",62,62,"AERT",1)
D TASK^LRERT1(62,DA)
"IX",62,62,"AERT",1.4)
S X=$S('$D(LRFMERTS):1,1:0)
"IX",62,62,"AERT",2)
Q
"IX",62,62,"AERT",2.4)
S X=0
"IX",62,62,"AERT",11.1,0)
^.114IA^2^2
"IX",62,62,"AERT",11.1,1,0)
1^F^62^.01^^^F
"IX",62,62,"AERT",11.1,2,0)
2^F^62^20^^^F
"IX",63,63.37,"AD",0)
63.37^AD^Create ISOLATE ID on .01 entry^MU^^F^IR^I^63.37^^^^^A
"IX",63,63.37,"AD",1)
D SETISOID^LRXREF(9)
"IX",63,63.37,"AD",2)
Q
"IX",63,63.37,"AD",11.1,0)
^.114IA^1^1
"IX",63,63.37,"AD",11.1,1,0)
1^F^63.37^.01^^1^F
"IX",63,63.37,"AD",11.1,1,3)

"KRN",19,8074,-1)
3^2
"KRN",19,8074,0)
LRAPAFIP^JPC registries^^M^^^^^^^^
"KRN",19,8074,1,0)
^^1^1^3130129^
"KRN",19,8074,1,1,0)
List of JPC registries.
"KRN",19,8074,10,0)
^19.01PI^2^2
"KRN",19,8074,99)
61235,57695
"KRN",19,8074,"U")
JPC REGISTRIES
"KRN",19,14482,-1)
0^1
"KRN",19,14482,0)
LRAP VR^AP LEDI Data Entry^^R^^^^^^^^LAB SERVICE
"KRN",19,14482,1,0)
^^3^3^3130124^
"KRN",19,14482,1,1,0)
Data from an automated instrument for Anatomic Pathology (LEDI results)
"KRN",19,14482,1,2,0)
can be reviewed and approved individually by accession or by UID. Once
"KRN",19,14482,1,3,0)
approved, the data is not available for viewing with this option.  
"KRN",19,14482,25)
LRVR
"KRN",19,14482,"U")
AP LEDI DATA ENTRY
"KRN",8989.51,19,0)
LR IGNORE HOLIDAYS^Lab Collects on Holidays^^^IGNORE HOLIDAYS
"KRN",8989.51,19,1)
Y^^Enter 'Yes' if full lab service operates on federal holidays.
"KRN",8989.51,19,20,0)
^^2^2^2950816^
"KRN",8989.51,19,20,1,0)
This indicates if this institution operates at full service during
"KRN",8989.51,19,20,2,0)
federal holidays.
"KRN",8989.51,19,30,0)
^8989.513I^2^2
"KRN",8989.51,19,30,1,0)
1^4.2
"KRN",8989.51,19,30,2,0)
2^9.4
"KRN",8989.51,20,0)
LR MAX DAYS CONTINUOUS^Maximum Days for Continuous Orders^^^MAXIMUM DAYS FOR CONTINUOUS ORDERS^0
"KRN",8989.51,20,1)
N^1:370^Enter the maximum number of days that multiple-continuous orders can be placed.
"KRN",8989.51,20,20,0)
^^2^2^3000211^^^^
"KRN",8989.51,20,20,1,0)
This is the maximum number of days that multiple-continuous orders may be
"KRN",8989.51,20,20,2,0)
placed.  The number may be specific to each hospital location.
"KRN",8989.51,20,30,0)
^8989.513I^3^3
"KRN",8989.51,20,30,1,0)
1^44
"KRN",8989.51,20,30,2,0)
2^4.2
"KRN",8989.51,20,30,3,0)
3^9.4
"KRN",8989.51,34,0)
LR LAB COLLECT FUTURE^Lab Collect Days Allowed in Future^^^LAB COLLECT DAYS ALLOWED IN FUTURE^0
"KRN",8989.51,34,1)
N^1:370^Enter the number of days allowed to collect 'Lab Collect' future orders.
"KRN",8989.51,34,20,0)
^^2^2^3000211^^^^
"KRN",8989.51,34,20,1,0)
This is the maximum number of days that 'Lab Collect' orders may be
"KRN",8989.51,34,20,2,0)
placed.  The number may be specific to each hospital location.
"KRN",8989.51,34,30,0)
^8989.513I^4^4
"KRN",8989.51,34,30,1,0)
1^44
"KRN",8989.51,34,30,2,0)
2^4
"KRN",8989.51,34,30,3,0)
3^4.2
"KRN",8989.51,34,30,4,0)
4^9.4
"KRN",8989.51,74,0)
LR COLLECT FRIDAY^Collect on Friday^^^COLLECT FRIDAY
"KRN",8989.51,74,1)
Y^0:1^Enter 1 if routine collection is done on this day
"KRN",8989.51,74,20,0)
^^1^1^2951010^
"KRN",8989.51,74,20,1,0)
This determines if routine collection is done on this day.
"KRN",8989.51,74,30,0)
^8989.513I^2^2
"KRN",8989.51,74,30,1,0)
1^4.2
"KRN",8989.51,74,30,2,0)
2^9.4
"KRN",8989.51,75,0)
LR COLLECT THURSDAY^Collect on Thursday^^^COLLECT THURSDAY
"KRN",8989.51,75,1)
Y^0:1^Enter 1 if routine collection is done on this day
"KRN",8989.51,75,20,0)
^^1^1^2951010^
"KRN",8989.51,75,20,1,0)
This determines if routine collection is done on this day.
"KRN",8989.51,75,30,0)
^8989.513I^2^2
"KRN",8989.51,75,30,1,0)
1^4.2
"KRN",8989.51,75,30,2,0)
2^9.4
"KRN",8989.51,76,0)
LR COLLECT WEDNESDAY^Collect on Wednesday^^^COLLECT WEDNESDAY
"KRN",8989.51,76,1)
Y^0:1^Enter 1 if routine collection is done on this day
"KRN",8989.51,76,20,0)
^^1^1^2951010^
"KRN",8989.51,76,20,1,0)
This determines if routine collection is done on this day.
"KRN",8989.51,76,30,0)
^8989.513I^2^2
"KRN",8989.51,76,30,1,0)
1^4.2
"KRN",8989.51,76,30,2,0)
2^9.4
"KRN",8989.51,77,0)
LR COLLECT TUESDAY^Collect on Tuesday^^^COLLECT TUESDAY
"KRN",8989.51,77,1)
Y^0:1^Enter 1 if routine collection is done on this day
"KRN",8989.51,77,20,0)
^^1^1^2951010^
"KRN",8989.51,77,20,1,0)
This determines if routine collection is done on this day.
"KRN",8989.51,77,30,0)
^8989.513I^2^2
"KRN",8989.51,77,30,1,0)
1^4.2
"KRN",8989.51,77,30,2,0)
2^9.4
"KRN",8989.51,78,0)
LR COLLECT MONDAY^Collect on Monday^^^COLLECT MONDAY
"KRN",8989.51,78,1)
Y^0:1^Enter 1 if routine collection is done on this day
"KRN",8989.51,78,20,0)
^^1^1^2951010^
"KRN",8989.51,78,20,1,0)
This determines if routine collection is done on this day.
"KRN",8989.51,78,30,0)
^8989.513I^2^2
"KRN",8989.51,78,30,1,0)
1^4.2
"KRN",8989.51,78,30,2,0)
2^9.4
"KRN",8989.51,79,0)
LR COLLECT SUNDAY^Collect on Sunday^^^COLLECT SUNDAY
"KRN",8989.51,79,1)
Y^0:1^Enter 1 if routine collection is done on this day
"KRN",8989.51,79,20,0)
^^1^1^2951010^
"KRN",8989.51,79,20,1,0)
This determines if routine collection is done on this day.
"KRN",8989.51,79,30,0)
^8989.513I^2^2
"KRN",8989.51,79,30,1,0)
1^4.2
"KRN",8989.51,79,30,2,0)
2^9.4
"KRN",8989.51,80,0)
LR COLLECT SATURDAY^Collect on Saturday^^^COLLECT SATURDAY
"KRN",8989.51,80,1)
Y^0:1^Enter 1 if routine collection is done on this day
"KRN",8989.51,80,20,0)
^^1^1^2951010^
"KRN",8989.51,80,20,1,0)
This determines if routine collection is done on this day.
"KRN",8989.51,80,30,0)
^8989.513I^2^2
"KRN",8989.51,80,30,1,0)
1^4.2
"KRN",8989.51,80,30,2,0)
2^9.4
"KRN",8989.51,404,0)
LR VER EA VERIFY BY UID^Default load/work list verify method^1^Accession Area^Default load/work list verify method^0
"KRN",8989.51,404,1)
S^0:Accession Number;1:Unique Identifier (UID);2:Only UID^Specify the default result verification method presented to user.
"KRN",8989.51,404,4,0)
^8989.514^1^1
"KRN",8989.51,404,4,1,0)
UID
"KRN",8989.51,404,4,"B","UID",1)

"KRN",8989.51,404,6)
P^68
"KRN",8989.51,404,20,0)
^8989.512^9^9^3070911^^^^
"KRN",8989.51,404,20,1,0)
Used to designate the default verification method presented to
"KRN",8989.51,404,20,2,0)
the user when verifying laboratory results in the "CH" subscript
"KRN",8989.51,404,20,3,0)
via options that use a load/work list. Parameter is associated
"KRN",8989.51,404,20,4,0)
with the accession area linked to the load/worklist profile
"KRN",8989.51,404,20,5,0)
selected by the user.
"KRN",8989.51,404,20,6,0)

"KRN",8989.51,404,20,7,0)
Parameter can be set at the package or user level. 
"KRN",8989.51,404,20,8,0)
User level takes precedence over division level.
"KRN",8989.51,404,20,9,0)
Site can also force verification by UID only.
"KRN",8989.51,404,30,0)
^8989.513I^2^2
"KRN",8989.51,404,30,1,0)
1^200
"KRN",8989.51,404,30,2,0)
2^9.4
"KRN",8989.51,461,0)
LR EGFR METHOD^EGFR Creatinine IDMS-traceable Method^0^IDMS-traceable^Creatinine IDMS-traceable Method^0
"KRN",8989.51,461,1)
Y^^Answer with yes/no if the Creatinine method is traceable to an IDMS method.
"KRN",8989.51,461,4,0)
^8989.514^2^2
"KRN",8989.51,461,4,1,0)
EGFR
"KRN",8989.51,461,4,2,0)
IDMS
"KRN",8989.51,461,4,"B","EGFR",1)

"KRN",8989.51,461,4,"B","IDMS",2)

"KRN",8989.51,461,6)
Y
"KRN",8989.51,461,20,0)
^8989.512^3^3^3111006^^^
"KRN",8989.51,461,20,1,0)
Used to designate if the EGFR calculation should calculate the
"KRN",8989.51,461,20,2,0)
EGFR based on a IDMS-traceable method. This parameter is configurable
"KRN",8989.51,461,20,3,0)
at both the package and division level.
"KRN",8989.51,461,30,0)
^8989.513I^2^2
"KRN",8989.51,461,30,1,0)
1^4
"KRN",8989.51,461,30,2,0)
2^9.4
"KRN",8989.51,462,0)
LR EGFR AGE CUTOFF^EGFR Patient's Age Cutoff^0^^Suppress EGFR When Patient's Age^0
"KRN",8989.51,462,1)
S^0:NEVER;1:<18 YEARS;2:>70 YEARS;3:BOTH^Select when the patient's age should suppress reporting of the patient's EGFR.
"KRN",8989.51,462,4,0)
^8989.514^1^1
"KRN",8989.51,462,4,1,0)
EGFR
"KRN",8989.51,462,4,"B","EGFR",1)

"KRN",8989.51,462,6)
^^
"KRN",8989.51,462,20,0)
^8989.512^5^5^3111006^^^^
"KRN",8989.51,462,20,1,0)
Used to designate if the EGFR calculation should not be performed 
"KRN",8989.51,462,20,2,0)
on creatinine when executing the delta check EGFR when the
"KRN",8989.51,462,20,3,0)
patient's age is <18 or >70. This parameter is configurable
"KRN",8989.51,462,20,4,0)
at both the package and division level and can be set for
"KRN",8989.51,462,20,5,0)
either or both age cutoffs.
"KRN",8989.51,462,30,0)
^8989.513I^2^2
"KRN",8989.51,462,30,1,0)
1^4
"KRN",8989.51,462,30,2,0)
2^9.4
"KRN",8989.51,463,0)
LR EGFR RESULT SUPPRESS^EGFR Result Cutoff^0^>60 Result Suppression^Report EGFR as >60^0
"KRN",8989.51,463,1)
Y^^Answer with yes/no if EGFR values >60 should be reported as ">60".
"KRN",8989.51,463,4,0)
^8989.514^1^1
"KRN",8989.51,463,4,1,0)
EGFR
"KRN",8989.51,463,4,"B","EGFR",1)

"KRN",8989.51,463,20,0)
^8989.512^4^4^3111006^^^
"KRN",8989.51,463,20,1,0)
Used to designate if the EGFR calculation should be suppressed
"KRN",8989.51,463,20,2,0)
when the value is >60. If enabled then ">60" is reported in
"KRN",8989.51,463,20,3,0)
lieu of the actual EGFR calculated value. This parameter is
"KRN",8989.51,463,20,4,0)
configurable at both the package and division level.
"KRN",8989.51,463,30,0)
^8989.513I^2^2
"KRN",8989.51,463,30,1,0)
1^4
"KRN",8989.51,463,30,2,0)
2^9.4
"KRN",8989.51,464,0)
LR VER EM VERIFY BY UID^Default manual verify method^0^^Default manual verify method^0
"KRN",8989.51,464,1)
S^0:Accession Number;1:Unique Identifier (UID);2:Only UID^Specify the default result verification method presented to user.
"KRN",8989.51,464,4,0)
^8989.514^1^1
"KRN",8989.51,464,4,1,0)
UID
"KRN",8989.51,464,4,"B","UID",1)

"KRN",8989.51,464,6)
^
"KRN",8989.51,464,20,0)
^8989.512^7^7^3070911^^^^
"KRN",8989.51,464,20,1,0)
Used to designate the default verification method presented to
"KRN",8989.51,464,20,2,0)
the user when verifying laboratory results in the "CH" subscript
"KRN",8989.51,464,20,3,0)
via options that do not use a load/work list.
"KRN",8989.51,464,20,4,0)
Parameter can be set at the package, division or user
"KRN",8989.51,464,20,5,0)
level. Division level takes precedence over the package level.
"KRN",8989.51,464,20,6,0)
User level takes precedence over division level.
"KRN",8989.51,464,20,7,0)
Site can also force verification by UID only.
"KRN",8989.51,464,30,0)
^8989.513I^3^3
"KRN",8989.51,464,30,1,0)
1^200
"KRN",8989.51,464,30,2,0)
2^4
"KRN",8989.51,464,30,3,0)
3^9.4
"KRN",8989.51,467,0)
LRAPRES1 AP ALERT^Send an alert after AP release^0^^Send alert for released AP^0
"KRN",8989.51,467,1)
Y
"KRN",8989.51,467,20,0)
^8989.512^2^2^3071116^^^^
"KRN",8989.51,467,20,1,0)
After Anatomic Pathology report is released, this will be the default 
"KRN",8989.51,467,20,2,0)
answer to the "Send an alert" message.
"KRN",8989.51,467,30,0)
^8989.513I^3^3
"KRN",8989.51,467,30,1,0)
1^200
"KRN",8989.51,467,30,2,0)
5^4
"KRN",8989.51,467,30,3,0)
10^9.4
"KRN",8989.51,471,0)
LR AP REPORT SELECTION^Default AP Report Selection Prompt^0^^AP Report Selection Default^0
"KRN",8989.51,471,1)
S^1:Accession Number;2:Unique Identifier (UID);3:Patient Name^Specify the default report selection method presented to user.
"KRN",8989.51,471,4,0)
^8989.514
"KRN",8989.51,471,30,0)
^8989.513I^3^3
"KRN",8989.51,471,30,1,0)
1^200
"KRN",8989.51,471,30,2,0)
2^4
"KRN",8989.51,471,30,3,0)
3^9.4
"KRN",8989.51,472,0)
LR AP SNOMED SYSTEM PRINT^Print SNOMED Code System^0^^Print SNOMED Version
"KRN",8989.51,472,1)
S^1:SNOMED I;2:SNOMED CT;3:BOTH^Select which version of SNOMED to print on AP reports
"KRN",8989.51,472,20,0)
^^2^2^3090227^
"KRN",8989.51,472,20,1,0)
Parameter to allow the site/division to indicate which version of SNOMED
"KRN",8989.51,472,20,2,0)
to print or display on Anatomic Pathology reports.
"KRN",8989.51,472,30,0)
^8989.513I^2^2
"KRN",8989.51,472,30,1,0)
1^4
"KRN",8989.51,472,30,2,0)
2^9.4
"KRN",8989.51,474,0)
LR MAPPING DEFAULT DIRECTORY^Lab STS Default Mapping Files Directory^0^^Default Directory^0
"KRN",8989.51,474,1)
F^3:245^The directory that contains the STS mapping files
"KRN",8989.51,474,4,0)
^8989.514^2^2
"KRN",8989.51,474,4,1,0)
MAPPING
"KRN",8989.51,474,4,2,0)
STANDARDIZATION
"KRN",8989.51,474,4,"B","MAPPING",1)

"KRN",8989.51,474,4,"B","STANDARDIZATION",2)

"KRN",8989.51,474,20,0)
^8989.512^5^5^3110105^^^^
"KRN",8989.51,474,20,1,0)
This parameter holds the name of the default directory
"KRN",8989.51,474,20,2,0)
which contains the STS mapping of standard code sets to VistA
"KRN",8989.51,474,20,3,0)
Laboratory system files.
"KRN",8989.51,474,20,4,0)
 
"KRN",8989.51,474,20,5,0)
Should be expressed as a full directory specification.
"KRN",8989.51,474,30,0)
^8989.513I^3^3
"KRN",8989.51,474,30,1,0)
1^200
"KRN",8989.51,474,30,2,0)
2^9.4
"KRN",8989.51,474,30,3,0)
3^4.2
"KRN",8989.51,476,0)
LR MAPPING DEFAULT FILESPEC^Lab STS Default Mapping Filespec^0^^Default FileSpec^0
"KRN",8989.51,476,1)
F^3:70^The filespec to screen the display of files
"KRN",8989.51,476,4,0)
^8989.514^2^2
"KRN",8989.51,476,4,1,0)
MAPPING
"KRN",8989.51,476,4,2,0)
STANDARDIZATION
"KRN",8989.51,476,4,"B","MAPPING",1)

"KRN",8989.51,476,4,"B","STANDARDIZATION",2)

"KRN",8989.51,476,20,0)
^8989.512^5^5^3110105^^^
"KRN",8989.51,476,20,1,0)
This parameter holds the file specification used to screen which
"KRN",8989.51,476,20,2,0)
files is a given directory are presented to the user for loading.
"KRN",8989.51,476,20,3,0)
These files contain the STS mapping of standard code sets to VistA
"KRN",8989.51,476,20,4,0)
Laboratory system files.
"KRN",8989.51,476,20,5,0)

"KRN",8989.51,476,30,0)
^8989.513I^3^3
"KRN",8989.51,476,30,1,0)
1^200
"KRN",8989.51,476,30,2,0)
2^9.4
"KRN",8989.51,476,30,3,0)
3^4.2
"KRN",8989.51,479,0)
LR CH GUI REPORT RIGHT MARGIN^Chemistry GUI Report Right Margin^0^^Chemistry GUI Report Right Margin^0
"KRN",8989.51,479,1)
N^80:240:0^Enter the value to be used for the right margin when formatting lab reports
"KRN",8989.51,479,20,0)
^8989.512^3^3^3080421^^^^
"KRN",8989.51,479,20,1,0)
This is the value to use for the right margin (column) when formatting
"KRN",8989.51,479,20,2,0)
chemistry/hematology type laboratory reports within a GUI display/client.
"KRN",8989.51,479,20,3,0)

"KRN",8989.51,479,30,0)
^8989.513I^3^3
"KRN",8989.51,479,30,1,0)
1^200
"KRN",8989.51,479,30,2,0)
2^4
"KRN",8989.51,479,30,3,0)
3^9.4
"KRN",8989.51,480,0)
LR MI GUI REPORT RIGHT MARGIN^Microbiology GUI Report Right Margin^0^^Microbiology GUI Report Right Margin^0
"KRN",8989.51,480,1)
N^80:240:0^Enter the value to be used for the right margin when formatting lab reports
"KRN",8989.51,480,20,0)
^8989.512^3^3^3080421^^^^
"KRN",8989.51,480,20,1,0)
This is the value to use for the right margin (column) when formatting
"KRN",8989.51,480,20,2,0)
microbiology type laboratory reports within a GUI display/client.
"KRN",8989.51,480,20,3,0)

"KRN",8989.51,480,30,0)
^8989.513I^3^3
"KRN",8989.51,480,30,1,0)
1^200
"KRN",8989.51,480,30,2,0)
2^4
"KRN",8989.51,480,30,3,0)
3^9.4
"KRN",8989.51,481,0)
LR AP GUI REPORT RIGHT MARGIN^AP GUI Report Right Margin^0^^AP GUI Report Right Margin^0
"KRN",8989.51,481,1)
N^80:240:0^Enter the value to be used for the right margin when foramtting lab reports
"KRN",8989.51,481,20,0)
^8989.512^3^3^3080421^^^^
"KRN",8989.51,481,20,1,0)
This is the value to use for the right margin (column) when formatting
"KRN",8989.51,481,20,2,0)
anatomic pathology type laboratory reports within a GUI display/client.
"KRN",8989.51,481,20,3,0)

"KRN",8989.51,481,30,0)
^8989.513I^3^3
"KRN",8989.51,481,30,1,0)
1^200
"KRN",8989.51,481,30,2,0)
2^4
"KRN",8989.51,481,30,3,0)
3^9.4
"KRN",8989.51,482,0)
LR MI VERIFY DISPLAY PROVIDER^Display Provider in Micro Result Entry^0^^Display Provider in Micro Result Entry^0
"KRN",8989.51,482,1)
Y^^Enter yes/no to display ordering provider information during micro result entry
"KRN",8989.51,482,20,0)
^8989.512^3^3^3111006^^^^
"KRN",8989.51,482,20,1,0)
This parameter allows the site/division/user to indicate if the ordering
"KRN",8989.51,482,20,2,0)
provider information should be displayed to the user during microbiology
"KRN",8989.51,482,20,3,0)
result data entry.
"KRN",8989.51,482,30,0)
^8989.513I^3^3
"KRN",8989.51,482,30,1,0)
1^200
"KRN",8989.51,482,30,2,0)
2^4
"KRN",8989.51,482,30,3,0)
3^9.4
"KRN",8989.51,496,0)
LR ACCESSION DEFAULT SPECIMEN^Default Accessioning Specimen^1^Lab Section^Default Specimen
"KRN",8989.51,496,1)
P^61^Select the Lab Section for this default specimen
"KRN",8989.51,496,4,0)
^8989.514^1^1
"KRN",8989.51,496,4,1,0)
AP DEFAULTS
"KRN",8989.51,496,4,"B","AP DEFAULTS",1)

"KRN",8989.51,496,6)
P^68
"KRN",8989.51,496,7)

"KRN",8989.51,496,8)
I $P(^(0),U,2)?1(1"SP",1"CY",1"EM")
"KRN",8989.51,496,20,0)
^8989.512^2^2^3081007^^^^
"KRN",8989.51,496,20,1,0)
Allows the package/facility/user to set a default topography presented
"KRN",8989.51,496,20,2,0)
to the user when accessioning specimens into the Laboratory system.
"KRN",8989.51,496,30,0)
^8989.513I^3^3
"KRN",8989.51,496,30,1,0)
1^200
"KRN",8989.51,496,30,2,0)
2^4
"KRN",8989.51,496,30,3,0)
3^9.4
"KRN",8989.51,497,0)
LR ACCESSION DEFAULT COL SAMP^Default Accessioning Collection Sample^1^Lab Section^Default Collection Sample
"KRN",8989.51,497,1)
P^62^Select the Lab Section for this default collection sample
"KRN",8989.51,497,4,0)
^8989.514^1^1
"KRN",8989.51,497,4,1,0)
AP DEFAULTS
"KRN",8989.51,497,4,"B","AP DEFAULTS",1)

"KRN",8989.51,497,6)
P^68
"KRN",8989.51,497,8)
I $P(^(0),U,2)?1(1"SP",1"CY",1"EM")
"KRN",8989.51,497,20,0)
^8989.512^4^4^3111216^^^^
"KRN",8989.51,497,20,1,0)
Allows the package/facility/user to set a default collection sample
"KRN",8989.51,497,20,2,0)
presented to the user when accessioning specimens into the Laboratory
"KRN",8989.51,497,20,3,0)
system.
"KRN",8989.51,497,20,4,0)

"KRN",8989.51,497,30,0)
^8989.513I^3^3
"KRN",8989.51,497,30,1,0)
1^200
"KRN",8989.51,497,30,2,0)
2^4
"KRN",8989.51,497,30,3,0)
3^9.4
"KRN",8989.51,498,0)
LR ACCESSION DEFAULT LAB TEST^Default Accessioning Lab Test^1^Lab Section^Default Laboratory Test
"KRN",8989.51,498,1)
P^60^Select the Lab Section for this default lab test
"KRN",8989.51,498,4,0)
^8989.514^1^1
"KRN",8989.51,498,4,1,0)
AP DEFAULTS
"KRN",8989.51,498,4,"B","AP DEFAULTS",1)

"KRN",8989.51,498,6)
P^68
"KRN",8989.51,498,8)
I $P(^(0),U,2)?1(1"SP",1"CY",1"EM")
"KRN",8989.51,498,20,0)
^8989.512^3^3^3081007^^^^
"KRN",8989.51,498,20,1,0)
Allows the package/facility/user to set a default laboratory test presented
"KRN",8989.51,498,20,2,0)
to the user when accessioning specimens into the Laboratory system.
"KRN",8989.51,498,20,3,0)

"KRN",8989.51,498,30,0)
^8989.513I^3^3
"KRN",8989.51,498,30,1,0)
1^200
"KRN",8989.51,498,30,2,0)
2^4
"KRN",8989.51,498,30,3,0)
3^9.4
"KRN",8989.51,499,0)
LR MANIFEST EXC PREV TEST^Exclude removed tests from building^1^Shipping Configuration^Exclude removed tests default^0
"KRN",8989.51,499,1)
Y^^Answer with yes/no to exclude previously removed tests building on manifest
"KRN",8989.51,499,6)
P^62.9
"KRN",8989.51,499,8)
I $P(^LAHM(62.9,Y,0),U,2)=DUZ(2),$P(^LAHM(62.9,Y,0),U,4)
"KRN",8989.51,499,20,0)
^8989.512^3^3^3120418^^^^
"KRN",8989.51,499,20,1,0)
Allows package or user to select the default value presented to the user 
"KRN",8989.51,499,20,2,0)
when building a shipping configuration to the prompt "Exclude previously
"KRN",8989.51,499,20,3,0)
removed tests from building?"
"KRN",8989.51,499,30,0)
^8989.513I^2^2
"KRN",8989.51,499,30,1,0)
1^200
"KRN",8989.51,499,30,2,0)
10^9.4
"KRN",8989.51,505,0)
LR AP SURGERY REFERENCE^Document Surgery Package Case Info^0^^Document Surgery Case Info^0
"KRN",8989.51,505,1)
Y^^Answer YES/NO if a source statement is included when copying surgical case info.
"KRN",8989.51,505,20,0)
^8989.512^3^3^3081126^
"KRN",8989.51,505,20,1,0)
Allows site/division to indicate when copying surgical case information from
"KRN",8989.51,505,20,2,0)
the Surgery package during surgical pathology login if a statement is also
"KRN",8989.51,505,20,3,0)
added to the copied information documenting the source of the copied information.
"KRN",8989.51,505,30,0)
^8989.513I^2^2
"KRN",8989.51,505,30,1,0)
1^4
"KRN",8989.51,505,30,2,0)
2^9.4
"KRN",8989.51,506,0)
LR MI VERIFY CPRS ALERT^Prompt CPRS Alert in Micro Result Entry^0^^Send CPRS Alert in Micro Result Entry^0
"KRN",8989.51,506,1)
S^0:Don't Ask;1:Ask - Default NO;2:Ask - Default YES^Specify if user should be prompted to send a CPRS Alert
"KRN",8989.51,506,4,0)
^8989.514^1^1
"KRN",8989.51,506,4,1,0)
MICRO
"KRN",8989.51,506,4,"B","MICRO",1)

"KRN",8989.51,506,20,0)
^8989.512^6^6^3090508^^
"KRN",8989.51,506,20,1,0)
Used to allow the user to determine if they want to be prompted
"KRN",8989.51,506,20,2,0)
to send a CPRS alert after editing a microbiology accession.
"KRN",8989.51,506,20,3,0)
 
"KRN",8989.51,506,20,4,0)
The user can indicate:
"KRN",8989.51,506,20,5,0)
 1. They do not want to be asked
"KRN",8989.51,506,20,6,0)
 2. They want to be asked with a default of YES/NO to send an alert.
"KRN",8989.51,506,30,0)
^8989.513I^3^3
"KRN",8989.51,506,30,1,0)
1^200
"KRN",8989.51,506,30,2,0)
2^4
"KRN",8989.51,506,30,3,0)
3^9.4
"KRN",8989.51,508,0)
LR CH VERIFY CPRS ALERT^Prompt CPRS Alert in CH Result Entry^0^^Send CPRS Alert in CH Result Entry^0
"KRN",8989.51,508,1)
S^0:Don't Ask;1:Ask - Default NO;2:Ask - Default YES^Specify if user should be prompted to send a CPRS Alert
"KRN",8989.51,508,4,0)
^8989.514^1^1
"KRN",8989.51,508,4,1,0)
CHEM/HEME
"KRN",8989.51,508,4,"B","CHEM/HEME",1)

"KRN",8989.51,508,20,0)
^^6^6^3090629^
"KRN",8989.51,508,20,1,0)
Used to allow the user to determine if they want to be prompted
"KRN",8989.51,508,20,2,0)
to send a CPRS alert after editing a Chem/Heme accession.
"KRN",8989.51,508,20,3,0)
 
"KRN",8989.51,508,20,4,0)
The user can indicate:
"KRN",8989.51,508,20,5,0)
 1. They do not want to be asked
"KRN",8989.51,508,20,6,0)
 2. They want to be asked with a default of YES/NO to send an alert.
"KRN",8989.51,508,30,0)
^8989.513I^3^3
"KRN",8989.51,508,30,1,0)
1^200
"KRN",8989.51,508,30,2,0)
2^4
"KRN",8989.51,508,30,3,0)
3^9.4
"KRN",8989.51,525,0)
LR REPORTS FACILITY PRINT^Print Reporting/Printing Facility^0^^Print Reporting/Printing Facility^0
"KRN",8989.51,525,1)
S^0:None;1:Reporting Facility;2:Printing Facility;3:Both^Should name of reporting and/or printing facility appear on Lab reports.
"KRN",8989.51,525,4,0)
^8989.514^1^1
"KRN",8989.51,525,4,1,0)
REPORTS
"KRN",8989.51,525,4,"B","REPORTS",1)

"KRN",8989.51,525,20,0)
^^6^6^3091110^
"KRN",8989.51,525,20,1,0)
 
"KRN",8989.51,525,20,2,0)
Determines if the name and address of the:
"KRN",8989.51,525,20,3,0)
 1. Laboratory that is responsible for the report display on the Laboratory report.
"KRN",8989.51,525,20,4,0)
 2. Facility where the report is printed display on the Laboratory report.
"KRN",8989.51,525,20,5,0)
 3. Both names display on the Laboratory report.
"KRN",8989.51,525,20,6,0)

"KRN",8989.51,525,30,0)
^8989.513I^3^2
"KRN",8989.51,525,30,2,0)
1^4
"KRN",8989.51,525,30,3,0)
2^9.4
"KRN",8989.51,526,0)
LR MANIFEST DEFLT ACCESSION^Use default accession dates^1^Shipping Configuration^Use default accession dates default^0
"KRN",8989.51,526,1)
Y^^Answer with yes/no to Use default accession dates prompt
"KRN",8989.51,526,6)
P^62.9
"KRN",8989.51,526,8)
I $P(^LAHM(62.9,Y,0),U,2)=DUZ(2),$P(^LAHM(62.9,Y,0),U,4)
"KRN",8989.51,526,20,0)
^8989.512^3^3^3120418^^^^
"KRN",8989.51,526,20,1,0)
Allows package or user to select the default value presented to the user 
"KRN",8989.51,526,20,2,0)
when building a shipping configuration to the prompt "Use default 
"KRN",8989.51,526,20,3,0)
accession dates?"
"KRN",8989.51,526,30,0)
^8989.513I^2^2
"KRN",8989.51,526,30,1,0)
1^200
"KRN",8989.51,526,30,2,0)
10^9.4
"KRN",8989.51,529,0)
LR ASK PERFORMING LAB MICRO^Ask Performing Lab Micro^0^^Ask Performing Lab for MICRO^0
"KRN",8989.51,529,1)
Y^^Enter yes to be prompted for Performing Lab for Microbiology tests.
"KRN",8989.51,529,4,0)
^8989.514^1^1
"KRN",8989.51,529,4,1,0)
PERFORMING LAB
"KRN",8989.51,529,4,"B","PERFORMING LAB",1)

"KRN",8989.51,529,6)

"KRN",8989.51,529,20,0)
^8989.512^5^5^3111028^^^^
"KRN",8989.51,529,20,1,0)
Enter Yes to be prompted for Performing Lab.
"KRN",8989.51,529,20,2,0)
Enter No to not be prompted for Performing Lab.
"KRN",8989.51,529,20,3,0)
The performing lab is the user's 'Default Performing Laboratory' parameter
"KRN",8989.51,529,20,4,0)
and if the parameter is not set for the user it defaults to the user's
"KRN",8989.51,529,20,5,0)
Institution (DUZ(2)).
"KRN",8989.51,529,30,0)
^8989.513I^3^3
"KRN",8989.51,529,30,1,0)
1^200
"KRN",8989.51,529,30,2,0)
2^4
"KRN",8989.51,529,30,3,0)
3^9.4
"KRN",8989.51,530,0)
LR ASK PERFORMING LAB AP^Ask Performing Lab AP^0^^Ask Performing Lab AP^0
"KRN",8989.51,530,1)
Y^^Enter yes to be prompted for Performing Lab for Anatomic Pathology tests.
"KRN",8989.51,530,4,0)
^8989.514^1^1
"KRN",8989.51,530,4,1,0)
PERFORMING LAB
"KRN",8989.51,530,4,"B","PERFORMING LAB",1)

"KRN",8989.51,530,6)

"KRN",8989.51,530,20,0)
^8989.512^5^5^3111205^^^^
"KRN",8989.51,530,20,1,0)
Enter Yes to be prompted for Performing Lab.
"KRN",8989.51,530,20,2,0)
Enter No to not be prompted for Performing Lab.
"KRN",8989.51,530,20,3,0)
The performing lab is the user's 'Default Performing Laboratory' parameter
"KRN",8989.51,530,20,4,0)
and if the parameter is not set for the user it defaults to the user's
"KRN",8989.51,530,20,5,0)
Institution (DUZ(2)).
"KRN",8989.51,530,30,0)
^8989.513I^3^3
"KRN",8989.51,530,30,1,0)
1^200
"KRN",8989.51,530,30,2,0)
2^4
"KRN",8989.51,530,30,3,0)
3^9.4
"KRN",8989.51,536,-1)
0^1
"KRN",8989.51,536,0)
LR AP DEFAULT ACCESSION NUMBER^Method of Assigning AP Accession Number^1^Lab Section^Default Method
"KRN",8989.51,536,1)
S^1:First Available Number;2:Next Available Sequential Number^Select the method the system will use to assign a default accession number.
"KRN",8989.51,536,4,0)
^8989.514^1^1
"KRN",8989.51,536,4,1,0)
AP DEFAULTS
"KRN",8989.51,536,4,"B","AP DEFAULTS",1)

"KRN",8989.51,536,6)
P^68
"KRN",8989.51,536,8)
I $P(^(0),U,2)?1(1"SP",1"CY",1"EM")
"KRN",8989.51,536,20,0)
^^21^21^3121031^
"KRN",8989.51,536,20,1,0)
When an Anatomic Pathology (AP) case is accessioned, this parameter will 
"KRN",8989.51,536,20,2,0)
control how the system should assign a default accession number to the 
"KRN",8989.51,536,20,3,0)
case being logged in. (Note: The user will still be able to override the 
"KRN",8989.51,536,20,4,0)
default, and select a different accession number, if they so choose).
"KRN",8989.51,536,20,5,0)
 
"KRN",8989.51,536,20,6,0)
'First Available Number' - The system will start searching from number 
"KRN",8989.51,536,20,7,0)
one, and the first available accession number that is found in that
"KRN",8989.51,536,20,8,0)
accession area will be used as the default accession number for the new
"KRN",8989.51,536,20,9,0)
case being logged in. Choosing this method will minimize the likelihood of
"KRN",8989.51,536,20,10,0)
having any gaps in the accession numbering, however, there is the
"KRN",8989.51,536,20,11,0)
possibility that some accessions might be out of sequence.
"KRN",8989.51,536,20,12,0)
 
"KRN",8989.51,536,20,13,0)
'Next Available Sequential Number' - The system will start searching from 
"KRN",8989.51,536,20,14,0)
the last accession number that was logged in, and the next available 
"KRN",8989.51,536,20,15,0)
number that is found in that accession area will be used as the default 
"KRN",8989.51,536,20,16,0)
accession number for the new case being logged in. Choosing this method 
"KRN",8989.51,536,20,17,0)
should better keep the accession numbers in sequence, but there is the 
"KRN",8989.51,536,20,18,0)
possibility that some gaps in the numbering might be introduced.
"KRN",8989.51,536,20,19,0)
 
"KRN",8989.51,536,20,20,0)
If no selection is made, the system will default to 'First Available 
"KRN",8989.51,536,20,21,0)
Number'.
"KRN",8989.51,536,30,0)
^8989.513I^1^1
"KRN",8989.51,536,30,1,0)
10^9.4
"KRN",8989.52,10,-1)
0^1
"KRN",8989.52,10,0)
LR PKG^Lab Package Level Parameters^9.4
"KRN",8989.52,10,10,0)
^8989.521IA^39^36
"KRN",8989.52,10,10,1,0)
1^LR COLLECT MONDAY
"KRN",8989.52,10,10,2,0)
2^LR COLLECT TUESDAY
"KRN",8989.52,10,10,3,0)
3^LR COLLECT WEDNESDAY
"KRN",8989.52,10,10,4,0)
4^LR COLLECT THURSDAY
"KRN",8989.52,10,10,5,0)
5^LR COLLECT FRIDAY
"KRN",8989.52,10,10,6,0)
6^LR COLLECT SATURDAY
"KRN",8989.52,10,10,7,0)
7^LR COLLECT SUNDAY
"KRN",8989.52,10,10,8,0)
8^LR IGNORE HOLIDAYS
"KRN",8989.52,10,10,10,0)
11^LR EGFR METHOD
"KRN",8989.52,10,10,11,0)
12^LR EGFR AGE CUTOFF
"KRN",8989.52,10,10,12,0)
13^LR EGFR RESULT SUPPRESS
"KRN",8989.52,10,10,13,0)
9.2^LR VER EA VERIFY BY UID
"KRN",8989.52,10,10,14,0)
9.1^LR VER EM VERIFY BY UID
"KRN",8989.52,10,10,15,0)
20^LRAPRES1 AP ALERT
"KRN",8989.52,10,10,16,0)
21^LR AP REPORT SELECTION
"KRN",8989.52,10,10,17,0)
24^LR AP SNOMED SYSTEM PRINT
"KRN",8989.52,10,10,18,0)
50^LR CH GUI REPORT RIGHT MARGIN
"KRN",8989.52,10,10,19,0)
52^LR MI GUI REPORT RIGHT MARGIN
"KRN",8989.52,10,10,20,0)
54^LR AP GUI REPORT RIGHT MARGIN
"KRN",8989.52,10,10,21,0)
9.3^LR MI VERIFY DISPLAY PROVIDER
"KRN",8989.52,10,10,22,0)
130.1^LR ACCESSION DEFAULT SPECIMEN
"KRN",8989.52,10,10,23,0)
130.2^LR ACCESSION DEFAULT COL SAMP
"KRN",8989.52,10,10,24,0)
130.3^LR ACCESSION DEFAULT LAB TEST
"KRN",8989.52,10,10,26,0)
25^LR AP SURGERY REFERENCE
"KRN",8989.52,10,10,27,0)
9.35^LR MI VERIFY CPRS ALERT
"KRN",8989.52,10,10,28,0)
9.36^LR CH VERIFY CPRS ALERT
"KRN",8989.52,10,10,29,0)
8.1^LR LAB COLLECT FUTURE
"KRN",8989.52,10,10,30,0)
8.11^LR MAX DAYS CONTINUOUS
"KRN",8989.52,10,10,31,0)
200^LR REPORTS FACILITY PRINT
"KRN",8989.52,10,10,33,0)
900^LR MAPPING DEFAULT DIRECTORY
"KRN",8989.52,10,10,34,0)
900.1^LR MAPPING DEFAULT FILESPEC
"KRN",8989.52,10,10,35,0)
22^LR ASK PERFORMING LAB AP
"KRN",8989.52,10,10,36,0)
23^LR ASK PERFORMING LAB MICRO
"KRN",8989.52,10,10,37,0)
150.1^LR MANIFEST EXC PREV TEST
"KRN",8989.52,10,10,38,0)
150.2^LR MANIFEST DEFLT ACCESSION
"KRN",8989.52,10,10,39,0)
120^LR AP DEFAULT ACCESSION NUMBER
"MBREQ")
0
"ORD",18,19)
19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
"ORD",18,19,0)
OPTION
"ORD",20,8989.51)
8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%)
"ORD",20,8989.51,0)
PARAMETER DEFINITION
"ORD",21,8989.52)
8989.52;21;1;;PAR2E1^XPDTA2;PAR2F1^XPDIA3;PAR2E1^XPDIA3;PAR2F2^XPDIA3;;PAR2DEL^XPDIA3(%)
"ORD",21,8989.52,0)
PARAMETER TEMPLATE
"PKG",26,-1)
1^1
"PKG",26,0)
LAB SERVICE^LR^CORE LAB SYSTEM
"PKG",26,20,0)
^9.402P^1^1
"PKG",26,20,1,0)
2^^LRXDRPT
"PKG",26,20,1,1)

"PKG",26,20,"B",2,1)

"PKG",26,22,0)
^9.49I^1^1
"PKG",26,22,1,0)
5.2^2940927^2941128
"PKG",26,22,1,"PAH",1,0)
427^3130819
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
44
"RTN","LR7OR1")
0^34^B35364190
"RTN","LR7OR1",1,0)
LR7OR1 ;DALIO/JMC - Get Lab results ;03/13/13  09:08
"RTN","LR7OR1",2,0)
 ;;5.2;LAB SERVICE;**121,187,219,230,256,310,340,348,350,427**;Sep 27, 1994;Build 33
"RTN","LR7OR1",3,0)
 ;
"RTN","LR7OR1",4,0)
RR(DFN,ORD,SDATE,EDATE,SUB,TEST,FLAG,COUNT,SPEC,UNVER) ;Get LAB results for patient
"RTN","LR7OR1",5,0)
 ;DFN = Patient DFN, ptr to file 2 (Required)
"RTN","LR7OR1",6,0)
 ;ORD = Lab Link from OE/RR (ORPK node) (Optional)
"RTN","LR7OR1",7,0)
 ;SDATE = start date to begin search in fileman format (Optional)
"RTN","LR7OR1",8,0)
 ;EDATE = end date to end search in fileman format (Optional)
"RTN","LR7OR1",9,0)
 ;SUB =set to CH,MI,AP or ALL to specify lab (Optional)
"RTN","LR7OR1",10,0)
 ;    subsection. A null entry will imply ALL.
"RTN","LR7OR1",11,0)
 ;TEST = Test to do lookup on (Optional). A null parameter will get all tests
"RTN","LR7OR1",12,0)
 ;FLAG = L for local test ID, N for National test ID (Optional)
"RTN","LR7OR1",13,0)
 ;    this is specified for both input and output
"RTN","LR7OR1",14,0)
 ;COUNT =Count of results to return. Each Date/time counts as 1 (optional)
"RTN","LR7OR1",15,0)
 ;SPEC =ptr file 61 to specify specimen (optional).
"RTN","LR7OR1",16,0)
 ;      If specified, no AP results are returned.
"RTN","LR7OR1",17,0)
 ;UNVER =1 to include unverified data
"RTN","LR7OR1",18,0)
 ;Output is set in ^TMP("LRRR",$J,dfn,subscript,inverse d/t,seq)=
"RTN","LR7OR1",19,0)
 ; testID^result^flag^units^refrange^resultstatus(F or P)^^^natlCode^natlName^system^Verifyby^^Theraputicflag(T or "")^PrintName^Accession^Order#^Specimen
"RTN","LR7OR1",20,0)
 ;
"RTN","LR7OR1",21,0)
 N LRDFN,LRDPF,SEX,AGE,DOB,ORDT,ORSN,II,III,DRAW,TSTY,SS,CT1
"RTN","LR7OR1",22,0)
 ;
"RTN","LR7OR1",23,0)
 Q:'$G(DFN)
"RTN","LR7OR1",24,0)
 S LRDFN=$$LRDFN(DFN),LRDPF="2^DPT("
"RTN","LR7OR1",25,0)
 Q:'LRDFN
"RTN","LR7OR1",26,0)
 ;
"RTN","LR7OR1",27,0)
 S SEX=$P($G(@("^"_$P(LRDPF,"^",2)_+DFN_",0)")),"^",2)
"RTN","LR7OR1",28,0)
 S DOB=$P($G(@("^"_$P(LRDPF,"^",2)_+DFN_",0)")),"^",3),AGE=$S($D(DT)&(DOB?7N):DT-DOB\10000,1:"??")
"RTN","LR7OR1",29,0)
 D DTRNG
"RTN","LR7OR1",30,0)
 S SUB=$S($G(SUB)="ALL":"CHMIAP",$L($G(SUB)):SUB,1:"CHMIAP"),FLAG=$S('$L($G(FLAG)):"L",1:FLAG)
"RTN","LR7OR1",31,0)
 ;
"RTN","LR7OR1",32,0)
 I $G(TEST),FLAG="L",'$D(^LAB(60,TEST)) Q  ;No-Match on Local testID
"RTN","LR7OR1",33,0)
 I $G(TEST),FLAG="N" S TEST=$O(^LAB(60,"AC",TEST,0)) Q:'TEST  ;No-Match on National testID
"RTN","LR7OR1",34,0)
 I $G(TEST) S SUB=$P(^LAB(60,TEST,0),"^",4) Q:'$L(SUB)  ;Test with no subscript
"RTN","LR7OR1",35,0)
 ;
"RTN","LR7OR1",36,0)
 K ^TMP("LRRR",$J),^TMP("LRAPI",$J)
"RTN","LR7OR1",37,0)
 ;
"RTN","LR7OR1",38,0)
 S COUNT=$S($G(COUNT):COUNT,1:9999999),CT1=1
"RTN","LR7OR1",39,0)
 ;
"RTN","LR7OR1",40,0)
 I $G(ORD) S ORDT=0 D  Q
"RTN","LR7OR1",41,0)
 . I $G(TEST) Q:'$D(^LAB(60,TEST,0))  S X=^(0) I $P(X,"^",4)="CH" D
"RTN","LR7OR1",42,0)
 . . I $P(X,"^",5)'="" S TSTY($P($P(X,"^",5),";",2))=TEST
"RTN","LR7OR1",43,0)
 . . I $P(X,"^",5)="" D EN^LR7OU1(TEST)
"RTN","LR7OR1",44,0)
 . I ORD["^" S ORDT=$P(ORD,"^"),ORSN=$P(ORD,"^",2) I ORDT,ORSN D SN Q  ;OE/RR 2.5 unconverted orders
"RTN","LR7OR1",45,0)
 . I ORD'[";" F  S ORDT=$O(^LRO(69,"C",ORD,ORDT)) Q:ORDT<1  S ORSN=0 F  S ORSN=$O(^LRO(69,"C",ORD,ORDT,ORSN)) Q:ORSN<1  D SN ;Early CPRS when only LR# stored
"RTN","LR7OR1",46,0)
 . I ORD[";" S ORDT=$P(ORD,";",2),ORSN=$P(ORD,";",3) I ORDT,ORSN D SN
"RTN","LR7OR1",47,0)
 I SUB["CH" D CH^LR7OR2(SDATE,EDATE,$G(TEST),COUNT,$G(SPEC),$G(UNVER))
"RTN","LR7OR1",48,0)
 I SUB["MI" D MI(SDATE,EDATE,COUNT,$G(SPEC))
"RTN","LR7OR1",49,0)
 ;I SUB["BB" D BB(SDATE,EDATE,COUNT,$G(SPEC))
"RTN","LR7OR1",50,0)
 I SUB["AP",'$G(SPEC) D AP(SDATE,EDATE,COUNT)
"RTN","LR7OR1",51,0)
 Q
"RTN","LR7OR1",52,0)
 ;
"RTN","LR7OR1",53,0)
 ;
"RTN","LR7OR1",54,0)
MI(SDATE,EDATE,COUNT,SPEC) ;Get MI Subscript data
"RTN","LR7OR1",55,0)
 Q:'$D(SDATE)  Q:'$D(EDATE)  Q:'$D(COUNT)  Q:'$D(CT1)
"RTN","LR7OR1",56,0)
 K ^TMP("LRX",$J)
"RTN","LR7OR1",57,0)
 S IVDT=SDATE F  S IVDT=$O(^LR(LRDFN,"MI",IVDT)) Q:IVDT<1!(IVDT>EDATE)!(CT1>COUNT)  K LRX S CTR=99,CT1=CT1+1 D MI^LR7OB63A(SPEC) M ^TMP("LRRR",$J,DFN,"MI",IVDT)=^TMP("LRX",$J,69,99,63)
"RTN","LR7OR1",58,0)
 K ^TMP("LRX",$J)
"RTN","LR7OR1",59,0)
 Q
"RTN","LR7OR1",60,0)
 ;
"RTN","LR7OR1",61,0)
 ;
"RTN","LR7OR1",62,0)
BB(SDATE,EDATE,COUNT,SPEC) ;Get BB Subscript data
"RTN","LR7OR1",63,0)
 Q
"RTN","LR7OR1",64,0)
 Q:'$D(SDATE)  Q:'$D(EDATE)  Q:'$D(COUNT)  Q:'$D(CT1)
"RTN","LR7OR1",65,0)
 K ^TMP("LRX",$J)
"RTN","LR7OR1",66,0)
 S IVDT=SDATE F  S IVDT=$O(^LR(LRDFN,"BB",IVDT)) Q:IVDT<1!(IVDT>EDATE)!(CT1>COUNT)  K LRX S CTR=99,CT1=CT1+1 D BB1^LR7OB63(SPEC) M ^TMP("LRRR",$J,DFN,"BB",IVDT)=^TMP("LRX",$J,69,99,63)
"RTN","LR7OR1",67,0)
 K ^TMP("LRX",$J)
"RTN","LR7OR1",68,0)
 Q
"RTN","LR7OR1",69,0)
 ;
"RTN","LR7OR1",70,0)
 ;
"RTN","LR7OR1",71,0)
AP(SDATE,EDATE,COUNT) ;Get AP Subscript data (EM,CY,AU,SP)
"RTN","LR7OR1",72,0)
 N LRSS K ^TMP("LRX",$J)
"RTN","LR7OR1",73,0)
 Q:'$D(SDATE)  Q:'$D(EDATE)  Q:'$D(COUNT)  Q:'$D(CT1)
"RTN","LR7OR1",74,0)
 S CTR=99 D AU^LR7OB63D M ^TMP("LRRR",$J,DFN,"AU")=^TMP("LRX",$J,69,99,63)
"RTN","LR7OR1",75,0)
 F LRSS="EM","CY","SP" S IVDT=SDATE F  S IVDT=$O(^LR(LRDFN,LRSS,IVDT)) Q:IVDT<1!(IVDT>EDATE)!(CT1>COUNT)  K LRX S CTR=99,CT1=CT1+1 D SS^LR7OB63C(LRSS) M ^TMP("LRRR",$J,DFN,LRSS,IVDT)=^TMP("LRX",$J,69,99,63)
"RTN","LR7OR1",76,0)
 K ^TMP("LRX",$J)
"RTN","LR7OR1",77,0)
 Q
"RTN","LR7OR1",78,0)
 ;
"RTN","LR7OR1",79,0)
 ;
"RTN","LR7OR1",80,0)
TEST ;Test the RR entry point
"RTN","LR7OR1",81,0)
 N X1,X2,X3,X4,X5,DIC,%DT,X,Y
"RTN","LR7OR1",82,0)
 K ^TMP("LRRR",$J),^TMP("LRAPI",$J) S (X1,X2,X3,X4,X5)=""
"RTN","LR7OR1",83,0)
 D ^LRDPA Q:'DFN
"RTN","LR7OR1",84,0)
O1 W !,"Select Lab Order #: " R X:DTIME Q:'$T!(X["^")
"RTN","LR7OR1",85,0)
 I $L(X),'$D(^LRO(69,"C",X)) W !!,X_" is not a valid order number." G O1
"RTN","LR7OR1",86,0)
 I $L(X),$D(^LRO(69,"C",X)) S X5=X,DIC=60,DIC(0)="AEQM",DIC("A")="Select Test (optional): " D ^DIC S X3=$S(Y>0:+Y,1:"") Q:Y<0&(X["^")  G T2
"RTN","LR7OR1",87,0)
 S %DT="AETS",%DT("A")="Select Start Date: " D ^%DT S X1=$S(Y>0:Y,1:"") I Y<0,X["^" Q
"RTN","LR7OR1",88,0)
 S %DT="AETS",%DT("A")="Select End Date: " D ^%DT S X2=$S(Y>0:Y,1:"") I Y<0,X["^" Q
"RTN","LR7OR1",89,0)
 S DIC=60,DIC(0)="AEQM",DIC("A")="Look for specific Test: " D ^DIC S X3=$S(Y>0:+Y,1:"") I Y<0,X["^" Q
"RTN","LR7OR1",90,0)
 I 'X3 D
"RTN","LR7OR1",91,0)
T1 . W !,"Enter a lab area to search on (ALL,CH,MI,AP): " R X:DTIME Q:'$T!(X["^")
"RTN","LR7OR1",92,0)
 . IF "ALLCHMIAP"'[X W !!,"Bad input, enter ALL, CH, MI, or AP" G T1
"RTN","LR7OR1",93,0)
 . S X4=$S("ALLCHMIAP"[X:X,1:"")
"RTN","LR7OR1",94,0)
T2 D RR(DFN,X5,X1,X2,X4,X3)
"RTN","LR7OR1",95,0)
 W !!,$S($D(^TMP("LRRR",$J)):"Data found!",1:"NO Data found!")
"RTN","LR7OR1",96,0)
 Q
"RTN","LR7OR1",97,0)
 ;
"RTN","LR7OR1",98,0)
 ;
"RTN","LR7OR1",99,0)
DTRNG ; Date range setup
"RTN","LR7OR1",100,0)
 I $G(EDATE)<$G(SDATE) S X=EDATE,EDATE=SDATE,SDATE=X
"RTN","LR7OR1",101,0)
 I $G(EDATE) S EDATE=$S($L(EDATE,".")=2:EDATE+.000001,1:EDATE+1)
"RTN","LR7OR1",102,0)
 I $G(SDATE) S SDATE=$S($L(SDATE,".")=2:SDATE-.000001,1:SDATE)
"RTN","LR7OR1",103,0)
 S SDATE=$S($G(SDATE):9999999-SDATE,1:9999999),EDATE=$S($G(EDATE):9999999-EDATE,1:1)
"RTN","LR7OR1",104,0)
 S X=EDATE,EDATE=SDATE,SDATE=X
"RTN","LR7OR1",105,0)
 Q
"RTN","LR7OR1",106,0)
 ;
"RTN","LR7OR1",107,0)
 ;
"RTN","LR7OR1",108,0)
SN ; Get the subs
"RTN","LR7OR1",109,0)
 ;
"RTN","LR7OR1",110,0)
 N I,II,III,LRPLSAVE
"RTN","LR7OR1",111,0)
 ;
"RTN","LR7OR1",112,0)
 ; Set flag to not print performing lab in called routines, wait for control returns to this routine.
"RTN","LR7OR1",113,0)
 S LRPLSAVE=1
"RTN","LR7OR1",114,0)
 ;
"RTN","LR7OR1",115,0)
 D 69^LR7OB69(ORDT,ORSN) Q:'$D(^TMP("LRX",$J,69))
"RTN","LR7OR1",116,0)
 ;
"RTN","LR7OR1",117,0)
 ; List performing laboratories
"RTN","LR7OR1",118,0)
 I $G(LRPLSAVE(0)) D
"RTN","LR7OR1",119,0)
 . N CTR,IVDT
"RTN","LR7OR1",120,0)
 . S CTR=LRPLSAVE(0),IVDT=0
"RTN","LR7OR1",121,0)
 . F  S IVDT=$O(LRPLSAVE("CH",IVDT)) Q:IVDT<1  D
"RTN","LR7OR1",122,0)
 . . D PLS^LR7OB63
"RTN","LR7OR1",123,0)
 ;
"RTN","LR7OR1",124,0)
 S II=0
"RTN","LR7OR1",125,0)
 F  S II=$O(^TMP("LRX",$J,69,II)) Q:II<1  D
"RTN","LR7OR1",126,0)
 . S DRAW=$P($G(^TMP("LRX",$J,69,II,68)),"^",4),SS=$P($G(^LRO(68,+$P(^TMP("LRX",$J,69,II),"^",4),0)),"^",2)
"RTN","LR7OR1",127,0)
 . S III=0
"RTN","LR7OR1",128,0)
 . F  S III=$O(^TMP("LRX",$J,69,II,63,III)) Q:III<1  I $S($D(TSTY):$D(TSTY(III)),1:1) D
"RTN","LR7OR1",129,0)
 . . I $P(^TMP("LRX",$J,69,II,63,III),U,6)="" Q
"RTN","LR7OR1",130,0)
 . . S I=III
"RTN","LR7OR1",131,0)
 . . I $D(^TMP("LRRR",$J,DFN,SS,9999999-DRAW,I)) F  S I=I+.00000001 I '$D(^TMP("LRRR",$J,DFN,SS,9999999-DRAW,I)) Q
"RTN","LR7OR1",132,0)
 . . S ^TMP("LRRR",$J,DFN,SS,9999999-DRAW,I)=^TMP("LRX",$J,69,II,63,III)
"RTN","LR7OR1",133,0)
 . I $D(^TMP("LRX",$J,69,II,63,"N")),$O(^TMP("LRRR",$J,DFN,SS,9999999-DRAW,0)) M ^TMP("LRRR",$J,DFN,SS,9999999-DRAW,"N")=^TMP("LRX",$J,69,II,63,"N")
"RTN","LR7OR1",134,0)
 ;
"RTN","LR7OR1",135,0)
 F I="LRPLS","LRPLS-ADDR" K ^TMP(I,$J)
"RTN","LR7OR1",136,0)
 ;
"RTN","LR7OR1",137,0)
 Q
"RTN","LR7OR1",138,0)
 ;
"RTN","LR7OR1",139,0)
 ;
"RTN","LR7OR1",140,0)
LRDFN(IFN,FILEROOT)  ;Get LRDFN
"RTN","LR7OR1",141,0)
 ; IFN=Internal file number
"RTN","LR7OR1",142,0)
 ; FILEROOT=Root of file to get LRDFN (optional) "DPT(" is default
"RTN","LR7OR1",143,0)
 Q:'$G(IFN) ""
"RTN","LR7OR1",144,0)
 I '$L($G(FILEROOT)) S FILEROOT="DPT("
"RTN","LR7OR1",145,0)
 S X=$S($D(@("^"_FILEROOT_+IFN_",""LR"")")):+^("LR"),1:"")
"RTN","LR7OR1",146,0)
 I X,'$D(^LR(X,0)) S X=""
"RTN","LR7OR1",147,0)
 Q X
"RTN","LR7ORB3")
0^31^B97650234
"RTN","LR7ORB3",1,0)
LR7ORB3 ;DALOI/JMC - Lab CPRS Notification Utility ;03/07/13  15:23
"RTN","LR7ORB3",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LR7ORB3",3,0)
 ;
"RTN","LR7ORB3",4,0)
 ; Reference to EN^ORB3 supported by ICR #1362
"RTN","LR7ORB3",5,0)
 ;
"RTN","LR7ORB3",6,0)
 ; ZEXCEPT is used to identify variables which are external to a specific TAG
"RTN","LR7ORB3",7,0)
 ;         used in conjunction with Eclipse M-editor.
"RTN","LR7ORB3",8,0)
 ;
"RTN","LR7ORB3",9,0)
SETUP(LRDFN,LRSS,LRIDT,LRUID) ; Setup a CPRS notification
"RTN","LR7ORB3",10,0)
 ;  Call with LRDFN = file #63 IEN
"RTN","LR7ORB3",11,0)
 ;             LRSS = file #63 subscript
"RTN","LR7ORB3",12,0)
 ;            LRIDT = inverse d/t of entry in file #63
"RTN","LR7ORB3",13,0)
 ;            LRUID = accession's UID
"RTN","LR7ORB3",14,0)
 ;
"RTN","LR7ORB3",15,0)
 ; Only supports CH and MI. AP subscript handled by separate API.
"RTN","LR7ORB3",16,0)
 ;
"RTN","LR7ORB3",17,0)
 N DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,LRC,LRDOCS,LRMORE,LRQUIT,LRTST,LRTYPE,LRX,LRXQA,LRY,X,Y
"RTN","LR7ORB3",18,0)
 ;
"RTN","LR7ORB3",19,0)
 S (LRTYPE,LRXQA,LRY)=""
"RTN","LR7ORB3",20,0)
 ;
"RTN","LR7ORB3",21,0)
 ; Select test to alert
"RTN","LR7ORB3",22,0)
 S LRY=$$SELTEST(LRUID)
"RTN","LR7ORB3",23,0)
 I 'LRY Q LRY
"RTN","LR7ORB3",24,0)
 S LRTST=$P(LRY,"^",2,4)
"RTN","LR7ORB3",25,0)
 ;
"RTN","LR7ORB3",26,0)
 ; Ask user type of CPRS notification to send
"RTN","LR7ORB3",27,0)
 S DIR(0)="SO^1:Lab results available;2:Abnormal lab results;3:Critical lab results"
"RTN","LR7ORB3",28,0)
 D ^DIR
"RTN","LR7ORB3",29,0)
 I $D(DIRUT) Q "0^User aborted"
"RTN","LR7ORB3",30,0)
 E  S LRTYPE=$S(Y=1:3,Y=2:14,1:57)
"RTN","LR7ORB3",31,0)
 ;
"RTN","LR7ORB3",32,0)
 ; Ask user for recipients.
"RTN","LR7ORB3",33,0)
 D GETDOCS(.LRDOCS,LRDFN,LRSS,LRIDT)
"RTN","LR7ORB3",34,0)
 S (LRC,LRXQA)=0
"RTN","LR7ORB3",35,0)
 F  S LRC=$O(LRDOCS(LRC)) Q:LRC<1  S LRXQA(+LRDOCS(LRC))=$P(LRDOCS(LRC),"^",3)
"RTN","LR7ORB3",36,0)
 I $O(LRXQA("")) D
"RTN","LR7ORB3",37,0)
 . N LRJ,LRMSG
"RTN","LR7ORB3",38,0)
 . D CURREC,EN^DDIOL(.LRMSG)
"RTN","LR7ORB3",39,0)
 ;
"RTN","LR7ORB3",40,0)
 S LRMORE=0 D MORE
"RTN","LR7ORB3",41,0)
 I LRMORE D LOOKUP
"RTN","LR7ORB3",42,0)
 I $O(LRXQA(""))'="" S LRXQA=1
"RTN","LR7ORB3",43,0)
 E  S LRY="0^No recipients selected"
"RTN","LR7ORB3",44,0)
 ;
"RTN","LR7ORB3",45,0)
 ; If everything OK then send alert
"RTN","LR7ORB3",46,0)
 I LRTYPE,LRXQA D
"RTN","LR7ORB3",47,0)
 . N LRJ,LRMSG
"RTN","LR7ORB3",48,0)
 . D CURREC,EN^DDIOL(.LRMSG)
"RTN","LR7ORB3",49,0)
 . K DIR
"RTN","LR7ORB3",50,0)
 . S DIR(0)="Y",DIR("A")="Send Alert",DIR("B")="YES"
"RTN","LR7ORB3",51,0)
 . D ^DIR
"RTN","LR7ORB3",52,0)
 . I Y'=1 S LRY="0^Alert Sending Aborted" Q
"RTN","LR7ORB3",53,0)
 . S LRY=$$OR(LRTYPE,LRDFN,LRSS,LRIDT,LRUID,.LRXQA,LRTST)
"RTN","LR7ORB3",54,0)
 ;
"RTN","LR7ORB3",55,0)
 Q LRY
"RTN","LR7ORB3",56,0)
 ;
"RTN","LR7ORB3",57,0)
 ;
"RTN","LR7ORB3",58,0)
 ;
"RTN","LR7ORB3",59,0)
GETDOCS(LRDOCS,LRDFN,LRSS,LRIDT) ; Return PCP(inpatient PC/attending/outpt PC/outpt assoc PC/outpt attending) and ordering provider
"RTN","LR7ORB3",60,0)
 ;
"RTN","LR7ORB3",61,0)
 N DFN,LRDPF,LRX,X
"RTN","LR7ORB3",62,0)
 ;
"RTN","LR7ORB3",63,0)
 S LRDOCS=0
"RTN","LR7ORB3",64,0)
 I LRSS'?1(1"CH",1"MI") Q
"RTN","LR7ORB3",65,0)
 ;
"RTN","LR7ORB3",66,0)
 S LRX=$P($G(^LR(LRDFN,LRSS,LRIDT,0)),"^",$S(LRSS="CH":10,1:7))
"RTN","LR7ORB3",67,0)
 I LRX>0 S LRDOCS=LRDOCS+1,LRDOCS(LRDOCS)=LRX_"^"_$$NAME^XUSER(LRX,"F")_"^"_"Ordering Provider"
"RTN","LR7ORB3",68,0)
 ;
"RTN","LR7ORB3",69,0)
 S LRDPF=$P($G(^LR(LRDFN,0)),"^",2),DFN=$P($G(^LR(LRDFN,0)),"^",3)
"RTN","LR7ORB3",70,0)
 I LRDPF=2 D
"RTN","LR7ORB3",71,0)
 . N LRDT,LRPCP,VADMVT,VAINDT
"RTN","LR7ORB3",72,0)
 . S LRPCP=0
"RTN","LR7ORB3",73,0)
 . S LRDT=$P($G(^LR(LRDFN,LRSS,LRIDT,0)),"^")
"RTN","LR7ORB3",74,0)
 . I LRDT<1 S LRDT=DT
"RTN","LR7ORB3",75,0)
 . S VAINDT=LRDT D ADM^VADPT2
"RTN","LR7ORB3",76,0)
 . I VADMVT D  Q
"RTN","LR7ORB3",77,0)
 . . N VAHOW,VAIN,VAROOT
"RTN","LR7ORB3",78,0)
 . . D INP^VADPT
"RTN","LR7ORB3",79,0)
 . . I VAIN(2) S LRDOCS=LRDOCS+1,LRDOCS(LRDOCS)=VAIN(2)_"^"_"Inpatient Primary Care Provider",LRPCP=1 Q
"RTN","LR7ORB3",80,0)
 . . I VAIN(11) S LRDOCS=LRDOCS+1,LRDOCS(LRDOCS)=VAIN(11)_"^"_"Inpatient Attending Provider",LRPCP=1
"RTN","LR7ORB3",81,0)
 . S LRX=$$OUTPTPR^SDUTL3(DFN,LRDT,1)
"RTN","LR7ORB3",82,0)
 . I LRX>0 S LRDOCS=LRDOCS+1,LRDOCS(LRDOCS)=LRX_"^"_"Outpatient Primary Care Provider",LRPCP=1 Q
"RTN","LR7ORB3",83,0)
 . S LRX=$$OUTPTPR^SDUTL3(DFN,LRDT,2)
"RTN","LR7ORB3",84,0)
 . I LRX>0 S LRDOCS=LRDOCS+1,LRDOCS(LRDOCS)=LRX_"^"_"Outpatient Attending Provider",LRPCP=1
"RTN","LR7ORB3",85,0)
 Q
"RTN","LR7ORB3",86,0)
 ;
"RTN","LR7ORB3",87,0)
 ;
"RTN","LR7ORB3",88,0)
MORE ; Add names or mail groups to the lookup list?
"RTN","LR7ORB3",89,0)
 N DIR,DIRUT,DTOUT,DUOUT,X,Y
"RTN","LR7ORB3",90,0)
 ;
"RTN","LR7ORB3",91,0)
 ;ZEXCEPT: LRMORE,LRQUIT
"RTN","LR7ORB3",92,0)
 ;
"RTN","LR7ORB3",93,0)
 W !
"RTN","LR7ORB3",94,0)
 S LRMORE=1
"RTN","LR7ORB3",95,0)
 S DIR(0)="Y"
"RTN","LR7ORB3",96,0)
 S DIR("A")="Send the alert to additional recipients and/or mail groups"
"RTN","LR7ORB3",97,0)
 S X=$$GET^XPAR("USR^DIV^PKG","LRAPRES1 AP ALERT",1,"Q")
"RTN","LR7ORB3",98,0)
 S DIR("B")=$S(X=1:"YES",1:"NO")
"RTN","LR7ORB3",99,0)
 S DIR("?")="^D AHELP^LR7ORB3"
"RTN","LR7ORB3",100,0)
 D ^DIR
"RTN","LR7ORB3",101,0)
 I Y=0 S LRMORE=0 Q
"RTN","LR7ORB3",102,0)
 I $D(DUOUT)!($D(DTOUT)) S LRQUIT=1
"RTN","LR7ORB3",103,0)
 Q
"RTN","LR7ORB3",104,0)
 ;
"RTN","LR7ORB3",105,0)
 ;
"RTN","LR7ORB3",106,0)
LOOKUP ; Add additional names or mail groups to alert list.
"RTN","LR7ORB3",107,0)
 N DIC,DIR,DIRUT,DTOUT,DUOUT,LRADL,LRDELETE,LRMSG,X,Y
"RTN","LR7ORB3",108,0)
 ;
"RTN","LR7ORB3",109,0)
 ;ZEXCEPT: LRQUIT,LRXQA
"RTN","LR7ORB3",110,0)
 ;
"RTN","LR7ORB3",111,0)
 S LRQUIT=0
"RTN","LR7ORB3",112,0)
 F  D  Q:LRQUIT
"RTN","LR7ORB3",113,0)
 . W !
"RTN","LR7ORB3",114,0)
 . K DIR
"RTN","LR7ORB3",115,0)
 . S LRDELETE=0
"RTN","LR7ORB3",116,0)
 . S DIR(0)="FO^3:30^I X["".""&(X'?1(1""G."",1""g."")1.E) K X"
"RTN","LR7ORB3",117,0)
 . S DIR("A")="Enter name or mail group"
"RTN","LR7ORB3",118,0)
 . S DIR("?",1)="Prefix selection with '-' to delete a recipient"
"RTN","LR7ORB3",119,0)
 . S DIR("?",2)="Enter lastname,firstname OR G.mailgroup OR ^ to exit"
"RTN","LR7ORB3",120,0)
 . S DIR("?")="Enter '??' for additional help and listing of currently selected recipients."
"RTN","LR7ORB3",121,0)
 . S DIR("??")="^D AHELP^LR7ORB3"
"RTN","LR7ORB3",122,0)
 . S DIR("PRE")="I '$D(DTOUT),$E(X)=""-"" S X=$E(X,2,9999),LRDELETE=1"
"RTN","LR7ORB3",123,0)
 . D ^DIR
"RTN","LR7ORB3",124,0)
 . I $D(DIRUT) S LRQUIT=1 Q
"RTN","LR7ORB3",125,0)
 . S LRADL=""
"RTN","LR7ORB3",126,0)
 . I Y?1(1"G.",1"g.")1.E S LRADL="G",X=$P(Y,".",2)
"RTN","LR7ORB3",127,0)
 . K DIC
"RTN","LR7ORB3",128,0)
 . S DIC(0)="EMQZ",DIC=$S(LRADL="G":3.8,1:200)
"RTN","LR7ORB3",129,0)
 . I LRADL="G" S DIC("S")="N LRX S LRX=^(0) I $S($P(LRX,U,2)=""PU"":1,$P($G(^XMB(3.8,+Y,3)),U)=DUZ:1,+$P(LRX,U,6):0,$D(^XMB(3.8,+Y,1,""B"",DUZ)):1,1:0)"
"RTN","LR7ORB3",130,0)
 . D ^DIC
"RTN","LR7ORB3",131,0)
 . Q:Y=-1
"RTN","LR7ORB3",132,0)
 . I LRDELETE D
"RTN","LR7ORB3",133,0)
 . . I LRADL="" K LRXQA($P(Y,"^")) Q
"RTN","LR7ORB3",134,0)
 . . I LRADL="G" K LRXQA("G."_$P(Y,"^",2))
"RTN","LR7ORB3",135,0)
 . E  D
"RTN","LR7ORB3",136,0)
 . . I LRADL="" S LRXQA($P(Y,"^"))="" Q
"RTN","LR7ORB3",137,0)
 . . I LRADL="G" S LRXQA("G."_$P(Y,"^",2))=""
"RTN","LR7ORB3",138,0)
 . K LRMSG
"RTN","LR7ORB3",139,0)
 . S LRMSG=$S(LRADL="G":"Mail group ",1:"User ")_$P(Y,"^",2)_$S(LRDELETE:" deleted from",1:" added to")_" alert list."
"RTN","LR7ORB3",140,0)
 . D EN^DDIOL(LRMSG,"","!!")
"RTN","LR7ORB3",141,0)
 Q
"RTN","LR7ORB3",142,0)
 ;
"RTN","LR7ORB3",143,0)
 ;
"RTN","LR7ORB3",144,0)
AHELP ; Help Frame
"RTN","LR7ORB3",145,0)
 N LRI,LRMSG
"RTN","LR7ORB3",146,0)
 ;
"RTN","LR7ORB3",147,0)
 S LRMSG(1)="Enter either 'Y' or 'N'."
"RTN","LR7ORB3",148,0)
 S LRMSG(2)="If answered 'Yes', you will also have the opportunity to send alerts",LRMSG(2,"F")="!!"
"RTN","LR7ORB3",149,0)
 S LRMSG(3)="to additional recipients and/or mail groups."
"RTN","LR7ORB3",150,0)
 ;
"RTN","LR7ORB3",151,0)
 ; Get list of current recipients
"RTN","LR7ORB3",152,0)
 D CURREC
"RTN","LR7ORB3",153,0)
 ;
"RTN","LR7ORB3",154,0)
 D EN^DDIOL(.LRMSG)
"RTN","LR7ORB3",155,0)
 Q
"RTN","LR7ORB3",156,0)
 ;
"RTN","LR7ORB3",157,0)
 ;
"RTN","LR7ORB3",158,0)
CURREC ; Build list of current recipients.
"RTN","LR7ORB3",159,0)
 ;
"RTN","LR7ORB3",160,0)
 N LRI,LRJ
"RTN","LR7ORB3",161,0)
 ;
"RTN","LR7ORB3",162,0)
 ;ZEXCEPT: LRMSG,LRXQA
"RTN","LR7ORB3",163,0)
 ;
"RTN","LR7ORB3",164,0)
 S LRJ=$O(LRMSG(""),-1)
"RTN","LR7ORB3",165,0)
 ;
"RTN","LR7ORB3",166,0)
 I '$D(LRXQA) S LRJ=LRJ+1,LRMSG(LRJ)="No recipients listed",LRMSG(LRJ,"F")="!!" Q
"RTN","LR7ORB3",167,0)
 ;
"RTN","LR7ORB3",168,0)
 S LRI="",LRJ=LRJ+1,LRMSG(LRJ)="The current recipients will be:",LRMSG(LRJ,"F")="!!"
"RTN","LR7ORB3",169,0)
 F  S LRI=$O(LRXQA(LRI)) Q:LRI=""  D
"RTN","LR7ORB3",170,0)
 . S LRJ=LRJ+1,LRMSG(LRJ)=$S(LRI:$$NAME^XUSER(LRI,"F"),1:LRI)
"RTN","LR7ORB3",171,0)
 . I LRXQA(LRI)'="" S LRMSG(LRJ)=LRMSG(LRJ)_"  ["_LRXQA(LRI)_"]"
"RTN","LR7ORB3",172,0)
 ;
"RTN","LR7ORB3",173,0)
 Q
"RTN","LR7ORB3",174,0)
 ;
"RTN","LR7ORB3",175,0)
 ;
"RTN","LR7ORB3",176,0)
OR(LRTYPE,LRDFN,LRSS,LRIDT,LRUID,LRXQA,LRTST) ; Send OR notification
"RTN","LR7ORB3",177,0)
 ;
"RTN","LR7ORB3",178,0)
 N DFN,LRIENS,LRMSG,LRODT,LROE,LROIFN,LRPREFIX,LRSN,LRX,LRY
"RTN","LR7ORB3",179,0)
 ;
"RTN","LR7ORB3",180,0)
 ; Call with LRTYPE = type OERR notification (currently supports 3, 14, 57)
"RTN","LR7ORB3",181,0)
 ;            LRDFN = file #63 IEN
"RTN","LR7ORB3",182,0)
 ;             LRSS = file #63 subscript
"RTN","LR7ORB3",183,0)
 ;            LRIDT = inverse d/t of entry in file #63
"RTN","LR7ORB3",184,0)
 ;            LRUID = accession's UID
"RTN","LR7ORB3",185,0)
 ;            LRXQA = recipient array
"RTN","LR7ORB3",186,0)
 ;            LRTST = test ien ^ test name being alerted ^ parent test ien
"RTN","LR7ORB3",187,0)
 ;
"RTN","LR7ORB3",188,0)
 ; Only supports CH and MI. AP subscript handled by separate API.
"RTN","LR7ORB3",189,0)
 ;
"RTN","LR7ORB3",190,0)
 I LRSS'?1(1"CH",1"MI") Q "0^Lab Subscript not supported"
"RTN","LR7ORB3",191,0)
 ;
"RTN","LR7ORB3",192,0)
 S DFN=$P(^LR(LRDFN,0),"^",3)
"RTN","LR7ORB3",193,0)
 ;
"RTN","LR7ORB3",194,0)
 S LRPREFIX=$S(LRTYPE=3:"",LRTYPE=14:"Abnormal ",LRTYPE=57:"Critical ",1:"")
"RTN","LR7ORB3",195,0)
 ;
"RTN","LR7ORB3",196,0)
 S LRX=$$CHECKUID^LRWU4(LRUID,LRSS)
"RTN","LR7ORB3",197,0)
 I LRX<1 Q "0^Accession's UID not valid"
"RTN","LR7ORB3",198,0)
 S LRY=$G(^LRO(68,$P(LRX,"^",2),1,$P(LRX,"^",3),1,$P(LRX,"^",4),0))
"RTN","LR7ORB3",199,0)
 S LRODT=+$P(LRY,"^",4),LRSN=+$P(LRY,"^",5),(LROE,LROIFN)=""
"RTN","LR7ORB3",200,0)
 I LRODT,LRSN D
"RTN","LR7ORB3",201,0)
 . N LR6903
"RTN","LR7ORB3",202,0)
 . S LR6903=$O(^LRO(69,LRODT,1,LRSN,2,"B",+LRTST,0))
"RTN","LR7ORB3",203,0)
 . I 'LR6903,$P(LRTST,"^",3) S LR6903=$O(^LRO(69,LRODT,1,LRSN,2,"B",+$P(LRTST,"^",3),0))
"RTN","LR7ORB3",204,0)
 . I LR6903 S LROIFN=$P($G(^LRO(69,LRODT,1,LRSN,2,LR6903,0)),"^",7)
"RTN","LR7ORB3",205,0)
 . I 'LROIFN S LROIFN=$P($G(^LRO(69,LRODT,1,LRSN,0)),"^",11)
"RTN","LR7ORB3",206,0)
 . S LROE=$P($G(^LRO(69,LRODT,1,LRSN,.1)),"^")
"RTN","LR7ORB3",207,0)
 ;
"RTN","LR7ORB3",208,0)
 S LRIENS=LROIFN_"@OR|"_LROE_";"_LRODT_";"_LRSN_";"_LRSS_";"_LRIDT_"@LRCH"
"RTN","LR7ORB3",209,0)
 ;
"RTN","LR7ORB3",210,0)
 I LRSS="CH" D
"RTN","LR7ORB3",211,0)
 . I LRTYPE=14!(LRTYPE=57) S LRMSG=LRPREFIX_"lab results:"
"RTN","LR7ORB3",212,0)
 . E  S LRMSG="Lab results:"
"RTN","LR7ORB3",213,0)
 ;
"RTN","LR7ORB3",214,0)
 I LRSS="MI" D
"RTN","LR7ORB3",215,0)
 . I LRTYPE=14!(LRTYPE=57) S LRMSG=LRPREFIX_"microbiology results:"
"RTN","LR7ORB3",216,0)
 . E  S LRMSG="Microbiology results:"
"RTN","LR7ORB3",217,0)
 ;
"RTN","LR7ORB3",218,0)
 S LRMSG=LRMSG_" - ["_$P(LRTST,"^",2)_"]"
"RTN","LR7ORB3",219,0)
 ;
"RTN","LR7ORB3",220,0)
 ; OERR parameters:
"RTN","LR7ORB3",221,0)
 ;          ORN: notification id (#100.9 ien)
"RTN","LR7ORB3",222,0)
 ;          |      ORBDFN: patient id (#2 ien)
"RTN","LR7ORB3",223,0)
 ;          |      |   ORNUM: order number (#100 ien)
"RTN","LR7ORB3",224,0)
 ;          |      |   |       ORBADUZ: recipient array
"RTN","LR7ORB3",225,0)
 ;          |      |   |       |     ORBPMSG: message text
"RTN","LR7ORB3",226,0)
 ;          |      |   |       |     |     ORBPDATA lab result reference
"RTN","LR7ORB3",227,0)
 ;          |      |   |       |     |     |
"RTN","LR7ORB3",228,0)
 D EN^ORB3(LRTYPE,DFN,LROIFN,.LRXQA,LRMSG,LRIENS)
"RTN","LR7ORB3",229,0)
 ;
"RTN","LR7ORB3",230,0)
 Q "1^Alert Sent"
"RTN","LR7ORB3",231,0)
 ;
"RTN","LR7ORB3",232,0)
 ;
"RTN","LR7ORB3",233,0)
SELTEST(LRUID) ; Select test on accession for alert messsage - screen out workload tests
"RTN","LR7ORB3",234,0)
 ;
"RTN","LR7ORB3",235,0)
 ; Call with LRUID = accession's UID
"RTN","LR7ORB3",236,0)
 ; Returns     LRY = 1^Test IEN^Test name for alert message^Parent Test IEN
"RTN","LR7ORB3",237,0)
 ;                   0^error message
"RTN","LR7ORB3",238,0)
 ;
"RTN","LR7ORB3",239,0)
 N DIC,DIR,DIROUT,DIRUT,DUOUT,LRAA,LRAD,LRADO,LRAN,LRI,LRJ,LRTEST,LRX,LRY,X,Y
"RTN","LR7ORB3",240,0)
 ;
"RTN","LR7ORB3",241,0)
 S LRY=1
"RTN","LR7ORB3",242,0)
 ; Resolve UID to global subscripts.
"RTN","LR7ORB3",243,0)
 S LRX=$$CHECKUID^LRWU4(LRUID)
"RTN","LR7ORB3",244,0)
 I LRX S LRAA=$P(LRX,"^",2),LRAD=$P(LRX,"^",3),LRAN=$P(LRX,"^",4)
"RTN","LR7ORB3",245,0)
 E  S LRY="0^Invalid Accession UID"
"RTN","LR7ORB3",246,0)
 I 'LRY Q LRY
"RTN","LR7ORB3",247,0)
 ;
"RTN","LR7ORB3",248,0)
 ; Build list of tests on accession
"RTN","LR7ORB3",249,0)
 ;  - if accession has rolled over then also check original accession
"RTN","LR7ORB3",250,0)
 S LRADO=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),"^",3)
"RTN","LR7ORB3",251,0)
 F LRJ=1,2 D
"RTN","LR7ORB3",252,0)
 . I LRJ=2,LRAD=LRADO Q
"RTN","LR7ORB3",253,0)
 . I LRJ=2 S LRAD=LRADO
"RTN","LR7ORB3",254,0)
 . S LRI=0
"RTN","LR7ORB3",255,0)
 . F  S LRI=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI)) Q:'LRI  D
"RTN","LR7ORB3",256,0)
 . . I $P(^LAB(60,LRI,0),"^",4)'="WK" S LRTEST(LRI)=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI,0)),"^",9)
"RTN","LR7ORB3",257,0)
 ;
"RTN","LR7ORB3",258,0)
 I '$D(LRTEST) S LRY="O^No tests on accession"
"RTN","LR7ORB3",259,0)
 ;
"RTN","LR7ORB3",260,0)
 I 'LRY Q LRY
"RTN","LR7ORB3",261,0)
 ;
"RTN","LR7ORB3",262,0)
 S DIC="^LAB(60,",DIC(0)="AEMQZ"
"RTN","LR7ORB3",263,0)
 S DIC("A")="Select TEST: ",DIC("S")="I $D(LRTEST(Y))"
"RTN","LR7ORB3",264,0)
 D ^DIC
"RTN","LR7ORB3",265,0)
 I Y<1 S LRY="0^User aborted"
"RTN","LR7ORB3",266,0)
 E  S LRY="1^"_Y(0,0)
"RTN","LR7ORB3",267,0)
 E  S LRY="1^"_+Y_"^"_Y(0,0)_"^"_$G(LRTEST(+Y))
"RTN","LR7ORB3",268,0)
 ;
"RTN","LR7ORB3",269,0)
 Q LRY
"RTN","LR7ORB3",270,0)
 ;
"RTN","LR7ORB3",271,0)
 ;
"RTN","LR7ORB3",272,0)
ASKXQA(LRDFN,LRSS,LRIDT,LRUID,LRDEFAULT) ; Ask if user wants to send a CPRS notification/alert for this accession.
"RTN","LR7ORB3",273,0)
 ;  Call with LRDFN = file #63 IEN
"RTN","LR7ORB3",274,0)
 ;             LRSS = file #63 subscript
"RTN","LR7ORB3",275,0)
 ;            LRIDT = inverse d/t of entry in file #63
"RTN","LR7ORB3",276,0)
 ;            LRUID = accession's UID
"RTN","LR7ORB3",277,0)
 ;        LRDEFAULT = default answer for DIR call (1-NO,2-YES)
"RTN","LR7ORB3",278,0)
 ;
"RTN","LR7ORB3",279,0)
 N DIR,DIRUT,DTOUT,DUOUT,LRY,X,Y
"RTN","LR7ORB3",280,0)
 ;
"RTN","LR7ORB3",281,0)
 S LRDEFAULT=$G(LRDEFAULT)
"RTN","LR7ORB3",282,0)
 S DIR(0)="Y",DIR("A")="Send a CPRS Alert/Notification"
"RTN","LR7ORB3",283,0)
 S DIR("B")=$S(LRDEFAULT=2:"YES",1:"NO")
"RTN","LR7ORB3",284,0)
 D ^DIR
"RTN","LR7ORB3",285,0)
 I Y<1 Q
"RTN","LR7ORB3",286,0)
 ;
"RTN","LR7ORB3",287,0)
 S LRY=$$SETUP(LRDFN,LRSS,LRIDT,LRUID)
"RTN","LR7ORB3",288,0)
 W " ...",$P(LRY,"^",2)
"RTN","LR7ORB3",289,0)
 ;
"RTN","LR7ORB3",290,0)
 Q
"RTN","LR7ORB3",291,0)
 ;
"RTN","LR7ORB3",292,0)
 ;
"RTN","LR7ORB3",293,0)
SENDOR ; Send a CPRS alert for an accession.
"RTN","LR7ORB3",294,0)
 ;  - User is prompted to select the accession and tests.
"RTN","LR7ORB3",295,0)
 ;
"RTN","LR7ORB3",296,0)
 N %ZIS,DIC,DIR,DIROUT,DIRUT,DUOUT,LRAA,LRACC,LRAD,LRAN,LRDFN,LRDPF,LREND,LRIDT,LRLAB,LRSS,LRSTOP,LRUID,LRVBY,LRY,X,Y
"RTN","LR7ORB3",297,0)
 ;
"RTN","LR7ORB3",298,0)
 F  D  Q:LREND!LRSTOP
"RTN","LR7ORB3",299,0)
 . S (LREND,LRSTOP,LRVBY)=0
"RTN","LR7ORB3",300,0)
 . S LRACC="" D ^LRWU4
"RTN","LR7ORB3",301,0)
 . I LRAN<1 S LREND=1 Q
"RTN","LR7ORB3",302,0)
 . I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W !,"Doesn't exist." Q
"RTN","LR7ORB3",303,0)
 . K DIC,LRDFN,LRDPF,LRIDT,LRSS
"RTN","LR7ORB3",304,0)
 . S LRSS=$P(^LRO(68,LRAA,0),"^",2),LRDFN=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),"^"),LRIDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",5)
"RTN","LR7ORB3",305,0)
 . S LRDPF=$P(^LR(LRDFN,0),"^",2)
"RTN","LR7ORB3",306,0)
 . I LRDPF'=2 W !,"CPRS Alerts only support patients from the PATIENT file (#2)" Q
"RTN","LR7ORB3",307,0)
 . S LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^")
"RTN","LR7ORB3",308,0)
 . I LRUID="" W !,"Accession missing associated UID" Q
"RTN","LR7ORB3",309,0)
 . I LRSS=""!(LRIDT<1)!(LRDFN<1) W !,"Incomplete accession - unable to identify results." Q
"RTN","LR7ORB3",310,0)
 . I LRSS'?1(1"CH",1"MI") D  Q
"RTN","LR7ORB3",311,0)
 . . W !,"This option only supports CH and MI subscripted accessions."
"RTN","LR7ORB3",312,0)
 . . W !,"Use option 'Send an AP Alert' [LRAP ALERT] to send AP alerts"
"RTN","LR7ORB3",313,0)
 . I '$$OK2SEND^LA7SRR W !,"This accession has not been released." Q
"RTN","LR7ORB3",314,0)
 . S LRY=$$SETUP(LRDFN,LRSS,LRIDT,LRUID)
"RTN","LR7ORB3",315,0)
 . W " ...",$P(LRY,"^",2)
"RTN","LR7ORB3",316,0)
 ;
"RTN","LR7ORB3",317,0)
 Q
"RTN","LR7OSAP")
0^36^B68882961
"RTN","LR7OSAP",1,0)
LR7OSAP ;DALOI/STAFF - Silent AP rpt (compare to LRAPCUM) ;03/21/13  15:30
"RTN","LR7OSAP",2,0)
 ;;5.2;LAB SERVICE;**121,187,230,256,259,317,350,427**;Sep 27, 1994;Build 33
"RTN","LR7OSAP",3,0)
 ;
"RTN","LR7OSAP",4,0)
GET I '$D(^LR(LRDFN,LRSS)) Q
"RTN","LR7OSAP",5,0)
 N FST,X
"RTN","LR7OSAP",6,0)
 S (A,FST)=0,LRI=LRIN
"RTN","LR7OSAP",7,0)
 F  S LRI=$O(^LR(LRDFN,LRSS,LRI)) Q:'LRI!(CT1>COUNT)!(LRI>LROUT)  S B=$G(^(LRI,0)),CT1=CT1+1 I B D
"RTN","LR7OSAP",8,0)
 . D W
"RTN","LR7OSAP",9,0)
 . S X="",$P(X,"=",GIOM)=""
"RTN","LR7OSAP",10,0)
 . D LN
"RTN","LR7OSAP",11,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,X)
"RTN","LR7OSAP",12,0)
 . D LINE^LR7OSUM4
"RTN","LR7OSAP",13,0)
 ;
"RTN","LR7OSAP",14,0)
 I 'FST D
"RTN","LR7OSAP",15,0)
 . I LRSS="SP",'$D(SUBHEAD("SURGICAL PATHOLOGY")) Q
"RTN","LR7OSAP",16,0)
 . I LRSS="CY",'$D(SUBHEAD("CYTOPATHOLOGY")) Q
"RTN","LR7OSAP",17,0)
 . I LRSS="EM",'$D(SUBHEAD("EM")) Q
"RTN","LR7OSAP",18,0)
 . D LINE^LR7OSUM4,LN
"RTN","LR7OSAP",19,0)
 . S X=GIOM/2-($L(LRAA(1))/2+5)
"RTN","LR7OSAP",20,0)
 . S ^TMP("LRH",$J,LRAA(1))=GCNT
"RTN","LR7OSAP",21,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(X,CCNT,"---- "_LRAA(1)_" ----")
"RTN","LR7OSAP",22,0)
 . D LN
"RTN","LR7OSAP",23,0)
 . S ^TMP("LRC",$J,GCNT,0)="No "_$S(LRSS="SP":"Surgical Pathology",LRSS="CY":"Cytology",LRSS="EM":"EM",1:"")_" reports available for date range ..."
"RTN","LR7OSAP",24,0)
 Q
"RTN","LR7OSAP",25,0)
 ;
"RTN","LR7OSAP",26,0)
 ;
"RTN","LR7OSAP",27,0)
F(PIECE) ;
"RTN","LR7OSAP",28,0)
 ;If PIECE=1, then only get 1st piece; otherwise get whole node
"RTN","LR7OSAP",29,0)
 I '$G(PIECE) D WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_","_LRV_")",79) Q
"RTN","LR7OSAP",30,0)
 S C=0
"RTN","LR7OSAP",31,0)
 F  S C=$O(^LR(LRDFN,LRSS,LRI,LRV,C)) Q:'C  S X=$P(^(C,0),"^") D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,X)
"RTN","LR7OSAP",32,0)
 Q
"RTN","LR7OSAP",33,0)
 ;
"RTN","LR7OSAP",34,0)
 ;
"RTN","LR7OSAP",35,0)
W ; Called from above and LR7OSAP4
"RTN","LR7OSAP",36,0)
 N LR,LRPTR,LRMD,LRTEXT,LRV,LRW,LRX
"RTN","LR7OSAP",37,0)
 I 'FST D
"RTN","LR7OSAP",38,0)
 . D LINE^LR7OSUM4,LN
"RTN","LR7OSAP",39,0)
 . S X=GIOM/2-($L(LRAA(1))/2+5)
"RTN","LR7OSAP",40,0)
 . S ^TMP("LRH",$J,LRAA(1))=GCNT
"RTN","LR7OSAP",41,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(X,CCNT,"---- "_LRAA(1)_" ----")
"RTN","LR7OSAP",42,0)
 I FST D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Next "_LRAA(1)_" Specimen...")
"RTN","LR7OSAP",43,0)
 S FST=1
"RTN","LR7OSAP",44,0)
 ;
"RTN","LR7OSAP",45,0)
 ; Check for TIU document report and use instead and quit
"RTN","LR7OSAP",46,0)
 D TIUCHK^LRAPUTL(.LRPTR,LRDFN,LRSS,LRI)
"RTN","LR7OSAP",47,0)
 I +$G(LRPTR) D  Q
"RTN","LR7OSAP",48,0)
 . N LRCKSUM,LRCNT,LRCNTT,LRENCRYP,LRFLG,LRHFLG,LROR,LRQUIT,LRTXT
"RTN","LR7OSAP",49,0)
 . D MAIN^LR7OSAP3(LRPTR)
"RTN","LR7OSAP",50,0)
 ;
"RTN","LR7OSAP",51,0)
 ; Display reporting lab
"RTN","LR7OSAP",52,0)
 I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2 D
"RTN","LR7OSAP",53,0)
 . S LRX=+$G(^LR(LRDFN,LRSS,LRI,"RF"))
"RTN","LR7OSAP",54,0)
 . I LRX D RL^LR7OSMZU(LRX)
"RTN","LR7OSAP",55,0)
 ;
"RTN","LR7OSAP",56,0)
 S Y=+B
"RTN","LR7OSAP",57,0)
 D D^LRU
"RTN","LR7OSAP",58,0)
 S LRW(1)=Y,Y=$P(B,"^",10)
"RTN","LR7OSAP",59,0)
 D D^LRU
"RTN","LR7OSAP",60,0)
 S LRW(10)=Y,Y=$P(B,"^",3)
"RTN","LR7OSAP",61,0)
 D D^LRU
"RTN","LR7OSAP",62,0)
 S LRW(3)=Y,X=$P(B,"^",2)
"RTN","LR7OSAP",63,0)
 D:X D^LRUA
"RTN","LR7OSAP",64,0)
 S LRW(2)=X,LRW(11)=$P(B,"^",11),X=$P(B,"^",4)
"RTN","LR7OSAP",65,0)
 D:X D^LRUA
"RTN","LR7OSAP",66,0)
 S LRW(4)=X,X=$P(B,"^",7)
"RTN","LR7OSAP",67,0)
 D:X D^LRUA
"RTN","LR7OSAP",68,0)
 S LRW(7)=X
"RTN","LR7OSAP",69,0)
 D LN
"RTN","LR7OSAP",70,0)
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Date Spec taken: "_LRW(1)),^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(38,CCNT,"Pathologist:"_LRW(2))
"RTN","LR7OSAP",71,0)
 D LN
"RTN","LR7OSAP",72,0)
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Date Spec rec'd: "_LRW(10)),^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(38,CCNT,$S(LRSS="SP":"Resident: ",1:"Tech: ")_LRW(4))
"RTN","LR7OSAP",73,0)
 D LN
"RTN","LR7OSAP",74,0)
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,$S($L(LRW(3)):"Date  completed: ",1:"REPORT INCOMPLETE")_LRW(3)),^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(38,CCNT,"Accession #: "_$P(B,"^",6))
"RTN","LR7OSAP",75,0)
 D LN
"RTN","LR7OSAP",76,0)
 S $P(LR("%"),"-",GIOM)=""
"RTN","LR7OSAP",77,0)
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Submitted by: "_$P(B,"^",5)),^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(38,CCNT,"Practitioner:"_LRW(7))
"RTN","LR7OSAP",78,0)
 D LN
"RTN","LR7OSAP",79,0)
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LR("%"))
"RTN","LR7OSAP",80,0)
 ;
"RTN","LR7OSAP",81,0)
 I $D(^LR(LRDFN,LRSS,LRI,.1)) D
"RTN","LR7OSAP",82,0)
 . D LN
"RTN","LR7OSAP",83,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Specimen: ")
"RTN","LR7OSAP",84,0)
 . S LRV=.1
"RTN","LR7OSAP",85,0)
 . D F(1)
"RTN","LR7OSAP",86,0)
 ;
"RTN","LR7OSAP",87,0)
 ; Don't show anymore data if not verified.
"RTN","LR7OSAP",88,0)
 I LRW(11)="" D  Q
"RTN","LR7OSAP",89,0)
 . D A,LN
"RTN","LR7OSAP",90,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Report not verified")
"RTN","LR7OSAP",91,0)
 ;
"RTN","LR7OSAP",92,0)
 I $P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),"^",4) D
"RTN","LR7OSAP",93,0)
 . D LN
"RTN","LR7OSAP",94,0)
 . S LRTEXT="SUPPLEMENTARY REPORT HAS BEEN ADDED"
"RTN","LR7OSAP",95,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(14,CCNT,"*+* "_LRTEXT_" *+*")
"RTN","LR7OSAP",96,0)
 . D LN
"RTN","LR7OSAP",97,0)
 . S LRTEXT="REFER TO BOTTOM OF REPORT"
"RTN","LR7OSAP",98,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(19,CCNT,"*+* "_LRTEXT_" *+*")
"RTN","LR7OSAP",99,0)
 . D LN
"RTN","LR7OSAP",100,0)
 ;
"RTN","LR7OSAP",101,0)
 I $D(^LR(LRDFN,LRSS,LRI,.2)) D
"RTN","LR7OSAP",102,0)
 . D LN
"RTN","LR7OSAP",103,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Brief Clinical History:")
"RTN","LR7OSAP",104,0)
 . S LRV=.2 D F()
"RTN","LR7OSAP",105,0)
 ;
"RTN","LR7OSAP",106,0)
 I $D(^LR(LRDFN,LRSS,LRI,.3)) D
"RTN","LR7OSAP",107,0)
 . D LN
"RTN","LR7OSAP",108,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Preoperative Diagnosis:")
"RTN","LR7OSAP",109,0)
 . S LRV=.3 D F()
"RTN","LR7OSAP",110,0)
 ;
"RTN","LR7OSAP",111,0)
 I $D(^LR(LRDFN,LRSS,LRI,.4)) D
"RTN","LR7OSAP",112,0)
 . D LN
"RTN","LR7OSAP",113,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Operative Findings:")
"RTN","LR7OSAP",114,0)
 . S LRV=.4 D F()
"RTN","LR7OSAP",115,0)
 ;
"RTN","LR7OSAP",116,0)
 I $D(^LR(LRDFN,LRSS,LRI,.5)) D
"RTN","LR7OSAP",117,0)
 . D LN
"RTN","LR7OSAP",118,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Postoperative Diagnosis:")
"RTN","LR7OSAP",119,0)
 . S LRV=.5 D F()
"RTN","LR7OSAP",120,0)
 ;
"RTN","LR7OSAP",121,0)
 D SET^LRUA
"RTN","LR7OSAP",122,0)
 ;
"RTN","LR7OSAP",123,0)
 I $O(^LR(LRDFN,LRSS,LRI,1.3,0)) D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LR(69.2,.13)) I $P($G(^LR(LRDFN,LRSS,LRI,6,0)),U,4) S LR(0)=6 D MOD^LR7OSAP1
"RTN","LR7OSAP",124,0)
 S LRV=1.3
"RTN","LR7OSAP",125,0)
 D F()
"RTN","LR7OSAP",126,0)
 ;
"RTN","LR7OSAP",127,0)
 I $O(^LR(LRDFN,LRSS,LRI,1,0)) D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LR(69.2,.03)) I $P($G(^LR(LRDFN,LRSS,LRI,7,0)),U,4) S LR(0)=7 D MOD^LR7OSAP1
"RTN","LR7OSAP",128,0)
 S LRV=1
"RTN","LR7OSAP",129,0)
 D F()
"RTN","LR7OSAP",130,0)
 ;
"RTN","LR7OSAP",131,0)
 I $O(^LR(LRDFN,LRSS,LRI,1.1,0)) D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LR(69.2,.04)_" (Date Spec taken: "_LRW(1)_")") I $P($G(^LR(LRDFN,LRSS,LRI,4,0)),U,4) S LR(0)=4 D MOD^LR7OSAP1
"RTN","LR7OSAP",132,0)
 S LRV=1.1
"RTN","LR7OSAP",133,0)
 D F()
"RTN","LR7OSAP",134,0)
 ;
"RTN","LR7OSAP",135,0)
 I $O(^LR(LRDFN,LRSS,LRI,1.4,0)) D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LR(69.2,.14)) I $P($G(^LR(LRDFN,LRSS,LRI,5,0)),U,4) S LR(0)=5 D MOD^LR7OSAP1
"RTN","LR7OSAP",136,0)
 S LRV=1.4
"RTN","LR7OSAP",137,0)
 D F()
"RTN","LR7OSAP",138,0)
 ;
"RTN","LR7OSAP",139,0)
 I $O(^LR(LRDFN,LRSS,LRI,1.2,0)) D
"RTN","LR7OSAP",140,0)
 . D LN
"RTN","LR7OSAP",141,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Supplementary Report:")
"RTN","LR7OSAP",142,0)
 . S C=0 F  S C=$O(^LR(LRDFN,LRSS,LRI,1.2,C)) Q:'C  D
"RTN","LR7OSAP",143,0)
 .. S X=^LR(LRDFN,LRSS,LRI,1.2,C,0),Y=+X,X=$P(X,U,2)
"RTN","LR7OSAP",144,0)
 .. ;Don't even print supp date if supp is not released
"RTN","LR7OSAP",145,0)
 .. Q:'X
"RTN","LR7OSAP",146,0)
 .. D D^LRU,LN
"RTN","LR7OSAP",147,0)
 .. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,"Date: "_Y)
"RTN","LR7OSAP",148,0)
 .. I 'X S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(1,CCNT," not verified")
"RTN","LR7OSAP",149,0)
 .. I $O(^LR(LRDFN,LRSS,LRI,1.2,C,2,0)) D MODSR^LR7OSAP1
"RTN","LR7OSAP",150,0)
 .. D:X U
"RTN","LR7OSAP",151,0)
 I $D(^LR(LRDFN,LRSS,LRI,2)) D B
"RTN","LR7OSAP",152,0)
 ;
"RTN","LR7OSAP",153,0)
 ; DALOI/LMT - LR,427 - Removed comments from report to restore pre-LR,350 behavior
"RTN","LR7OSAP",154,0)
 ;I $D(^LR(LRDFN,LRSS,LRI,99)) D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Comments:") S LRV=99 D F(1)
"RTN","LR7OSAP",155,0)
 ;
"RTN","LR7OSAP",156,0)
 ; List performing labs
"RTN","LR7OSAP",157,0)
 D PPL^LR7OSMZ1(LRDFN,LRSS,LRI)
"RTN","LR7OSAP",158,0)
 ;
"RTN","LR7OSAP",159,0)
 Q
"RTN","LR7OSAP",160,0)
 ;
"RTN","LR7OSAP",161,0)
 ;
"RTN","LR7OSAP",162,0)
U ;
"RTN","LR7OSAP",163,0)
 D WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_",1.2,"_C_",1)",79)
"RTN","LR7OSAP",164,0)
 Q
"RTN","LR7OSAP",165,0)
 ;
"RTN","LR7OSAP",166,0)
 ;
"RTN","LR7OSAP",167,0)
B ;
"RTN","LR7OSAP",168,0)
 S C=0
"RTN","LR7OSAP",169,0)
 F  S C=$O(^LR(LRDFN,LRSS,LRI,2,C)) Q:'C  D SP
"RTN","LR7OSAP",170,0)
 Q
"RTN","LR7OSAP",171,0)
 ;
"RTN","LR7OSAP",172,0)
 ;
"RTN","LR7OSAP",173,0)
SP ;
"RTN","LR7OSAP",174,0)
 S G=0
"RTN","LR7OSAP",175,0)
 F  S G=$O(^LR(LRDFN,LRSS,LRI,2,C,5,G)) Q:'G  S X=^(G,0),Y=$P(X,"^",2),E=$P(X,"^",3),E(1)=$P(X,"^")_":",E(1)=$P($P($G(LR(LRSS)),E(1),2),";") D D^LRU S T(2)=Y D WP
"RTN","LR7OSAP",176,0)
 Q
"RTN","LR7OSAP",177,0)
 ;
"RTN","LR7OSAP",178,0)
 ;
"RTN","LR7OSAP",179,0)
WP ;
"RTN","LR7OSAP",180,0)
 D LN
"RTN","LR7OSAP",181,0)
 S X=E(1)_" "_E_" Date: "_T(2)_" ",^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,X)
"RTN","LR7OSAP",182,0)
 D WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_",2,"_C_",5,"_G_",1)",79)
"RTN","LR7OSAP",183,0)
 Q
"RTN","LR7OSAP",184,0)
 ;
"RTN","LR7OSAP",185,0)
 ;
"RTN","LR7OSAP",186,0)
A ;
"RTN","LR7OSAP",187,0)
 D WRAP^LR7OSAP1("^LR("_LRDFN_","""_LRSS_""","_LRI_",97)",79)
"RTN","LR7OSAP",188,0)
 Q
"RTN","LR7OSAP",189,0)
 ;
"RTN","LR7OSAP",190,0)
 ;
"RTN","LR7OSAP",191,0)
LN ;Increment the counter
"RTN","LR7OSAP",192,0)
 S GCNT=GCNT+1,CCNT=1
"RTN","LR7OSAP",193,0)
 Q
"RTN","LR7OSAP",194,0)
 ;
"RTN","LR7OSAP",195,0)
 ;
"RTN","LR7OSAP",196,0)
EN ; Get AP results
"RTN","LR7OSAP",197,0)
 ; Called by LR7OSUM
"RTN","LR7OSAP",198,0)
 ;
"RTN","LR7OSAP",199,0)
 N GIOM
"RTN","LR7OSAP",200,0)
 S GIOM=$G(LRGIOM)
"RTN","LR7OSAP",201,0)
 I GIOM="" D
"RTN","LR7OSAP",202,0)
 . S GIOM=$$GET^XPAR("USR^DIV^PKG","LR AP GUI REPORT RIGHT MARGIN",1,"Q")
"RTN","LR7OSAP",203,0)
 . I GIOM="" S GIOM=80
"RTN","LR7OSAP",204,0)
 ;
"RTN","LR7OSAP",205,0)
 ; Display "Printed at:" notice
"RTN","LR7OSAP",206,0)
 I '$O(^TMP("LRC",$J,0)),$$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1 D PFAC^LR7OSMZU
"RTN","LR7OSAP",207,0)
 ;
"RTN","LR7OSAP",208,0)
 I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("SURGICAL PATHOLOGY"))) D SPA
"RTN","LR7OSAP",209,0)
 I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("CYTOPATHOLOGY"))) D CY
"RTN","LR7OSAP",210,0)
 I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("EM"))) D EM
"RTN","LR7OSAP",211,0)
 I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("AUTOPSY"))) D AU
"RTN","LR7OSAP",212,0)
 Q
"RTN","LR7OSAP",213,0)
 ;
"RTN","LR7OSAP",214,0)
 ;
"RTN","LR7OSAP",215,0)
CY ; Cytology results
"RTN","LR7OSAP",216,0)
 ;
"RTN","LR7OSAP",217,0)
 I '$D(^LR(LRDFN,"CY")) D  Q
"RTN","LR7OSAP",218,0)
 . I '$D(SUBHEAD("CYTOPATHOLOGY")) Q
"RTN","LR7OSAP",219,0)
 . D LINE^LR7OSUM4
"RTN","LR7OSAP",220,0)
 . D LN S ^TMP("LRC",$J,GCNT,0)="No Cytology reports available..."
"RTN","LR7OSAP",221,0)
 ;
"RTN","LR7OSAP",222,0)
 S LRSS="CY",LRAA(1)="CYTOPATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
"RTN","LR7OSAP",223,0)
 D GET
"RTN","LR7OSAP",224,0)
 Q
"RTN","LR7OSAP",225,0)
 ;
"RTN","LR7OSAP",226,0)
 ;
"RTN","LR7OSAP",227,0)
SPA ; Surgical Pathology results
"RTN","LR7OSAP",228,0)
 ;
"RTN","LR7OSAP",229,0)
 I '$D(^LR(LRDFN,"SP")) D  Q
"RTN","LR7OSAP",230,0)
 . I '$D(SUBHEAD("SURGICAL PATHOLOGY")) Q
"RTN","LR7OSAP",231,0)
 . D LINE^LR7OSUM4
"RTN","LR7OSAP",232,0)
 . D LN S ^TMP("LRC",$J,GCNT,0)="No Surgical Pathology reports available..."
"RTN","LR7OSAP",233,0)
 ;
"RTN","LR7OSAP",234,0)
 S LRSS="SP",LRAA(1)="SURGICAL PATHOLOGY",LRAA=+$O(^LRO(68,"B",LRAA(1),0)) S:'LRAA LRAA=$$FIND(LRSS)
"RTN","LR7OSAP",235,0)
 D GET
"RTN","LR7OSAP",236,0)
 Q
"RTN","LR7OSAP",237,0)
 ;
"RTN","LR7OSAP",238,0)
 ;
"RTN","LR7OSAP",239,0)
EM ; Electron Microscopy results
"RTN","LR7OSAP",240,0)
 ;
"RTN","LR7OSAP",241,0)
 I '$D(^LR(LRDFN,"EM")) D  Q
"RTN","LR7OSAP",242,0)
 . I '$D(SUBHEAD("EM")) Q
"RTN","LR7OSAP",243,0)
 . D LINE^LR7OSUM4
"RTN","LR7OSAP",244,0)
 . D LN S ^TMP("LRC",$J,GCNT,0)="No EM reports available..."
"RTN","LR7OSAP",245,0)
 ;
"RTN","LR7OSAP",246,0)
 S LRSS="EM",LRAA(1)="ELECTRON MICROSCOPY",LRAA=+$O(^LRO(68,"B","EM",0)) S:'LRAA LRAA=$$FIND(LRSS)
"RTN","LR7OSAP",247,0)
 D GET
"RTN","LR7OSAP",248,0)
 Q
"RTN","LR7OSAP",249,0)
 ;
"RTN","LR7OSAP",250,0)
 ;
"RTN","LR7OSAP",251,0)
AU ; Autopsy results
"RTN","LR7OSAP",252,0)
 ;
"RTN","LR7OSAP",253,0)
 I '$D(^LR(LRDFN,"AU")) D  Q
"RTN","LR7OSAP",254,0)
 . I '$D(SUBHEAD("AUTOPSY")) Q
"RTN","LR7OSAP",255,0)
 . D LINE^LR7OSUM4
"RTN","LR7OSAP",256,0)
 . D LN S ^TMP("LRC",$J,GCNT,0)="No Autopsy report available..."
"RTN","LR7OSAP",257,0)
 ;
"RTN","LR7OSAP",258,0)
 D EN^LR7OSAP2(LRDFN)
"RTN","LR7OSAP",259,0)
 Q
"RTN","LR7OSAP",260,0)
 ;
"RTN","LR7OSAP",261,0)
 ;
"RTN","LR7OSAP",262,0)
FIND(SS) ; Find a valid entry in 68
"RTN","LR7OSAP",263,0)
 ;SS=LRSS value to look for
"RTN","LR7OSAP",264,0)
 N I,Y
"RTN","LR7OSAP",265,0)
 S I=0,Y="" F  S I=$O(^LRO(68,I)) Q:I<1  I $P($G(^LRO(68,I,0)),"^",2)=SS S Y=I Q
"RTN","LR7OSAP",266,0)
 Q Y
"RTN","LR7OSMZ2")
0^35^B47170390
"RTN","LR7OSMZ2",1,0)
LR7OSMZ2 ;DALOI/STAFF - Silent Micro rpt - BACTERIA, SIC/SBC, MIC ;03/13/13  14:31
"RTN","LR7OSMZ2",2,0)
 ;;5.2;LAB SERVICE;**121,244,392,350,427**;Sep 27, 1994;Build 33
"RTN","LR7OSMZ2",3,0)
 ;
"RTN","LR7OSMZ2",4,0)
 ;
"RTN","LR7OSMZ2",5,0)
ANTI ;from LR7OSMZ1
"RTN","LR7OSMZ2",6,0)
 I $P(^LR(LRDFN,"MI",LRIDT,14,0),U,4)>0 D
"RTN","LR7OSMZ2",7,0)
 . D LINE,LINE S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(28,CCNT,"Antibiotic Level(s):")
"RTN","LR7OSMZ2",8,0)
 . D LINE
"RTN","LR7OSMZ2",9,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"ANTIBIOTIC")_$$S^LR7OS(20,CCNT,"CONC RANGE (ug/ml)")_$$S^LR7OS(42,CCNT,"DRAW TIME")
"RTN","LR7OSMZ2",10,0)
 . S B=0
"RTN","LR7OSMZ2",11,0)
 . F  S B=$O(^LR(LRDFN,"MI",LRIDT,14,B)) Q:B<1  S X=^(B,0) D
"RTN","LR7OSMZ2",12,0)
 . . D LINE
"RTN","LR7OSMZ2",13,0)
 . . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,$P(X,U))_$$S^LR7OS(20,CCNT,$P(X,U,3))_$$S^LR7OS(42,CCNT,$$EXTERNAL^DILFD(63.42,1,"",$P(X,U,2)))
"RTN","LR7OSMZ2",14,0)
 . . D LINE
"RTN","LR7OSMZ2",15,0)
 Q
"RTN","LR7OSMZ2",16,0)
 ;
"RTN","LR7OSMZ2",17,0)
 ;
"RTN","LR7OSMZ2",18,0)
BACT ;from LR7OSMZ1
"RTN","LR7OSMZ2",19,0)
 ;
"RTN","LR7OSMZ2",20,0)
 I '$L($P(^LR(LRDFN,"MI",LRIDT,1),U)) Q:'$D(LRWRDVEW)  Q:LRSB'=1
"RTN","LR7OSMZ2",21,0)
 ;
"RTN","LR7OSMZ2",22,0)
 D BUG
"RTN","LR7OSMZ2",23,0)
 I $D(^LR(LRDFN,"MI",LRIDT,2,0)) D FH^LR7OSMZU Q:LREND  D GRAM
"RTN","LR7OSMZ2",24,0)
 ;
"RTN","LR7OSMZ2",25,0)
 I $D(^LR(LRDFN,"MI",LRIDT,25,0)) D FH^LR7OSMZU Q:LREND  D BSMEAR
"RTN","LR7OSMZ2",26,0)
 ;
"RTN","LR7OSMZ2",27,0)
 I $D(^LR(LRDFN,"MI",LRIDT,3,0)) D FH^LR7OSMZU Q:LREND  D BRMK Q:LREND  D BACT^LR7OSMZ5 Q:LREND
"RTN","LR7OSMZ2",28,0)
 ;
"RTN","LR7OSMZ2",29,0)
 I $O(^LR(LRDFN,"MI",LRIDT,4,0)) D  Q:LREND
"RTN","LR7OSMZ2",30,0)
 . D FH^LR7OSMZU Q:LREND
"RTN","LR7OSMZ2",31,0)
 . D LINE S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Bacteriology Remark(s):") S B=0 D
"RTN","LR7OSMZ2",32,0)
 . F  S B=+$O(^LR(LRDFN,"MI",LRIDT,4,B)) Q:B<1  D LINE S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,^LR(LRDFN,"MI",LRIDT,4,B,0))
"RTN","LR7OSMZ2",33,0)
 ;
"RTN","LR7OSMZ2",34,0)
 Q
"RTN","LR7OSMZ2",35,0)
 ;
"RTN","LR7OSMZ2",36,0)
 ;
"RTN","LR7OSMZ2",37,0)
BUG ;
"RTN","LR7OSMZ2",38,0)
 ;
"RTN","LR7OSMZ2",39,0)
 N LRNS,LRTUS,LRUS,X
"RTN","LR7OSMZ2",40,0)
 ;
"RTN","LR7OSMZ2",41,0)
 S X=^LR(LRDFN,"MI",LRIDT,1),LRTUS=$P(X,U,2),DZ=$P(X,U,3),LRUS=$P(X,U,6),LRNS=$P(X,U,5),Y=$P(X,U)
"RTN","LR7OSMZ2",42,0)
 D D^LRU,LINE
"RTN","LR7OSMZ2",43,0)
 ;
"RTN","LR7OSMZ2",44,0)
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"* BACTERIOLOGY "_$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_"   TECH CODE: "_DZ)
"RTN","LR7OSMZ2",45,0)
 S LRPRE=19
"RTN","LR7OSMZ2",46,0)
 D PRE^LR7OSMZU
"RTN","LR7OSMZ2",47,0)
 ;
"RTN","LR7OSMZ2",48,0)
 I LRUS'="" D
"RTN","LR7OSMZ2",49,0)
 . D LINE
"RTN","LR7OSMZ2",50,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"URINE SCREEN: "_$S(LRUS="N":"Negative",LRUS="P":"Positive",1:LRUS))
"RTN","LR7OSMZ2",51,0)
 . I LRNS="" D LINE
"RTN","LR7OSMZ2",52,0)
 ;
"RTN","LR7OSMZ2",53,0)
 I LRNS'="" D
"RTN","LR7OSMZ2",54,0)
 . D LINE
"RTN","LR7OSMZ2",55,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"SPUTUM SCREEN:  "_LRNS)
"RTN","LR7OSMZ2",56,0)
 . D LINE
"RTN","LR7OSMZ2",57,0)
 ;
"RTN","LR7OSMZ2",58,0)
 Q
"RTN","LR7OSMZ2",59,0)
 ;
"RTN","LR7OSMZ2",60,0)
 ;
"RTN","LR7OSMZ2",61,0)
GRAM ;
"RTN","LR7OSMZ2",62,0)
 N CNT,LRGRM
"RTN","LR7OSMZ2",63,0)
 ;
"RTN","LR7OSMZ2",64,0)
 D LINE
"RTN","LR7OSMZ2",65,0)
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"GRAM STAIN:")
"RTN","LR7OSMZ2",66,0)
 S (CNT,LRGRM)=0
"RTN","LR7OSMZ2",67,0)
 F  S LRGRM=+$O(^LR(LRDFN,"MI",LRIDT,2,LRGRM)) Q:LRGRM<1  D
"RTN","LR7OSMZ2",68,0)
 . S X=^LR(LRDFN,"MI",LRIDT,2,LRGRM,0),CNT=CNT+1
"RTN","LR7OSMZ2",69,0)
 . I CNT>1 D LN^LR7OSMZ1 S ^TMP("LRC",$J,GCNT,0)=""
"RTN","LR7OSMZ2",70,0)
 . S ^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(13,CCNT,X)
"RTN","LR7OSMZ2",71,0)
 D LINE
"RTN","LR7OSMZ2",72,0)
 Q
"RTN","LR7OSMZ2",73,0)
 ;
"RTN","LR7OSMZ2",74,0)
 ;
"RTN","LR7OSMZ2",75,0)
BSMEAR ;
"RTN","LR7OSMZ2",76,0)
 ;
"RTN","LR7OSMZ2",77,0)
 D LINE
"RTN","LR7OSMZ2",78,0)
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"BACTERIOLOGY SMEAR/PREP:") S LRMYC=0
"RTN","LR7OSMZ2",79,0)
 F  S LRMYC=+$O(^LR(LRDFN,"MI",LRIDT,25,LRMYC)) Q:LRMYC<1  S X=^(LRMYC,0) D LINE S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(5,CCNT,X)
"RTN","LR7OSMZ2",80,0)
 D LINE
"RTN","LR7OSMZ2",81,0)
 Q
"RTN","LR7OSMZ2",82,0)
 ;
"RTN","LR7OSMZ2",83,0)
 ;
"RTN","LR7OSMZ2",84,0)
BRMK ;
"RTN","LR7OSMZ2",85,0)
 ;
"RTN","LR7OSMZ2",86,0)
 N LRAX,LRBUG
"RTN","LR7OSMZ2",87,0)
 ;
"RTN","LR7OSMZ2",88,0)
 S (LRBUG,LR2ORMOR)=0
"RTN","LR7OSMZ2",89,0)
 F LRAX=1,2 S LRBUG=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1  S:LRAX=2 LR2ORMOR=1
"RTN","LR7OSMZ2",90,0)
 ;
"RTN","LR7OSMZ2",91,0)
 I LRAX'=1 D
"RTN","LR7OSMZ2",92,0)
 . S (LRBUG,LRTSTS)=0
"RTN","LR7OSMZ2",93,0)
 . F LRAX=1:1 S LRBUG=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1  D LST,LINE
"RTN","LR7OSMZ2",94,0)
 ;
"RTN","LR7OSMZ2",95,0)
 Q
"RTN","LR7OSMZ2",96,0)
 ;
"RTN","LR7OSMZ2",97,0)
 ;
"RTN","LR7OSMZ2",98,0)
LST ;
"RTN","LR7OSMZ2",99,0)
 ;
"RTN","LR7OSMZ2",100,0)
 N LRX
"RTN","LR7OSMZ2",101,0)
 S LRX=^LR(LRDFN,"MI",LRIDT,3,LRBUG,0)
"RTN","LR7OSMZ2",102,0)
 S (LRBUG(LRAX),LRORG)=$P(LRX,U),LRQU=$P(LRX,U,2),LRSSD=$P(LRX,U,3,8),LRORG=$P(^LAB(61.2,LRORG,0),U)
"RTN","LR7OSMZ2",103,0)
 ;
"RTN","LR7OSMZ2",104,0)
 I LRSSD'?."^" S LRSIC1=$P(LRSSD,U),LRSBC1=$P(LRSSD,U,2),LRDRTM1=$P(LRSSD,U,3),LRSIC2=$P(LRSSD,U,4),LRSBC2=$P(LRSSD,U,5),LRDRTM2=$P(LRSSD,U,6),LRSSD=1
"RTN","LR7OSMZ2",105,0)
 ;
"RTN","LR7OSMZ2",106,0)
 I LRAX=1 D LINE S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"CULTURE RESULTS: ")
"RTN","LR7OSMZ2",107,0)
 ;
"RTN","LR7OSMZ2",108,0)
 I LRAX>1 D LN^LR7OSMZ1 S ^TMP("LRC",$J,GCNT,0)=""
"RTN","LR7OSMZ2",109,0)
 ;
"RTN","LR7OSMZ2",110,0)
 S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(18,CCNT,$S(LR2ORMOR:$J(LRBUG,2)_". ",1:" ")_LRORG)
"RTN","LR7OSMZ2",111,0)
 ;
"RTN","LR7OSMZ2",112,0)
 ; Display quantity/colony count
"RTN","LR7OSMZ2",113,0)
 I LRQU'="" D
"RTN","LR7OSMZ2",114,0)
 . N LRX
"RTN","LR7OSMZ2",115,0)
 . S LRX=" - Quantity: "_LRQU
"RTN","LR7OSMZ2",116,0)
 . I (GIOM-$X-1)<$L(LRX) D LINE S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(21,CCNT,LRX) Q
"RTN","LR7OSMZ2",117,0)
 . S ^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,LRX)
"RTN","LR7OSMZ2",118,0)
 ;
"RTN","LR7OSMZ2",119,0)
 I LRSSD D SSD
"RTN","LR7OSMZ2",120,0)
 ;
"RTN","LR7OSMZ2",121,0)
 S:$D(^LR(LRDFN,"MI",LRIDT,3,LRBUG,2)) LRTSTS=LRTSTS+1
"RTN","LR7OSMZ2",122,0)
 ;
"RTN","LR7OSMZ2",123,0)
 I $O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,0)) D MIC
"RTN","LR7OSMZ2",124,0)
 ;
"RTN","LR7OSMZ2",125,0)
 I $O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,0)) D CMNT
"RTN","LR7OSMZ2",126,0)
 ;
"RTN","LR7OSMZ2",127,0)
 Q
"RTN","LR7OSMZ2",128,0)
 ;
"RTN","LR7OSMZ2",129,0)
 ;
"RTN","LR7OSMZ2",130,0)
SSD ;
"RTN","LR7OSMZ2",131,0)
 ;
"RTN","LR7OSMZ2",132,0)
 D LINE
"RTN","LR7OSMZ2",133,0)
 S LRDRTM1=$S(LRDRTM1="P":"PEAK",LRDRTM1="T":"TROUGH",1:LRDRTM1),LRDRTM2=$S(LRDRTM2="P":"PEAK",LRDRTM2="T":"TROUGH",1:LRDRTM2)
"RTN","LR7OSMZ2",134,0)
 ;
"RTN","LR7OSMZ2",135,0)
 I LRSIC1'="" D
"RTN","LR7OSMZ2",136,0)
 . D LINE
"RTN","LR7OSMZ2",137,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(20,CCNT,"SIT ")
"RTN","LR7OSMZ2",138,0)
 . S:$L(LRDRTM1) ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,"("_LRDRTM1_")")
"RTN","LR7OSMZ2",139,0)
 . S ^(0)=^(0)_$$S^LR7OS(CCNT,CCNT,": "_LRSIC1)
"RTN","LR7OSMZ2",140,0)
 ;
"RTN","LR7OSMZ2",141,0)
 I LRSBC1'="" D
"RTN","LR7OSMZ2",142,0)
 . D LINE
"RTN","LR7OSMZ2",143,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(20,CCNT,"SBT ")
"RTN","LR7OSMZ2",144,0)
 . S:$L(LRDRTM1) ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,"("_LRDRTM1_")")
"RTN","LR7OSMZ2",145,0)
 . S ^(0)=^(0)_$$S^LR7OS(CCNT,CCNT,": "_LRSBC1)
"RTN","LR7OSMZ2",146,0)
 ;
"RTN","LR7OSMZ2",147,0)
 I LRSIC2'="" D
"RTN","LR7OSMZ2",148,0)
 . D LINE
"RTN","LR7OSMZ2",149,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(20,CCNT,"SIT ")
"RTN","LR7OSMZ2",150,0)
 . S:$L(LRDRTM2) ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,"("_LRDRTM2_")")
"RTN","LR7OSMZ2",151,0)
 . S ^(0)=^(0)_$$S^LR7OS(CCNT,CCNT,": "_LRSIC2)
"RTN","LR7OSMZ2",152,0)
 ;
"RTN","LR7OSMZ2",153,0)
 I LRSBC2'="" D
"RTN","LR7OSMZ2",154,0)
 . D LINE
"RTN","LR7OSMZ2",155,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(20,CCNT,"SBT ")
"RTN","LR7OSMZ2",156,0)
 . S:$L(LRDRTM2) ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,"("_LRDRTM2_")")
"RTN","LR7OSMZ2",157,0)
 . S ^(0)=^(0)_$$S^LR7OS(CCNT,CCNT,": "_LRSBC2)
"RTN","LR7OSMZ2",158,0)
 ;
"RTN","LR7OSMZ2",159,0)
 Q
"RTN","LR7OSMZ2",160,0)
 ;
"RTN","LR7OSMZ2",161,0)
 ;
"RTN","LR7OSMZ2",162,0)
MIC ;
"RTN","LR7OSMZ2",163,0)
 ;
"RTN","LR7OSMZ2",164,0)
 D LINE
"RTN","LR7OSMZ2",165,0)
 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(22,CCNT,"Antibiotic"),B=0
"RTN","LR7OSMZ2",166,0)
 F  S B=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1  I $L($P(^(B,0),U,2,3))>0 S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(39,CCNT,"MIC (ug/ml)")_$$S^LR7OS(54,CCNT,"MBC (ug/ml)") Q
"RTN","LR7OSMZ2",167,0)
 ;
"RTN","LR7OSMZ2",168,0)
 S B=0
"RTN","LR7OSMZ2",169,0)
 F  S B=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1  D
"RTN","LR7OSMZ2",170,0)
 . S X=^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B,0)
"RTN","LR7OSMZ2",171,0)
 . D LINE
"RTN","LR7OSMZ2",172,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(22,CCNT,$P(X,U))_$$S^LR7OS(39,CCNT,$J($P(X,U,2),7))_$$S^LR7OS(54,CCNT,$J($P(X,U,3),7))
"RTN","LR7OSMZ2",173,0)
 ;
"RTN","LR7OSMZ2",174,0)
 Q
"RTN","LR7OSMZ2",175,0)
 ;
"RTN","LR7OSMZ2",176,0)
 ;
"RTN","LR7OSMZ2",177,0)
CMNT ;
"RTN","LR7OSMZ2",178,0)
 ;
"RTN","LR7OSMZ2",179,0)
 N LRX,X,DIWL,DIWR,DIWF,LRIDX
"RTN","LR7OSMZ2",180,0)
 S LRPC=0,DIWL=31,DIWR=GIOM,DIWF="|"
"RTN","LR7OSMZ2",181,0)
 F A=0:1 S LRPC=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC)) Q:LRPC<1  D
"RTN","LR7OSMZ2",182,0)
 . S LRX=^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC,0),X=LRX
"RTN","LR7OSMZ2",183,0)
 . K ^UTILITY($J,"W")
"RTN","LR7OSMZ2",184,0)
 . D ^DIWP
"RTN","LR7OSMZ2",185,0)
 . I A=0,$D(^UTILITY($J,"W",31,1,0)) D
"RTN","LR7OSMZ2",186,0)
 . . D LN^LR7OSMZ1
"RTN","LR7OSMZ2",187,0)
 . . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(22,CCNT,"Comment: "_^UTILITY($J,"W",31,1,0))
"RTN","LR7OSMZ2",188,0)
 . . K ^UTILITY($J,"W",31,1,0)
"RTN","LR7OSMZ2",189,0)
 . S LRIDX=0
"RTN","LR7OSMZ2",190,0)
 . F  S LRIDX=$O(^UTILITY($J,"W",31,LRIDX)) Q:'LRIDX  D
"RTN","LR7OSMZ2",191,0)
 . . Q:'$D(^UTILITY($J,"W",31,LRIDX,0))
"RTN","LR7OSMZ2",192,0)
 . . D LN^LR7OSMZ1
"RTN","LR7OSMZ2",193,0)
 . . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(22,CCNT,"         "_^UTILITY($J,"W",31,LRIDX,0))
"RTN","LR7OSMZ2",194,0)
 . K ^UTILITY($J,"W")
"RTN","LR7OSMZ2",195,0)
 Q
"RTN","LR7OSMZ2",196,0)
 ;
"RTN","LR7OSMZ2",197,0)
 ;
"RTN","LR7OSMZ2",198,0)
LINE ;
"RTN","LR7OSMZ2",199,0)
 D LINE^LR7OSUM4
"RTN","LR7OSMZ2",200,0)
 Q
"RTN","LR7OSUM1")
0^39^B87418148
"RTN","LR7OSUM1",1,0)
LR7OSUM1 ;DALOI/staff - Silent Patient cum cont. ;06/03/13  11:17
"RTN","LR7OSUM1",2,0)
 ;;5.2;LAB SERVICE;**121,187,256,286,384,350,427**;Sep 27, 1994;Build 33
"RTN","LR7OSUM1",3,0)
 ;
"RTN","LR7OSUM1",4,0)
LRIDT ; from LR7OSUM
"RTN","LR7OSUM1",5,0)
 N GIOM,LRDRL
"RTN","LR7OSUM1",6,0)
 S GIOM=$G(LRGIOM)
"RTN","LR7OSUM1",7,0)
 I GIOM="" D
"RTN","LR7OSUM1",8,0)
 . S GIOM=$$GET^XPAR("USR^DIV^PKG","LR CH GUI REPORT RIGHT MARGIN",1,"Q")
"RTN","LR7OSUM1",9,0)
 . I GIOM="" S GIOM=80
"RTN","LR7OSUM1",10,0)
 K ^TMP("LRPLS",$J),^TMP("LRPLS-ADDR",$J),^TMP("LRCMTINDX",$J)
"RTN","LR7OSUM1",11,0)
 ;
"RTN","LR7OSUM1",12,0)
 ; Flag to determine if reporting laboratory is printed on report
"RTN","LR7OSUM1",13,0)
 S LRDRL=$$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2
"RTN","LR7OSUM1",14,0)
 ;
"RTN","LR7OSUM1",15,0)
 F  S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1!(LRIDT>LROUT)!(CT1>COUNT)  I $D(^(LRIDT,0)) S X=^(0),CT1=CT1+1 D LRIIDT
"RTN","LR7OSUM1",16,0)
 D CMTINDX^LR7OSUM2
"RTN","LR7OSUM1",17,0)
 Q
"RTN","LR7OSUM1",18,0)
 ;
"RTN","LR7OSUM1",19,0)
 ;
"RTN","LR7OSUM1",20,0)
LRIIDT ;
"RTN","LR7OSUM1",21,0)
 N LRIIDT,LRAN,LRPROV,LREAL,LRSPM,LRSPM1,LRSUB,LRTLOC,LRTNN,LRTST,LRTSTS,LRVDT,LRVIDT
"RTN","LR7OSUM1",22,0)
 S (LRIIDT,LRVIDT)=$P(X,U,1),LREAL=$P(X,U,2),LRSUB=1,LRTNN=1,LRSPM=$P(X,U,5),LRTLOC=$E($P(X,U,11),1,7),LRVDT=$P(X,U,3),LRAN=$P(X,U,6),LRPROV=$P(X,U,10)
"RTN","LR7OSUM1",23,0)
 ;
"RTN","LR7OSUM1",24,0)
 I LRVDT D  Q
"RTN","LR7OSUM1",25,0)
 . D LRSUB,ORDBY^LR7OSUM2,RELDT^LR7OSUM2
"RTN","LR7OSUM1",26,0)
 . I LRDRL D RL^LR7OSUM2
"RTN","LR7OSUM1",27,0)
 . D PLS^LR7OSUM2
"RTN","LR7OSUM1",28,0)
 ;
"RTN","LR7OSUM1",29,0)
 I LRVDT="" D
"RTN","LR7OSUM1",30,0)
 . D CHKNP,ORDBY^LR7OSUM2
"RTN","LR7OSUM1",31,0)
 . I LRDRL D RL^LR7OSUM2
"RTN","LR7OSUM1",32,0)
 . N OUTCNT
"RTN","LR7OSUM1",33,0)
 . S OUTCNT=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),OUTCNT=OUTCNT+1
"RTN","LR7OSUM1",34,0)
 . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" "
"RTN","LR7OSUM1",35,0)
 ;
"RTN","LR7OSUM1",36,0)
 Q
"RTN","LR7OSUM1",37,0)
 ;
"RTN","LR7OSUM1",38,0)
 ;
"RTN","LR7OSUM1",39,0)
LRSUB ;
"RTN","LR7OSUM1",40,0)
 N LRTRES
"RTN","LR7OSUM1",41,0)
 S LRSUB=1
"RTN","LR7OSUM1",42,0)
 F  S LRSUB=$O(^LR(LRDFN,"CH",LRIDT,LRSUB)) Q:LRSUB<1  D
"RTN","LR7OSUM1",43,0)
 . S X=^LR(LRDFN,"CH",LRIDT,LRSUB)
"RTN","LR7OSUM1",44,0)
 . S LRTRES=$$TSTRES^LRRPU(LRDFN,"CH",LRIDT,LRSUB,"")
"RTN","LR7OSUM1",45,0)
 . I $P(LRTRES,"^",1)="" Q
"RTN","LR7OSUM1",46,0)
 . D SUB1
"RTN","LR7OSUM1",47,0)
 Q
"RTN","LR7OSUM1",48,0)
 ;
"RTN","LR7OSUM1",49,0)
 ;
"RTN","LR7OSUM1",50,0)
SUB1 ;
"RTN","LR7OSUM1",51,0)
 N LRNOFL,LRTSTVAL
"RTN","LR7OSUM1",52,0)
 S LRTSTVAL=$P(LRTRES,U,1)
"RTN","LR7OSUM1",53,0)
 S LRNOFL="",LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";"_1,0))
"RTN","LR7OSUM1",54,0)
 Q:LRTST=""
"RTN","LR7OSUM1",55,0)
 Q:"IN"[$P(^LAB(60,LRTST,0),U,3)
"RTN","LR7OSUM1",56,0)
 I '$D(^LAB(64.5,"AC",LRSUB)) D MISC Q
"RTN","LR7OSUM1",57,0)
 K LRNON
"RTN","LR7OSUM1",58,0)
 D LRMH
"RTN","LR7OSUM1",59,0)
 I '$D(LRNON) D MISC
"RTN","LR7OSUM1",60,0)
 Q
"RTN","LR7OSUM1",61,0)
 ;
"RTN","LR7OSUM1",62,0)
 ;
"RTN","LR7OSUM1",63,0)
LRMH ;
"RTN","LR7OSUM1",64,0)
 S LRMH=0
"RTN","LR7OSUM1",65,0)
 F  S LRMH=$O(^LAB(64.5,"AC",LRSUB,1,LRMH)) Q:LRMH<1  D LRSH
"RTN","LR7OSUM1",66,0)
 Q
"RTN","LR7OSUM1",67,0)
 ;
"RTN","LR7OSUM1",68,0)
 ;
"RTN","LR7OSUM1",69,0)
LRSH ;
"RTN","LR7OSUM1",70,0)
 S LRSH=0
"RTN","LR7OSUM1",71,0)
 F  S LRSH=$O(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH)) Q:LRSH<1  D TST
"RTN","LR7OSUM1",72,0)
 Q
"RTN","LR7OSUM1",73,0)
 ;
"RTN","LR7OSUM1",74,0)
 ;
"RTN","LR7OSUM1",75,0)
TST ;
"RTN","LR7OSUM1",76,0)
 S LRTSTS=0
"RTN","LR7OSUM1",77,0)
 F  S LRTSTS=$O(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH,LRTSTS)) Q:'LRTSTS  S LRSPM1=^(LRTSTS) D TST1
"RTN","LR7OSUM1",78,0)
 Q
"RTN","LR7OSUM1",79,0)
 ;
"RTN","LR7OSUM1",80,0)
 ;
"RTN","LR7OSUM1",81,0)
TST1 ;
"RTN","LR7OSUM1",82,0)
 Q:LRSPM'=LRSPM1
"RTN","LR7OSUM1",83,0)
 ;
"RTN","LR7OSUM1",84,0)
SBSET ;
"RTN","LR7OSUM1",85,0)
 N LRMHN,LRTF
"RTN","LR7OSUM1",86,0)
 S LRMHN=$P(^LAB(64.5,1,1,LRMH,0),U,1),LRTF=^(1,LRSH,0),$P(LRTF,U,4)=$P(LRTF,U,3),$P(LRTF,U,3)=$P(^(1,0),U,4),LRNON=1
"RTN","LR7OSUM1",87,0)
 Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD($P(LRTF,"^"))))
"RTN","LR7OSUM1",88,0)
 ;
"RTN","LR7OSUM1",89,0)
 ;**  LRTE=Total minor headings
"RTN","LR7OSUM1",90,0)
 ;** LRMHN=Major heading name^TE^Lab performing tests
"RTN","LR7OSUM1",91,0)
 ;**  LRTF=Minor header^Profile specimen^Total tests^Type of display
"RTN","LR7OSUM1",92,0)
 ;
"RTN","LR7OSUM1",93,0)
 S LRIIDT=LRVIDT
"RTN","LR7OSUM1",94,0)
 S:'$D(^TMP($J,LRDFN,LRMH)) ^(LRMH)=LRMHN
"RTN","LR7OSUM1",95,0)
 S:'$D(^TMP($J,LRDFN,LRMH,LRSH))!($D(^(LRSH))=10) ^(LRSH)=LRTF_U
"RTN","LR7OSUM1",96,0)
 S:'$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,0)) ^(0)=LRTLOC_U_LRVIDT_U_LRVDT_U_LRAN_U_LRIDT_U_LREAL
"RTN","LR7OSUM1",97,0)
 ;
"RTN","LR7OSUM1",98,0)
LRTSTVAL ;
"RTN","LR7OSUM1",99,0)
 ;
"RTN","LR7OSUM1",100,0)
 N TST
"RTN","LR7OSUM1",101,0)
 S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,LRTSTS)=$P(LRTRES,"^")_"^"_$P(LRTRES,"^",2)
"RTN","LR7OSUM1",102,0)
 S X=$P($G(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRTSTS,0)),"^",3)
"RTN","LR7OSUM1",103,0)
 I X'="" S ^TMP("LRT",$J,X)=$P(LRTF,"^")
"RTN","LR7OSUM1",104,0)
 ;
"RTN","LR7OSUM1",105,0)
 ; Check for comment on specimen and put in TMP global on first pass
"RTN","LR7OSUM1",106,0)
 I $D(^LR(LRDFN,"CH",LRIDT,1,0)),'$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",0)) D TEXT
"RTN","LR7OSUM1",107,0)
 ;
"RTN","LR7OSUM1",108,0)
 ; Check if individual result's unit/normals different from test units/normals
"RTN","LR7OSUM1",109,0)
 I $P(LRTRES,"^")'?1(1"pending",1"comment",1"canc") D CHKUN
"RTN","LR7OSUM1",110,0)
 ;
"RTN","LR7OSUM1",111,0)
 S TST=$S($P($G(^LAB(60,LRTST,.1)),"^")'="":$P(^(.1),"^"),1:$P(^LAB(60,LRTST,0),"^"))
"RTN","LR7OSUM1",112,0)
 I $O(^LAB(60,LRTST,1,LRSPM,1,0)),'$D(^TMP($J,"EVAL",LRTST,LRSPM)) D
"RTN","LR7OSUM1",113,0)
 . S ^TMP($J,"EVAL",LRTST,LRSPM)=""
"RTN","LR7OSUM1",114,0)
 . N I,L,X
"RTN","LR7OSUM1",115,0)
 . S I=0
"RTN","LR7OSUM1",116,0)
 . S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1,^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Evaluation for "_TST_":"
"RTN","LR7OSUM1",117,0)
 . F  S I=$O(^LAB(60,LRTST,1,LRSPM,1,I)) Q:'I  S X=^(I,0) S L=L+1,^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=X
"RTN","LR7OSUM1",118,0)
 . S ^TMP("LRCMTINDX",$J,LRIDT)=""
"RTN","LR7OSUM1",119,0)
 ;
"RTN","LR7OSUM1",120,0)
 ; Save performing lab ien in list
"RTN","LR7OSUM1",121,0)
 I $P(LRTRES,U,6) S ^TMP("LRPLS",$J,LRMH,LRSH,$P(LRTRES,U,6),TST)="",^TMP("LRCMTINDX",$J,LRIDT)=""
"RTN","LR7OSUM1",122,0)
 Q
"RTN","LR7OSUM1",123,0)
 ;
"RTN","LR7OSUM1",124,0)
 ;
"RTN","LR7OSUM1",125,0)
MISC ;
"RTN","LR7OSUM1",126,0)
 Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD("MISCELLANEOUS TESTS")))
"RTN","LR7OSUM1",127,0)
 S LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";"_1,0))
"RTN","LR7OSUM1",128,0)
 Q:LRTST=""
"RTN","LR7OSUM1",129,0)
 Q:"IN"[$P(^LAB(60,LRTST,0),U,3)
"RTN","LR7OSUM1",130,0)
 N LRTOP,TST
"RTN","LR7OSUM1",131,0)
 S LRTOP=LRSPM
"RTN","LR7OSUM1",132,0)
 ;
"RTN","LR7OSUM1",133,0)
 S:'$D(^TMP($J,LRDFN,"MISC",LRIDT,0)) ^(0)=LRIDT_U_LRVIDT_U_LRVDT_U_LRAN_U_LRSPM_U_LREAL
"RTN","LR7OSUM1",134,0)
 S ^TMP($J,LRDFN,"MISC",LRIDT,LRTNN)=$P(LRTRES,"^")_U_LRSPM_U_LRTST_U_$P(LRTRES,"^",2)_U_LRSUB_U_$P(LRTRES,"^",3,6)
"RTN","LR7OSUM1",135,0)
 ;
"RTN","LR7OSUM1",136,0)
 S TST=$P($G(^LAB(60,LRTST,.1)),"^")
"RTN","LR7OSUM1",137,0)
 I TST="" S TST=$P(^LAB(60,LRTST,0),"^")
"RTN","LR7OSUM1",138,0)
 S ^TMP("LRT",$J,TST)="MISCELLANEOUS TESTS"
"RTN","LR7OSUM1",139,0)
 ;
"RTN","LR7OSUM1",140,0)
 ; Grab specimen comments
"RTN","LR7OSUM1",141,0)
 D GSC
"RTN","LR7OSUM1",142,0)
 ;
"RTN","LR7OSUM1",143,0)
 ; Grab test interpretation
"RTN","LR7OSUM1",144,0)
 I $O(^LAB(60,LRTST,1,LRSPM,1,0)) D
"RTN","LR7OSUM1",145,0)
 . N I,L,X
"RTN","LR7OSUM1",146,0)
 . S I=0
"RTN","LR7OSUM1",147,0)
 . S:'$D(^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)) ^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)=""
"RTN","LR7OSUM1",148,0)
 . S L=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),L=L+1
"RTN","LR7OSUM1",149,0)
 . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)="Evaluation for "_TST_":"
"RTN","LR7OSUM1",150,0)
 . F  S I=$O(^LAB(60,LRTST,1,LRSPM,1,I)) Q:'I  S X=^(I,0) S L=L+1,^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)=X
"RTN","LR7OSUM1",151,0)
 ;
"RTN","LR7OSUM1",152,0)
 ; Save performing lab ien in list
"RTN","LR7OSUM1",153,0)
 I $P(LRTRES,U,6) S ^TMP("LRPLS",$J,"MISC",$P(LRTRES,U,6),TST)=""
"RTN","LR7OSUM1",154,0)
 ;
"RTN","LR7OSUM1",155,0)
 S LRTNN=LRTNN+1
"RTN","LR7OSUM1",156,0)
 Q
"RTN","LR7OSUM1",157,0)
 ;
"RTN","LR7OSUM1",158,0)
 ;
"RTN","LR7OSUM1",159,0)
TEXT ;
"RTN","LR7OSUM1",160,0)
 N LRYESCOM,M,N
"RTN","LR7OSUM1",161,0)
 S LRYESCOM=0
"RTN","LR7OSUM1",162,0)
 S M=0
"RTN","LR7OSUM1",163,0)
 F  S M=$O(^LR(LRDFN,"CH",LRIDT,1,M)) Q:M<1!(LRYESCOM)  F N=1:1:$L(^LR(LRDFN,"CH",LRIDT,1,M,0)) Q:LRYESCOM  S:$E(^(0),N)'[$C(32) LRYESCOM=1
"RTN","LR7OSUM1",164,0)
 Q:'LRYESCOM
"RTN","LR7OSUM1",165,0)
 S L=0
"RTN","LR7OSUM1",166,0)
 F  S L=$O(^LR(LRDFN,"CH",LRIDT,1,L)) Q:L<1  S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
"RTN","LR7OSUM1",167,0)
 S ^TMP("LRCMTINDX",$J,LRIDT)=""
"RTN","LR7OSUM1",168,0)
 Q
"RTN","LR7OSUM1",169,0)
 ;
"RTN","LR7OSUM1",170,0)
 ;
"RTN","LR7OSUM1",171,0)
MICRO ;from LR7OSUM
"RTN","LR7OSUM1",172,0)
 Q:'$D(^LR(LRDFN,"MI"))
"RTN","LR7OSUM1",173,0)
 N GIOM,MICROCNT
"RTN","LR7OSUM1",174,0)
 S GIOM=$G(LRGIOM)
"RTN","LR7OSUM1",175,0)
 I GIOM="" D
"RTN","LR7OSUM1",176,0)
 . S GIOM=$$GET^XPAR("USR^DIV^PKG","LR MI GUI REPORT RIGHT MARGIN",1,"Q")
"RTN","LR7OSUM1",177,0)
 . I GIOM="" S GIOM=80
"RTN","LR7OSUM1",178,0)
 S:'$D(LRUNKNOW) LRUNKNOW=$P(^LAB(69.9,1,1),U,5)
"RTN","LR7OSUM1",179,0)
 S (LRONESPC,LRONETST)="",LREND=0,MICROCNT=GCNT+1
"RTN","LR7OSUM1",180,0)
 I $O(^LR(LRDFN,"MI",0)) S ^TMP("LRH",$J,"MICROBIOLOGY")=MICROCNT
"RTN","LR7OSUM1",181,0)
 S LRWRDVEW="",LRSB=0,LRIDT=LRIN
"RTN","LR7OSUM1",182,0)
 F  S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT<1!(LRIDT>LROUT)!(CT1>COUNT)  D
"RTN","LR7OSUM1",183,0)
 . N LRX
"RTN","LR7OSUM1",184,0)
 . ;
"RTN","LR7OSUM1",185,0)
 . S LRNLOC=LRLLOC
"RTN","LR7OSUM1",186,0)
 . S CT1=CT1+1
"RTN","LR7OSUM1",187,0)
 . ;
"RTN","LR7OSUM1",188,0)
 . D EN1^LR7OSMZ0
"RTN","LR7OSUM1",189,0)
 . ;
"RTN","LR7OSUM1",190,0)
 . D LN^LR7OSMZ1
"RTN","LR7OSUM1",191,0)
 . S LRX="=",^TMP("LRC",$J,GCNT,0)=$$REPEAT^XLFSTR(LRX,GIOM/$L(LRX))
"RTN","LR7OSUM1",192,0)
 . D LN^LR7OSMZ1
"RTN","LR7OSUM1",193,0)
 . S ^TMP("LRC",$J,GCNT,0)=""
"RTN","LR7OSUM1",194,0)
 . ;
"RTN","LR7OSUM1",195,0)
 . S LRLLOC=LRNLOC
"RTN","LR7OSUM1",196,0)
 I GCNT'>MICROCNT K ^TMP("LRH",$J,"MICROBIOLOGY")
"RTN","LR7OSUM1",197,0)
 K %,A,A1,AGE,B,B1,DFN,DOB,DZ,I,J,LR2ORMOR,LRAA,LRACC,LRACN,LRAD,LRADM,LRADX,LRAFS,LRAX,LRBUG,LRCMNT,LRCS,LRDCOM,LREF,LREND,LRIFN,LRLLT,LRMD,LRNLOC,LRNS,LROK,LRONESPC,LRONETST,LRORG,LRPRE,LRPRINT
"RTN","LR7OSUM1",198,0)
 Q
"RTN","LR7OSUM1",199,0)
 ;
"RTN","LR7OSUM1",200,0)
 ;
"RTN","LR7OSUM1",201,0)
CHKUN ; Check units and normals with cumulative report values
"RTN","LR7OSUM1",202,0)
 ; Add comment if these differ from file #64.5 values
"RTN","LR7OSUM1",203,0)
 ;
"RTN","LR7OSUM1",204,0)
 N I,L,LRFLAG,LRHI,LRLO,LRLOHI,LRX,LRY,TST,TXT
"RTN","LR7OSUM1",205,0)
 S LRX=$G(^LAB(64.5,"A",1,LRMH,LRSH,LRTSTS)),LRFLAG=0
"RTN","LR7OSUM1",206,0)
 S TST=$P($G(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRTSTS,0)),"^",3)
"RTN","LR7OSUM1",207,0)
 S LRY="*** For test "_TST
"RTN","LR7OSUM1",208,0)
 ; Check units - if different generate comment
"RTN","LR7OSUM1",209,0)
 I $$UP^XLFSTR($P(LRX,"^",7))'=$$UP^XLFSTR($P(LRTRES,"^",5)) S LRY=LRY_" Units: "_$S($P(LRTRES,"^",5)'="":$P(LRTRES,"^",5),1:"<none specified>"),LRFLAG=1
"RTN","LR7OSUM1",210,0)
 ;
"RTN","LR7OSUM1",211,0)
 ; Check normals - if different generate comment
"RTN","LR7OSUM1",212,0)
 S @("LRLO="_$S($P(LRX,"^",2)'="":$P(LRX,"^",2),$P(LRX,"^",11)'="":$P(LRX,"^",11),1:""""""))
"RTN","LR7OSUM1",213,0)
 ;
"RTN","LR7OSUM1",214,0)
 S @("LRHI="_$S($P(LRX,"^",3)'="":$P(LRX,"^",3),$P(LRX,"^",12)'="":$P(LRX,"^",12),1:""""""))
"RTN","LR7OSUM1",215,0)
 I LRLO'=$P(LRTRES,"^",3)!(LRHI'=$P(LRTRES,"^",4)) D
"RTN","LR7OSUM1",216,0)
 . I '$$REALDIFF Q
"RTN","LR7OSUM1",217,0)
 . I LRFLAG S LRY=LRY_" and"
"RTN","LR7OSUM1",218,0)
 . S TXT=""
"RTN","LR7OSUM1",219,0)
 . D
"RTN","LR7OSUM1",220,0)
 . . I $P(LRTRES,"^",3)="",$P(LRTRES,"^",4)="" S TXT="<none specified>" Q
"RTN","LR7OSUM1",221,0)
 . . I $P(LRTRES,"^",3)'="",$P(LRTRES,"^",4)'="" S TXT=$P(LRTRES,"^",3)_" to "_$P(LRTRES,"^",4) Q
"RTN","LR7OSUM1",222,0)
 . . I $P(LRTRES,"^",3)'="",$P(LRTRES,"^",4)="" S TXT=$S($P(LRTRES,"^",3)?.AP:$P(LRTRES,"^",3),1:"low: "_$P(LRTRES,"^",3)) Q
"RTN","LR7OSUM1",223,0)
 . . I $P(LRTRES,"^",3)="",$P(LRTRES,"^",4)'="" S TXT=$S($P(LRTRES,"^",4)?.AP:$P(LRTRES,"^",4),1:"high: "_$P(LRTRES,"^",4)) Q
"RTN","LR7OSUM1",224,0)
 . I TXT'="" S LRY=LRY_" Normals: "_TXT,LRFLAG=1
"RTN","LR7OSUM1",225,0)
 ;
"RTN","LR7OSUM1",226,0)
 I 'LRFLAG Q
"RTN","LR7OSUM1",227,0)
 ;
"RTN","LR7OSUM1",228,0)
 S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1
"RTN","LR7OSUM1",229,0)
 S LRY=LRY_" ***",^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=LRY
"RTN","LR7OSUM1",230,0)
 S ^TMP("LRCMTINDX",$J,LRIDT)=""
"RTN","LR7OSUM1",231,0)
 Q
"RTN","LR7OSUM1",232,0)
 ;
"RTN","LR7OSUM1",233,0)
 ;
"RTN","LR7OSUM1",234,0)
REALDIFF() ;
"RTN","LR7OSUM1",235,0)
 ; function to determine if values are numeric and are different
"RTN","LR7OSUM1",236,0)
 ; solely because of leading or trailing zeroes
"RTN","LR7OSUM1",237,0)
 ;     returns 0 if difference is because of leading/trailing zeroes
"RTN","LR7OSUM1",238,0)
 ;     returns 1 if differences are meaningful
"RTN","LR7OSUM1",239,0)
 N LRTRESLO,LRTRESHI,DIFF
"RTN","LR7OSUM1",240,0)
 S LRTRESLO=$P(LRTRES,"^",3),LRTRESHI=$P(LRTRES,"^",4)
"RTN","LR7OSUM1",241,0)
 S DIFF=0
"RTN","LR7OSUM1",242,0)
 I LRLO'=LRTRESLO S DIFF=1 D
"RTN","LR7OSUM1",243,0)
 . I LRLO?.N!(LRLO?.N1".".N) D
"RTN","LR7OSUM1",244,0)
 . . I LRTRESLO?.N!(LRTRESLO?.N1".".N) D
"RTN","LR7OSUM1",245,0)
 . . . I +LRLO=+LRTRESLO S DIFF=0
"RTN","LR7OSUM1",246,0)
 I DIFF Q 1
"RTN","LR7OSUM1",247,0)
 I LRHI'=LRTRESHI S DIFF=1 D
"RTN","LR7OSUM1",248,0)
 . I LRHI?.N!(LRHI?.N1".".N) D
"RTN","LR7OSUM1",249,0)
 . . I LRTRESHI?.N!(LRTRESHI?.N1".".N) D
"RTN","LR7OSUM1",250,0)
 . . . I +LRHI=+LRTRESHI S DIFF=0
"RTN","LR7OSUM1",251,0)
 I DIFF Q 1
"RTN","LR7OSUM1",252,0)
 Q 0
"RTN","LR7OSUM1",253,0)
 ;
"RTN","LR7OSUM1",254,0)
 ;
"RTN","LR7OSUM1",255,0)
GSC ; Grab specimen comments
"RTN","LR7OSUM1",256,0)
 ;
"RTN","LR7OSUM1",257,0)
 I $D(^LR(LRDFN,"CH",LRIDT,1,0)),'$D(^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)) D
"RTN","LR7OSUM1",258,0)
 . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)="",L=0
"RTN","LR7OSUM1",259,0)
 . F  S L=$O(^LR(LRDFN,"CH",LRIDT,1,L)) Q:L<1  S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
"RTN","LR7OSUM1",260,0)
 ;
"RTN","LR7OSUM1",261,0)
 Q
"RTN","LR7OSUM1",262,0)
 ;
"RTN","LR7OSUM1",263,0)
 ;
"RTN","LR7OSUM1",264,0)
CHKNP ; Check for NP comments and no verified results.
"RTN","LR7OSUM1",265,0)
 ;
"RTN","LR7OSUM1",266,0)
 ;
"RTN","LR7OSUM1",267,0)
 N LRCAN,TST
"RTN","LR7OSUM1",268,0)
 ; Don't print unverified results.
"RTN","LR7OSUM1",269,0)
 I $O(^LR(LRDFN,"CH",LRIDT,1)) Q
"RTN","LR7OSUM1",270,0)
 ;
"RTN","LR7OSUM1",271,0)
 S LRCAN=0
"RTN","LR7OSUM1",272,0)
 F  S LRCAN=+$O(^LR(LRDFN,"CH",LRIDT,1,LRCAN)) Q:LRCAN<1  Q:($E(^(LRCAN,0))="*")
"RTN","LR7OSUM1",273,0)
 ;
"RTN","LR7OSUM1",274,0)
 ; Print if cancel comment and no unverified results.
"RTN","LR7OSUM1",275,0)
 I LRCAN<1 Q
"RTN","LR7OSUM1",276,0)
 ;
"RTN","LR7OSUM1",277,0)
 Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD("MISCELLANEOUS TESTS")))
"RTN","LR7OSUM1",278,0)
 ;
"RTN","LR7OSUM1",279,0)
 S:'$D(^TMP($J,LRDFN,"MISC",LRIDT,0)) ^(0)=LRIDT_U_LRVIDT_U_LRVDT_U_LRAN_U_LRSPM_U_LREAL
"RTN","LR7OSUM1",280,0)
 S ^TMP($J,LRDFN,"MISC",LRIDT,LRTNN)=""_U_LRSPM_U
"RTN","LR7OSUM1",281,0)
 ;
"RTN","LR7OSUM1",282,0)
 S TST="See comment"
"RTN","LR7OSUM1",283,0)
 S ^TMP("LRT",$J,TST)="MISCELLANEOUS TESTS"
"RTN","LR7OSUM1",284,0)
 ;
"RTN","LR7OSUM1",285,0)
 ; Grab specimen comments
"RTN","LR7OSUM1",286,0)
 D GSC
"RTN","LR7OSUM1",287,0)
 ;
"RTN","LR7OSUM1",288,0)
 S LRTNN=LRTNN+1
"RTN","LR7OSUM1",289,0)
 Q
"RTN","LR7OSUM3")
0^23^B15593166
"RTN","LR7OSUM3",1,0)
LR7OSUM3 ;DALOI/STAFF - Silent Patient cum cont. ;02/20/13  16:5
"RTN","LR7OSUM3",2,0)
 ;;5.2;LAB SERVICE;**121,201,187,228,250,350,427**;Sep 27, 1994;Build 33
"RTN","LR7OSUM3",3,0)
 ;
"RTN","LR7OSUM3",4,0)
 N GIOM,LRPF,LRI
"RTN","LR7OSUM3",5,0)
 S GIOM=$G(LRGIOM)
"RTN","LR7OSUM3",6,0)
 I GIOM="" D
"RTN","LR7OSUM3",7,0)
 . S GIOM=$$GET^XPAR("USR^DIV^PKG","LR CH GUI REPORT RIGHT MARGIN",1,"Q")
"RTN","LR7OSUM3",8,0)
 . I GIOM="" S GIOM=80
"RTN","LR7OSUM3",9,0)
 S LRAG=0,LRYESCOM=0,LRIL=0,LRFULL=0
"RTN","LR7OSUM3",10,0)
 ;
"RTN","LR7OSUM3",11,0)
 ; Print header with name of facility printing report.
"RTN","LR7OSUM3",12,0)
 I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1 D PFAC
"RTN","LR7OSUM3",13,0)
 ;
"RTN","LR7OSUM3",14,0)
 D LRMH S LRMH="MISC"
"RTN","LR7OSUM3",15,0)
 G PRE^LR7OSUM6
"RTN","LR7OSUM3",16,0)
 ;
"RTN","LR7OSUM3",17,0)
LRMH S LRMH=0
"RTN","LR7OSUM3",18,0)
 F  S LRMH=$O(^TMP($J,LRDFN,LRMH)) Q:LRMH<1  S X=^(LRMH) D MH1
"RTN","LR7OSUM3",19,0)
 Q
"RTN","LR7OSUM3",20,0)
 ;
"RTN","LR7OSUM3",21,0)
 ;
"RTN","LR7OSUM3",22,0)
MH1 S LRMHN=$P(X,U,1),LRSH=0
"RTN","LR7OSUM3",23,0)
 S LRPG=1
"RTN","LR7OSUM3",24,0)
 D TOP^LR7OSUM6
"RTN","LR7OSUM3",25,0)
 S LROFMT="",LRFDE=0 D LRSH
"RTN","LR7OSUM3",26,0)
 D:'LRFDE LRBOT^LR7OSUM6
"RTN","LR7OSUM3",27,0)
 K LRTM,^TMP($J,"TM")
"RTN","LR7OSUM3",28,0)
 S LRFULL=0,LRTM=0,LROFMT="",LRFDE=0
"RTN","LR7OSUM3",29,0)
 Q
"RTN","LR7OSUM3",30,0)
 ;
"RTN","LR7OSUM3",31,0)
 ;
"RTN","LR7OSUM3",32,0)
LRSH ;from LR7OSUM4, LR7OSUM5
"RTN","LR7OSUM3",33,0)
 S LRSH=$O(^TMP($J,LRDFN,LRMH,LRSH)) Q:LRSH<1  G:$D(^(LRSH))'=11 LRSH S X=^(LRSH),LRSHN=$P(X,U,1),LRTOPP=$P(X,U,2),LRSHD=$P(X,U,3),LRFMT=$P(X,U,4),LRFMT(1)=$E(LRFMT,1),LROFMT(1)=$E(LROFMT,1)
"RTN","LR7OSUM3",34,0)
 Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD(LRSHN)))
"RTN","LR7OSUM3",35,0)
 I (LROFMT["V"&(LRFMT["V"))!(LROFMT'=""&(LRFMT(1)'=LROFMT(1))) S LROFMT="" D HEAD^LR7OSUM6
"RTN","LR7OSUM3",36,0)
 S LROFMT=LRFMT,LRTOPP=$E($P(^LAB(61,LRTOPP,0),U,1),1,13),LRTOT=0,LRPL=1,LRACT=0,LRJS=0,LRTS=0,LRFDE=0
"RTN","LR7OSUM3",37,0)
 S LRNP=0,LRFDT=0,LRLFDT=0,LRFFDT=0 D LRNP
"RTN","LR7OSUM3",38,0)
 ;
"RTN","LR7OSUM3",39,0)
LOOP ;from LR7OSUM5
"RTN","LR7OSUM3",40,0)
 I LRACT<LRPL S LRFDT=LRFFDT G:LRFMT["H" TS^LR7OSUM5 I LRFMT["V" S LRMULT=99999,LRMU=0 G BS^LR7OSUM4
"RTN","LR7OSUM3",41,0)
 D TXT1^LR7OSUM5
"RTN","LR7OSUM3",42,0)
 I LRCTR'<LRLNS S LRFULL=1 S:'LRFDT LRFED=1 D:LRFDE LRBOT^LR7OSUM6 D:'LRFDT HEAD^LR7OSUM6 S LRFULL=0 G LRSH
"RTN","LR7OSUM3",43,0)
 G LRSH
"RTN","LR7OSUM3",44,0)
 ;
"RTN","LR7OSUM3",45,0)
 ;
"RTN","LR7OSUM3",46,0)
LRNP ;from LR7OSUM4
"RTN","LR7OSUM3",47,0)
 S I=0 F  S I=$O(^LAB(64.5,1,1,LRMH,1,LRSH,1,I)) Q:I<1  D
"RTN","LR7OSUM3",48,0)
 . N LRCW
"RTN","LR7OSUM3",49,0)
 . S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I,0),U,2)
"RTN","LR7OSUM3",50,0)
 . I LRCW<1 S LRCW=15
"RTN","LR7OSUM3",51,0)
 . S LRTOT=LRTOT+LRCW
"RTN","LR7OSUM3",52,0)
 . I LRTOT>(GIOM-25) S LRPL=LRPL+1,LRTOT=LRCW
"RTN","LR7OSUM3",53,0)
LRLNS ;from LR7OSUM5
"RTN","LR7OSUM3",54,0)
 K LRTM,^TMP($J,"TM") S LRTM=0
"RTN","LR7OSUM3",55,0)
 S LRLNS=((GIOSL-18)-(GCNT+(6*LRPL)))\LRPL
"RTN","LR7OSUM3",56,0)
 S LRCL=(GIOM/2)-(5+($L(LRSHN)/2)) S GCNT=GCNT+1,CCNT=1,^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(LRCL,CCNT,"---- "_LRSHN_" ----")
"RTN","LR7OSUM3",57,0)
 S ^TMP("LRH",$J,LRSHN)=GCNT ;Set x-ref of minor headers with data
"RTN","LR7OSUM3",58,0)
 S LRACT=0,LRJS=0,LRNP=1
"RTN","LR7OSUM3",59,0)
 Q
"RTN","LR7OSUM3",60,0)
 ;
"RTN","LR7OSUM3",61,0)
 ;
"RTN","LR7OSUM3",62,0)
UDT ;from LR7OSUM4, LR7OSUM5
"RTN","LR7OSUM3",63,0)
 N LRBDT,LREAL
"RTN","LR7OSUM3",64,0)
 S LRBDT=LRFDT
"RTN","LR7OSUM3",65,0)
 ; If inexact date/time then suppress any pseudo time.
"RTN","LR7OSUM3",66,0)
 S LREAL=+$P(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,0),U,6)
"RTN","LR7OSUM3",67,0)
 ; Forces all formats to be inverse date/time regardless of parameter in file 64.5
"RTN","LR7OSUM3",68,0)
 S LRFDT=$P(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,0),U,2) ;,LRTIM=$E(LRFDT,9,12)
"RTN","LR7OSUM3",69,0)
 ;F I=0:0 Q:$L(LRTIM)=4  S LRTIM=LRTIM_0
"RTN","LR7OSUM3",70,0)
 ;S LRTIM=$S(LRTIM?4"0":"     ",1:$E(LRTIM,1,2)_":"_$E(LRTIM,3,4))
"RTN","LR7OSUM3",71,0)
 ;S LRUDT=$E($$Y2K^LRX($P(LRFDT,".")),1,5)_" "_$J(LRTIM,4)_" "
"RTN","LR7OSUM3",72,0)
 S LRFDT=LRBDT D:LRTM LRTM
"RTN","LR7OSUM3",73,0)
 Q
"RTN","LR7OSUM3",74,0)
 ;
"RTN","LR7OSUM3",75,0)
 ;
"RTN","LR7OSUM3",76,0)
LRTM ;
"RTN","LR7OSUM3",77,0)
 S LRNXSW=0 S:'$D(LRTM(0)) LRTM(0)=96
"RTN","LR7OSUM3",78,0)
 I $D(^TMP($J,"TM",LRFDT)) S LRNXSW=1
"RTN","LR7OSUM3",79,0)
 E  I $D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX")) D
"RTN","LR7OSUM3",80,0)
 . S ^TMP($J,"TM",LRFDT)=^TMP("LRCMTINDX",$J,LRFDT),LRNXSW=1
"RTN","LR7OSUM3",81,0)
 . S I=0 F  S I=$O(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX",I)) Q:I<1  S ^TMP($J,"TM",LRFDT,I)=^(I,0)
"RTN","LR7OSUM3",82,0)
 N LRUDT7
"RTN","LR7OSUM3",83,0)
 ;S LRUDT7=$$Y2K^LRX(9999999-LRFDT)
"RTN","LR7OSUM3",84,0)
 ;S LRUDT7=$$FMTE^XLFDT(9999999-LRFDT,"1"_$S(LREAL:"D",1:"M"))
"RTN","LR7OSUM3",85,0)
 S LRUDT7=$$LRUDT^LR7OSUM6(9999999-LRFDT,LREAL)
"RTN","LR7OSUM3",86,0)
 S LRUDT=$P(LRUDT7,"@")_" "_$E($P(LRUDT7,"@",2),1,5)
"RTN","LR7OSUM3",87,0)
 ;S:LRNXSW I=$P(^TMP($J,"TM",LRFDT),"^"),LRUDT=I_$E("   ",1,$S(I'="":1,1:2))_LRUDT
"RTN","LR7OSUM3",88,0)
 I LRNXSW D
"RTN","LR7OSUM3",89,0)
 . S I=$P(^TMP($J,"TM",LRFDT),"^")
"RTN","LR7OSUM3",90,0)
 . I I'="" S I="["_I_"]"
"RTN","LR7OSUM3",91,0)
 . S LRUDT=$$LJ^XLFSTR(I,5)_LRUDT_" "
"RTN","LR7OSUM3",92,0)
 Q
"RTN","LR7OSUM3",93,0)
 ;
"RTN","LR7OSUM3",94,0)
 ;
"RTN","LR7OSUM3",95,0)
PFAC ; Print header with name of facility printing report.
"RTN","LR7OSUM3",96,0)
 ;
"RTN","LR7OSUM3",97,0)
 D PFAC^LRRP1(DUZ(2),0,1,.LRPF)
"RTN","LR7OSUM3",98,0)
 I ($O(^TMP($J,LRDFN,0))!($O(^TMP($J,LRDFN,"MISC",0)))),$D(LRPF) D
"RTN","LR7OSUM3",99,0)
 . S LRI=0
"RTN","LR7OSUM3",100,0)
 . F  S LRI=$O(LRPF(LRI)) Q:'LRI  D LN^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,LRPF(LRI))
"RTN","LR7OSUM3",101,0)
 . D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,"As of: "_$$HTE^XLFDT($H,"1M"))
"RTN","LR7OSUM3",102,0)
 . D LINE^LR7OSUM4,LINE^LR7OSUM4
"RTN","LR7OSUM3",103,0)
 Q
"RTN","LR7OSUM5")
0^24^B50074363
"RTN","LR7OSUM5",1,0)
LR7OSUM5 ;DALOI/STAFFC - Silent Patient cum cont. ;02/20/13  16:48
"RTN","LR7OSUM5",2,0)
 ;;5.2;LAB SERVICE;**121,187,228,241,250,251,256,356,372,350,427**;Sep 27, 1994;Build 33
"RTN","LR7OSUM5",3,0)
 ;
"RTN","LR7OSUM5",4,0)
TS ; from LR7OSUM3
"RTN","LR7OSUM5",5,0)
 N A,B,I,J,LRII,LRCCNT,LRCTR,LRFALT,LRCL,LRCW,LRJ,LRLEN,LRPNAME,LRTLOC,LRWRAP,LRX,LRY,X,XZ,Z
"RTN","LR7OSUM5",6,0)
 ;
"RTN","LR7OSUM5",7,0)
 I LRACT'=0 S X="",$P(X,"=",GIOM)="" D LN S ^TMP("LRC",$J,GCNT,0)=X
"RTN","LR7OSUM5",8,0)
 ;
"RTN","LR7OSUM5",9,0)
 S I=0,LRII=0
"RTN","LR7OSUM5",10,0)
 F  S LRII=$O(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRII)) Q:LRII<1  S I=I+1,I(I)=LRII
"RTN","LR7OSUM5",11,0)
 S LRFALT=0,LRCTR=0,LRACT=LRACT+1,J=LRJS+1,LRCL=25
"RTN","LR7OSUM5",12,0)
 ;
"RTN","LR7OSUM5",13,0)
 I J'>LRSHD D
"RTN","LR7OSUM5",14,0)
 . D LINE^LR7OSUM4,LN
"RTN","LR7OSUM5",15,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,LRTOPP)_$$S^LR7OS(LRCL,CCNT,"")
"RTN","LR7OSUM5",16,0)
 ;
"RTN","LR7OSUM5",17,0)
 ; GIOM=right margin  LRCL=column position  LRCW=column width
"RTN","LR7OSUM5",18,0)
 F I=J:1:LRSHD S Z=^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),LRCW=$P(Z,U,2) S:LRCW<1 LRCW=15 Q:(GIOM-LRCL)<LRCW  D
"RTN","LR7OSUM5",19,0)
 . S LRCL=LRCL+LRCW,LRPNAME=$P(Z,U,3),LRLEN=$L(LRPNAME),LRWRAP=0
"RTN","LR7OSUM5",20,0)
 . I LRLEN>($S(LRCW>1:LRCW-1,1:1)) S LRCCNT=CCNT,LRWRAP=1
"RTN","LR7OSUM5",21,0)
 . S LRX=$E(LRPNAME,1,$S(LRCW>1:LRCW-1,1:1)),LRX=$$TRIM^XLFSTR(LRX,"RL"," "),LRX=$$CJ^XLFSTR(LRX,$S(LRCW>1:LRCW-1,1:1))
"RTN","LR7OSUM5",22,0)
 . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,LRX)_$$S^LR7OS(LRCL,CCNT,"")
"RTN","LR7OSUM5",23,0)
 . S:'$P($G(^TMP("LRT",$J,LRPNAME)),"^",2) $P(^TMP("LRT",$J,LRPNAME),"^",2)=GCNT
"RTN","LR7OSUM5",24,0)
 . I LRWRAP D
"RTN","LR7OSUM5",25,0)
 . . S LRJ=0
"RTN","LR7OSUM5",26,0)
 . . F  D  Q:LRPNAME=""
"RTN","LR7OSUM5",27,0)
 . . . S LRPNAME=$E(LRPNAME,$S(LRCW>1:LRCW,1:LRCW+1),LRLEN) S:$E(LRPNAME,1)=" " LRPNAME=$$TRIM^XLFSTR(LRPNAME,"L"," ") Q:LRPNAME=""
"RTN","LR7OSUM5",28,0)
 . . . S LRX=$E(LRPNAME,1,$S(LRCW>1:LRCW-1,1:1)),LRX=$$TRIM^XLFSTR(LRX,"RL"," "),LRX=$$CJ^XLFSTR(LRX,$S(LRCW>1:LRCW-1,1:1)),LRJ=LRJ+1
"RTN","LR7OSUM5",29,0)
 . . . S LRY=$G(^TMP("LRC",$J,GCNT+LRJ,0))
"RTN","LR7OSUM5",30,0)
 . . . S ^TMP("LRC",$J,GCNT+LRJ,0)=$$LJ^XLFSTR(LRY,LRCCNT-1)_LRX
"RTN","LR7OSUM5",31,0)
 S GCNT=$O(^TMP("LRC",$J,""),-1)
"RTN","LR7OSUM5",32,0)
 ;
"RTN","LR7OSUM5",33,0)
 S LRJS=(I-1)
"RTN","LR7OSUM5",34,0)
 S:LRACT=LRPL LRJS=LRJS+1
"RTN","LR7OSUM5",35,0)
 F I=J:1:LRJS Q:'$D(^LAB(64.5,"A",1,LRMH,LRSH,I(I)))  S Z=^(I(I)) S:$L($P(Z,U,2))!$L($P(Z,U,11)) LRFALT=1
"RTN","LR7OSUM5",36,0)
 I LRFALT D
"RTN","LR7OSUM5",37,0)
 . D LN
"RTN","LR7OSUM5",38,0)
 . S LRCL=25
"RTN","LR7OSUM5",39,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,$S($P(^LAB(64.5,"A",1,LRMH,LRSH,I(J)),U,11)'="":"Therapeutic low",1:"Ref range low"))_$$S^LR7OS(LRCL,CCNT,"")
"RTN","LR7OSUM5",40,0)
 . D TS1,LN
"RTN","LR7OSUM5",41,0)
 . S LRCL=25
"RTN","LR7OSUM5",42,0)
 . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,$S($P(^LAB(64.5,"A",1,LRMH,LRSH,I(J)),U,11)'="":"Therapeutic high",1:"Ref range high"))_$$S^LR7OS(LRCL,CCNT,"")
"RTN","LR7OSUM5",43,0)
 . D TS2
"RTN","LR7OSUM5",44,0)
 ;
"RTN","LR7OSUM5",45,0)
 F I=J:1:LRJS Q:'$D(^LAB(64.5,"A",1,LRMH,LRSH,I(I)))  S:$P(^(I(I)),U,7)'="" LRFALT=1
"RTN","LR7OSUM5",46,0)
 I LRFALT S LRCL=25 D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(LRCL,CCNT,"") F I=J:1:LRJS D TS3
"RTN","LR7OSUM5",47,0)
 S LRFALT=0,XZ="",$P(XZ,"-",GIOM)=""
"RTN","LR7OSUM5",48,0)
 D LN
"RTN","LR7OSUM5",49,0)
 S ^TMP("LRC",$J,GCNT,0)=XZ
"RTN","LR7OSUM5",50,0)
 ;
"RTN","LR7OSUM5",51,0)
LRFDT ;
"RTN","LR7OSUM5",52,0)
 S:LRNP LRFFDT=LRFDT,LRNP=0
"RTN","LR7OSUM5",53,0)
 S LRFDT=$O(^TMP($J,LRDFN,LRMH,LRSH,LRFDT)) G:LRFDT<1 LOOP^LR7OSUM3 S LRTLOC=$P(^(LRFDT,0),U,1)
"RTN","LR7OSUM5",54,0)
 S:LRFDT>LRLFDT LRLFDT=LRFDT
"RTN","LR7OSUM5",55,0)
 ;
"RTN","LR7OSUM5",56,0)
GOUT ;
"RTN","LR7OSUM5",57,0)
 D QRS
"RTN","LR7OSUM5",58,0)
 I LRCTR>LRLNS&(LRACT'<LRPL) S LRFULL=1 D TXT1 G:$O(^TMP($J,LRDFN,LRMH,LRSH,LRLFDT))<1 LRSH^LR7OSUM3 D HEAD^LR7OSUM6,LRLNS^LR7OSUM3 S LRFULL=0,LRFDT=LRLFDT G TS
"RTN","LR7OSUM5",59,0)
 I LRCTR>LRLNS&(LRACT<LRPL) S LRFDT=LRFFDT G TS
"RTN","LR7OSUM5",60,0)
 G LRFDT
"RTN","LR7OSUM5",61,0)
 ;
"RTN","LR7OSUM5",62,0)
 ;
"RTN","LR7OSUM5",63,0)
QRS ;
"RTN","LR7OSUM5",64,0)
 S LRCTR=LRCTR+1
"RTN","LR7OSUM5",65,0)
 F I=J:1:LRJS I $D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,I(I))) S:^(I(I))'="" LRFALT=1
"RTN","LR7OSUM5",66,0)
 Q:'LRFALT
"RTN","LR7OSUM5",67,0)
 S LRFALT=0,LRTM=1
"RTN","LR7OSUM5",68,0)
 D UDT^LR7OSUM3
"RTN","LR7OSUM5",69,0)
 S LRCL=25,LRTM=0
"RTN","LR7OSUM5",70,0)
 D LN
"RTN","LR7OSUM5",71,0)
 S ^TMP("LRC",$J,GCNT,0)=""
"RTN","LR7OSUM5",72,0)
 S:'LRNXSW ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(2,CCNT,""),^(0)=^(0)_$$S^LR7OS(3,CCNT,"")
"RTN","LR7OSUM5",73,0)
 S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,LRUDT)
"RTN","LR7OSUM5",74,0)
 F I=J:1:LRJS S LRG=^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0) S X=^(0) D QRS1
"RTN","LR7OSUM5",75,0)
 Q
"RTN","LR7OSUM5",76,0)
 ;
"RTN","LR7OSUM5",77,0)
 ;
"RTN","LR7OSUM5",78,0)
QRS1 ;
"RTN","LR7OSUM5",79,0)
 S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRCL,CCNT,""),LRCW=$P(LRG,U,2),LRDP=$P(X,U,6)
"RTN","LR7OSUM5",80,0)
 I LRCW<1 S LRCW=15
"RTN","LR7OSUM5",81,0)
 Q:(GIOM-LRCL)<LRCW
"RTN","LR7OSUM5",82,0)
 S LRCL=LRCL+LRCW
"RTN","LR7OSUM5",83,0)
 I $D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,I(I))) D
"RTN","LR7OSUM5",84,0)
 . S X=^TMP($J,LRDFN,LRMH,LRSH,LRFDT,I(I))
"RTN","LR7OSUM5",85,0)
 . D C(.X,.X1)
"RTN","LR7OSUM5",86,0)
 . I $P(LRG,U,4)'=""&($L(X)) S @("X="_$P(LRG,U,4)),^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,X_X1)
"RTN","LR7OSUM5",87,0)
 . I $P(LRG,U,4)="" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,X_X1)
"RTN","LR7OSUM5",88,0)
 Q
"RTN","LR7OSUM5",89,0)
 ;
"RTN","LR7OSUM5",90,0)
 ;
"RTN","LR7OSUM5",91,0)
TXT ; from LR7OSUM4
"RTN","LR7OSUM5",92,0)
 S LRVAR=0,LRIV=0
"RTN","LR7OSUM5",93,0)
 F  S LRIV=$O(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX",LRIV)) Q:LRIV<1  D
"RTN","LR7OSUM5",94,0)
 . S X=^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX",LRIV,0),LRVAR=LRVAR+1
"RTN","LR7OSUM5",95,0)
 . I LRVAR>1 D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(5,CCNT,"")
"RTN","LR7OSUM5",96,0)
 . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(5,CCNT,X)
"RTN","LR7OSUM5",97,0)
 Q
"RTN","LR7OSUM5",98,0)
 ;
"RTN","LR7OSUM5",99,0)
 ;
"RTN","LR7OSUM5",100,0)
LRLO ; from LR7OSUM4
"RTN","LR7OSUM5",101,0)
 S @("LRLO="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,2)):$P(^(I(I)),U,2),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,11)):$P(^(I(I)),U,11),1:""""""))
"RTN","LR7OSUM5",102,0)
 ;
"RTN","LR7OSUM5",103,0)
LRHI ;
"RTN","LR7OSUM5",104,0)
 S @("LRHI="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,3)):$P(^(I(I)),U,3),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,12)):$P(^(I(I)),U,12),1:"""""")),P7=$P(^(I(I)),U,7)
"RTN","LR7OSUM5",105,0)
 S LRLOHI=$$EN^LRLRRVF(LRLO,LRHI)
"RTN","LR7OSUM5",106,0)
 Q
"RTN","LR7OSUM5",107,0)
 ;
"RTN","LR7OSUM5",108,0)
 ;
"RTN","LR7OSUM5",109,0)
TXT1 ; from LR7OSUM3, LR7OSUM4
"RTN","LR7OSUM5",110,0)
 S XZ="",$P(XZ,"=",GIOM)=""
"RTN","LR7OSUM5",111,0)
 Q:'$D(LRTM(0))
"RTN","LR7OSUM5",112,0)
 N C6,I,L
"RTN","LR7OSUM5",113,0)
 S C6=0
"RTN","LR7OSUM5",114,0)
 F  S C6=$O(^TMP($J,"TM",C6)) Q:C6<1  S X=^(C6) D
"RTN","LR7OSUM5",115,0)
 . D LN
"RTN","LR7OSUM5",116,0)
 . S I=$S($L($P(X,"^"))>1:2,1:3),^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(I,CCNT,$P(X,U)_". "),L(0)=0,L=0 D
"RTN","LR7OSUM5",117,0)
 . F  S L=$O(^TMP($J,"TM",C6,L)) Q:L<1  S X=^(L),L(0)=L(0)+1 D
"RTN","LR7OSUM5",118,0)
 . . I L(0)>1 D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(6,CCNT,"")
"RTN","LR7OSUM5",119,0)
 . . S ^(0)=^TMP("LRC",$J,GCNT,0)_X
"RTN","LR7OSUM5",120,0)
 Q
"RTN","LR7OSUM5",121,0)
 ;
"RTN","LR7OSUM5",122,0)
 ;
"RTN","LR7OSUM5",123,0)
C(X,X1)    ;
"RTN","LR7OSUM5",124,0)
 N X2
"RTN","LR7OSUM5",125,0)
 S X1=" "_$P(X,U,2),X=$P(X,U,1)
"RTN","LR7OSUM5",126,0)
 I $P(LRG,U,4)'="" S LRCW=LRCW-3 Q
"RTN","LR7OSUM5",127,0)
 I "-<>"[$E(X,1),$E(X,2,$L(X))?.N.P1N S X2=$E(X,1),X=$E(X,2,$L(X))
"RTN","LR7OSUM5",128,0)
 S LRCW(1)=LRCW-3
"RTN","LR7OSUM5",129,0)
 I X?.N.P1N!(LRDP="")!(X?.N1".".N) S X=$S(LRDP="":$J(X,LRCW(1)),1:$J(X,LRCW(1),LRDP)) D C2(.X,.X2)
"RTN","LR7OSUM5",130,0)
 Q
"RTN","LR7OSUM5",131,0)
 ;
"RTN","LR7OSUM5",132,0)
 ;
"RTN","LR7OSUM5",133,0)
C1(X,X1) ; from LR7OSUM4
"RTN","LR7OSUM5",134,0)
 N X2
"RTN","LR7OSUM5",135,0)
 S LRCW=$S(X1="":7,1:10),X1=$S($L(X1)=1:" "_X1_" ",$L(X1)=0:X1,1:" "_X1)
"RTN","LR7OSUM5",136,0)
 I $P(LRG,U,4)'="" S LRCW=7 Q
"RTN","LR7OSUM5",137,0)
 I "-<>"[$E(X,1),$E(X,2,$L(X))?.N.P1N S X2=$E(X,1),X=$E(X,2,$L(X))
"RTN","LR7OSUM5",138,0)
 S LRCW(1)=LRCW-3
"RTN","LR7OSUM5",139,0)
 I X?.N.P1N!(LRDP="")!(X?.N1".".N) S X=$S(LRDP="":$J(X,LRCW(1)),1:$J(X,LRCW(1),LRDP)) D C2(.X,.X2)
"RTN","LR7OSUM5",140,0)
 S X=$S(X1'="":X_X1,1:X)
"RTN","LR7OSUM5",141,0)
 Q
"RTN","LR7OSUM5",142,0)
 ;
"RTN","LR7OSUM5",143,0)
 ;
"RTN","LR7OSUM5",144,0)
C2(X,X2) ;
"RTN","LR7OSUM5",145,0)
 Q:'$D(X2)
"RTN","LR7OSUM5",146,0)
 Q:'$D(X)
"RTN","LR7OSUM5",147,0)
 N X3
"RTN","LR7OSUM5",148,0)
 F X3=1:1:$L(X) I $E(X,X3)'=" " S X=$E(X,1,X3-2)_X2_$E(X,X3,$L(X)) Q
"RTN","LR7OSUM5",149,0)
 Q
"RTN","LR7OSUM5",150,0)
 ;
"RTN","LR7OSUM5",151,0)
 ;
"RTN","LR7OSUM5",152,0)
TS1 ; Print low therapeutic or reference range values
"RTN","LR7OSUM5",153,0)
 F I=J:1:LRJS S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2) S:LRCW<1 LRCW=15 S LRCL=LRCL+LRCW D
"RTN","LR7OSUM5",154,0)
 . S @("LRLO="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,2)):$P(^(I(I)),U,2),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,11)):$P(^(I(I)),U,11),1:""""""))
"RTN","LR7OSUM5",155,0)
 . ;S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J(LRLO,(A+B))),^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
"RTN","LR7OSUM5",156,0)
 . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$$CJ^XLFSTR(LRLO,LRCW)),^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
"RTN","LR7OSUM5",157,0)
 Q
"RTN","LR7OSUM5",158,0)
 ;
"RTN","LR7OSUM5",159,0)
 ;
"RTN","LR7OSUM5",160,0)
TS2 ; Print high therapeutic or reference range values
"RTN","LR7OSUM5",161,0)
 F I=J:1:LRJS S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2) S:LRCW<1 LRCW=15 S LRCL=LRCL+LRCW D
"RTN","LR7OSUM5",162,0)
 . S @("LRHI="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,3)):$P(^(I(I)),U,3),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,12)):$P(^(I(I)),U,12),1:"""""")),P7=$P(^(I(I)),U,7)
"RTN","LR7OSUM5",163,0)
 . ;S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J(LRHI,(A+B))),^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
"RTN","LR7OSUM5",164,0)
 . S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$$CJ^XLFSTR(LRHI,LRCW)),^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
"RTN","LR7OSUM5",165,0)
 Q
"RTN","LR7OSUM5",166,0)
 ;
"RTN","LR7OSUM5",167,0)
 ;
"RTN","LR7OSUM5",168,0)
TS3 ; Print units
"RTN","LR7OSUM5",169,0)
 S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2)
"RTN","LR7OSUM5",170,0)
 I LRCW<1 S LRCW=15
"RTN","LR7OSUM5",171,0)
 Q:(GIOM-LRCL)<LRCW
"RTN","LR7OSUM5",172,0)
 S LRCL=LRCL+LRCW,X=^LAB(64.5,"A",1,LRMH,LRSH,I(I))
"RTN","LR7OSUM5",173,0)
 ;S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J($P(X,U,7),(A+B)))
"RTN","LR7OSUM5",174,0)
 S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$$CJ^XLFSTR($P(X,U,7),LRCW))
"RTN","LR7OSUM5",175,0)
 S ^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRCL,CCNT,""),LRFALT=0
"RTN","LR7OSUM5",176,0)
 Q
"RTN","LR7OSUM5",177,0)
 ;
"RTN","LR7OSUM5",178,0)
 ;
"RTN","LR7OSUM5",179,0)
LN ;
"RTN","LR7OSUM5",180,0)
 S GCNT=GCNT+1,CCNT=1
"RTN","LR7OSUM5",181,0)
 Q
"RTN","LRAPBK")
0^26^B73747615
"RTN","LRAPBK",1,0)
LRAPBK ;DALOI/STAFF - AP LOG BOOK ;02/21/13  08:08
"RTN","LRAPBK",2,0)
 ;;5.2;LAB SERVICE;**51,72,201,274,350,427**;Sep 27, 1994;Build 33
"RTN","LRAPBK",3,0)
 ;
"RTN","LRAPBK",4,0)
 ; Reference to PXAPIOE supported by ICR #1541
"RTN","LRAPBK",5,0)
 ;
"RTN","LRAPBK",6,0)
 ; The code for functionality of LR*5.2*51 has changed with patch 72.
"RTN","LRAPBK",7,0)
 ; The functionality that came with LR*5.2*51 remains the same.
"RTN","LRAPBK",8,0)
 ;
"RTN","LRAPBK",9,0)
 ; ZEXCEPT is used to identify variables which are external to a specific TAG
"RTN","LRAPBK",10,0)
 ;         used in conjunction with Eclipse M-editor.
"RTN","LRAPBK",11,0)
 ;
"RTN","LRAPBK",12,0)
 N DIR,DIRUT,DTOUT,DUOUT,LRB
"RTN","LRAPBK",13,0)
 D ^LRAP G:'$D(Y) END D XR^LRU
"RTN","LRAPBK",14,0)
 W !!?20,LRO(68)," LOG BOOK"
"RTN","LRAPBK",15,0)
 ;
"RTN","LRAPBK",16,0)
 S DIR(0)="SO^0:No;1:Yes;2:Only Topography and Morphology Codes",DIR("A")="Print SNOMED codes",DIR("B")="No"
"RTN","LRAPBK",17,0)
 D ^DIR
"RTN","LRAPBK",18,0)
 I $D(DIRUT) D END Q
"RTN","LRAPBK",19,0)
 S LRB=Y
"RTN","LRAPBK",20,0)
 ;
"RTN","LRAPBK",21,0)
 K DIR
"RTN","LRAPBK",22,0)
 S DIR(0)="Y",DIR("A")="Print Single Accession",DIR("B")="NO"
"RTN","LRAPBK",23,0)
 D ^DIR
"RTN","LRAPBK",24,0)
 I $D(DIRUT) Q
"RTN","LRAPBK",25,0)
 I Y=1 D ACC Q
"RTN","LRAPBK",26,0)
 ;
"RTN","LRAPBK",27,0)
 S LRH(2)=$E(DT,1,3),LRH(0)=$$FMTE^XLFDT(LRH(2)_"0000","D")
"RTN","LRAPBK",28,0)
 ;
"RTN","LRAPBK",29,0)
 K DIR
"RTN","LRAPBK",30,0)
 S DIR(0)="DO^::AEP^",DIR("A")="Select Log Book Year",DIR("B")=LRH(0)
"RTN","LRAPBK",31,0)
 F  D  Q:$D(DIRUT)!($G(LRH(0)))
"RTN","LRAPBK",32,0)
 . D ^DIR
"RTN","LRAPBK",33,0)
 . I $D(DIRUT) Q
"RTN","LRAPBK",34,0)
 . S LRH(2)=$E(Y,1,3),LRH(0)=$$FMTE^XLFDT(LRH(2)_"0000","D")
"RTN","LRAPBK",35,0)
 . I '$D(^LR(LRXREF,LRH(2),LRABV)) W $C(7),"   No entries for ",LRH(0) K LRH(0) Q
"RTN","LRAPBK",36,0)
 I $D(DIRUT) D END Q
"RTN","LRAPBK",37,0)
 ;
"RTN","LRAPBK",38,0)
 ;
"RTN","LRAPBK",39,0)
N1 R !,"Start with Acc #: ",X:DTIME G:X=""!(X[U) END I X'?1N.N W $C(7),!!,"NUMBERS ONLY !!" G N1
"RTN","LRAPBK",40,0)
 S LRN(1)=X
"RTN","LRAPBK",41,0)
 ;
"RTN","LRAPBK",42,0)
 ;
"RTN","LRAPBK",43,0)
N2 R !,"Go    to   Acc #: LAST // ",X:DTIME G:X='$T!(X[U) END S:X="" X=999999 I X'?1N.N W $C(7),!!,"NUMBERS ONLY !!",!! G N2
"RTN","LRAPBK",44,0)
 ;
"RTN","LRAPBK",45,0)
 S LRN(2)=X,ZTRTN="QUE^LRAPBK",ZTDESC="Anatomic Path Log Book",ZTSAVE("LR*")="" D BEG^LRUTL G:POP!($D(ZTSK)) END
"RTN","LRAPBK",46,0)
 ;
"RTN","LRAPBK",47,0)
 ;
"RTN","LRAPBK",48,0)
QUE ; Print the log book
"RTN","LRAPBK",49,0)
 N LRPSNM
"RTN","LRAPBK",50,0)
 ; Flag to indicate which SNOMED system to print
"RTN","LRAPBK",51,0)
 S LRPSNM=$$GET^XPAR("DIV^PKG","LR AP SNOMED SYSTEM PRINT",1,"Q")
"RTN","LRAPBK",52,0)
 I LRPSNM<1 S LRPSNM=2
"RTN","LRAPBK",53,0)
 ;
"RTN","LRAPBK",54,0)
 U IO D L^LRU,S^LRU S P(9)="",LRW=LRH(2)_"0000" D H S LR("F")=1
"RTN","LRAPBK",55,0)
 S LRAN=LRN(1)-1
"RTN","LRAPBK",56,0)
 F  S LRAN=$O(^LR(LRXREF,LRH(2),LRABV,LRAN)) Q:'LRAN!(LRAN>LRN(2))!(LR("Q"))  D SH
"RTN","LRAPBK",57,0)
 W:IOST'?1"C".E @IOF
"RTN","LRAPBK",58,0)
 D END^LRUTL,END
"RTN","LRAPBK",59,0)
 Q
"RTN","LRAPBK",60,0)
 ;
"RTN","LRAPBK",61,0)
 ;
"RTN","LRAPBK",62,0)
ACC ; Print log book entry for a single accession
"RTN","LRAPBK",63,0)
 ;  Called from above.
"RTN","LRAPBK",64,0)
 N DFN,LR,LRAA,LRABV,LRACC,LRAD,LRAN,LRAX,LRBSAV,LRCAPA,LRDFN,LRDPAF,LRDPF,LREND,LRH,LRIDIV,LRIDT,LRO,LRSCR,LRSF,LRT,LRU,LRVBY,LRWHO,X,Y
"RTN","LRAPBK",65,0)
 ;
"RTN","LRAPBK",66,0)
 S LRSCR=LRSS,LRBSAV=LRB
"RTN","LRAPBK",67,0)
 F  D  Q:LREND!LRSTOP
"RTN","LRAPBK",68,0)
 . S LRACC="",(LREND,LRSTOP,LRVBY)=0,LRB=LRBSAV
"RTN","LRAPBK",69,0)
 . D ENA^LRWU4(LRSCR)
"RTN","LRAPBK",70,0)
 . I LRAN<1 S LREND=1 Q
"RTN","LRAPBK",71,0)
 . I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W !,"Doesn't exist." Q
"RTN","LRAPBK",72,0)
 . K LRDFN,LRDPF,LRIDT,LRSS
"RTN","LRAPBK",73,0)
 . S LRSS=$P(^LRO(68,LRAA,0),"^",2),LRDFN=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),"^"),LRIDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",5)
"RTN","LRAPBK",74,0)
 . I LRSS=""!(LRIDT<1)!(LRDFN<1) W !,"Incomplete accession - unable to identify results." Q
"RTN","LRAPBK",75,0)
 . I LRSS'?1(1"SP",1"CY",1"EM",1"AU") W !,"This option only supports SP, CY, EM and AU subscripted accessions." Q
"RTN","LRAPBK",76,0)
 . D ACCB
"RTN","LRAPBK",77,0)
 ;
"RTN","LRAPBK",78,0)
 D END^LRUTL,END
"RTN","LRAPBK",79,0)
 Q
"RTN","LRAPBK",80,0)
 ;
"RTN","LRAPBK",81,0)
 ;
"RTN","LRAPBK",82,0)
ACCB ; Build variables for printing.
"RTN","LRAPBK",83,0)
 ;
"RTN","LRAPBK",84,0)
 N LREND,LRSINGLE,LRSTOP,LRX
"RTN","LRAPBK",85,0)
 S LRX=^LRO(68,LRAA,0)
"RTN","LRAPBK",86,0)
 S (LRO(68),LRAA(1))=$P(LRX,U),LRAA(2)=LRSS,LRABV=$P(LRX,U,11)
"RTN","LRAPBK",87,0)
 S LRACC=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),"^")
"RTN","LRAPBK",88,0)
 ;
"RTN","LRAPBK",89,0)
 S X=^DIC(4,DUZ(2),0),LRAA(4)=$P(X,"^"),LRAA(5)=$E($P($G(^(1)),"^",3),1,30),X=+$P(X,"^",2),LRAA(6)=$P($G(^DIC(5,X,0)),"^",2)
"RTN","LRAPBK",90,0)
 ;
"RTN","LRAPBK",91,0)
 S LRH(2)=$E(LRAD,1,3),LRH(0)=LRH(2)+1700
"RTN","LRAPBK",92,0)
 S (LRN(1),LRN(2))=LRAN
"RTN","LRAPBK",93,0)
 D XR^LRU
"RTN","LRAPBK",94,0)
 ;
"RTN","LRAPBK",95,0)
 S (LREND,LRSTOP)=0,LRSINGLE=1
"RTN","LRAPBK",96,0)
 S %ZIS="Q",ZTSAVE("DFN")="",ZTSAVE("LR*")="",ZTRTN="QUE^LRAPBK"
"RTN","LRAPBK",97,0)
 D IO^LRWU
"RTN","LRAPBK",98,0)
 Q
"RTN","LRAPBK",99,0)
 ;
"RTN","LRAPBK",100,0)
 ;
"RTN","LRAPBK",101,0)
SH ;
"RTN","LRAPBK",102,0)
 N LRX
"RTN","LRAPBK",103,0)
 S P(13)="",LRDFN=$O(^LR(LRXREF,LRH(2),LRABV,LRAN,0)) Q:'LRDFN!(LR("Q"))  I "SPCYEM"[LRSS S LRI=$O(^(LRDFN,0)) Q:'LRI
"RTN","LRAPBK",104,0)
 D:$Y>(IOSL-6) H Q:LR("Q")
"RTN","LRAPBK",105,0)
 K LRDPF,LRLLOC
"RTN","LRAPBK",106,0)
 D PT^LRX
"RTN","LRAPBK",107,0)
 I $G(LREND) K LREND Q
"RTN","LRAPBK",108,0)
 ;
"RTN","LRAPBK",109,0)
 S LRP=PNM,P(0)=$S(LRDPF=2:"PATIENT",1:"OTHER")
"RTN","LRAPBK",110,0)
 ;
"RTN","LRAPBK",111,0)
 I "SPCYEM"[LRSS Q:'$D(^LR(LRDFN,LRSS,LRI,0))  D
"RTN","LRAPBK",112,0)
 . S (LRX(0),X)=^LR(LRDFN,LRSS,LRI,0),LRX("ORU")=$G(^LR(LRDFN,LRSS,LRI,"ORU"))
"RTN","LRAPBK",113,0)
 . S LRLLOC=$P(X,U,8),Y=$P(X,U,7) D S
"RTN","LRAPBK",114,0)
 . S P(2)=Y,Y=$P(X,U,2) D S
"RTN","LRAPBK",115,0)
 . S P(1)=$E(Y,1,12),Y=$P(X,U,13) D S
"RTN","LRAPBK",116,0)
 . S P(13)=Y,LRSPDT=$$FMTE^XLFDT(($P(X,U,1)),"1M"),X=$P(X,U,10)
"RTN","LRAPBK",117,0)
 ;
"RTN","LRAPBK",118,0)
 I LRSS="AU" Q:'$D(^LR(LRDFN,"AU"))  D
"RTN","LRAPBK",119,0)
 . S (LRX(0),X)=^LR(LRDFN,"AU"),LRX("ORU")=$G(^LR(LRDFN,"AU","ORU"))
"RTN","LRAPBK",120,0)
 . S LRLLOC=$P(X,U,5),Y=$P(X,U,12) D S
"RTN","LRAPBK",121,0)
 . S P(2)=Y,Y=$P(X,U,7) D S
"RTN","LRAPBK",122,0)
 . S P(9)=$E(Y,1,15),Y=$P(X,U,2) D S
"RTN","LRAPBK",123,0)
 . S LR("ASST")=Y,Y=$P(X,U,10) D S
"RTN","LRAPBK",124,0)
 . S P(1)=$E(Y,1,12),X=+X
"RTN","LRAPBK",125,0)
 ;
"RTN","LRAPBK",126,0)
 S T=$$FMTE^XLFDT(X,"1P") S T=$P(T,",",1) S T=$TR(T," ","/")
"RTN","LRAPBK",127,0)
 W !,$J(T,6),?7,$J(LRAN,5),?14 W:P(0)'="PATIENT" "#"
"RTN","LRAPBK",128,0)
 W $E(LRP,1,18),?34,SSN(1),?40,$E(LRLLOC,1,8),?49,$E(P(2),1,16),?67,P(1),!?5,"Patient ID: ",SSN
"RTN","LRAPBK",129,0)
 S LRLLOC("TY")=$P($G(^LRO(68,LRAA,1,LRH(2)_"0000",1,LRAN,0)),U,11)
"RTN","LRAPBK",130,0)
 S LRLLOC("TY")=$S(LRLLOC("TY")="":"InPatient","WI"[LRLLOC("TY"):"InPatient",1:"OutPatient")
"RTN","LRAPBK",131,0)
 W !?5,LRLLOC("TY")
"RTN","LRAPBK",132,0)
 ;
"RTN","LRAPBK",133,0)
 W ?29,"Accession [UID]: "_$P(LRX(0),"^",6)_" ["_$P(LRX("ORU"),"^")_"]"
"RTN","LRAPBK",134,0)
 ;
"RTN","LRAPBK",135,0)
 I $G(^LRO(68,LRAA,1,LRH(2)_"0000",1,LRAN,"PCE")) D
"RTN","LRAPBK",136,0)
 . N IEN,LRENC,LRSTR,LRX,LRY,X,Y
"RTN","LRAPBK",137,0)
 . S LRSTR=^LRO(68,LRAA,1,LRH(2)_"0000",1,LRAN,"PCE")
"RTN","LRAPBK",138,0)
 . F IEN=1:1 S LRX=$P(LRSTR,";",IEN) Q:'LRX  D
"RTN","LRAPBK",139,0)
 . . K LRY
"RTN","LRAPBK",140,0)
 . . D GETCPT^PXAPIOE(LRX,"LRY","ERR")
"RTN","LRAPBK",141,0)
 . . S LRY=0
"RTN","LRAPBK",142,0)
 . . F  S LRY=$O(LRY(LRY)) Q:'LRY  S LRENC(LRX_"."_LRY)=LRY(LRY)
"RTN","LRAPBK",143,0)
 . I '$O(LRENC(0)) Q
"RTN","LRAPBK",144,0)
 . W !,"CPT Code: "
"RTN","LRAPBK",145,0)
 . S IEN=0
"RTN","LRAPBK",146,0)
 . F  S IEN=$O(LRENC(IEN)) Q:'IEN  W $P(LRENC(IEN),U)_"X"_$P(LRENC(IEN),U,16)_" " W:$X>70 !
"RTN","LRAPBK",147,0)
 ;
"RTN","LRAPBK",148,0)
 I "SPCYEM"[LRSS D
"RTN","LRAPBK",149,0)
 . W !,"Date specimen taken: ",LRSPDT
"RTN","LRAPBK",150,0)
 . S Y=$P($G(^LRO(68,LRAA,1,LRW,1,LRAN,0)),"^",10)
"RTN","LRAPBK",151,0)
 . I Y,$D(^VA(200,Y,0)) W ?39," Entered by: ",$P(^(0),"^")
"RTN","LRAPBK",152,0)
 ;
"RTN","LRAPBK",153,0)
 I P(13)'="" W !?39,"Released by: ",P(13)
"RTN","LRAPBK",154,0)
 S Y=+$G(^LRO(68,LRAA,1,LRH(2)_"0000",1,LRAN,.4)) I Y,Y'=DUZ(2) W !,$P($G(^DIC(4,Y,0)),U)
"RTN","LRAPBK",155,0)
 ;
"RTN","LRAPBK",156,0)
 I LRSS="AU" D
"RTN","LRAPBK",157,0)
 . S DA=LRDFN D D^LRAUAW
"RTN","LRAPBK",158,0)
 . S Y=LR(63,12) D D^LRU
"RTN","LRAPBK",159,0)
 . W !?14,"Date died: ",Y,?49,"Path resident:",?64,P(9)
"RTN","LRAPBK",160,0)
 . D AS
"RTN","LRAPBK",161,0)
 ;
"RTN","LRAPBK",162,0)
 ; Print specimens and any surgery case source references
"RTN","LRAPBK",163,0)
 I LRSS?1(1"SP",1"CY",1"EM") D
"RTN","LRAPBK",164,0)
 . N Z
"RTN","LRAPBK",165,0)
 . S Z=0
"RTN","LRAPBK",166,0)
 . F  S Z=$O(^LR(LRDFN,LRSS,LRI,.1,Z)) Q:'Z  D  Q:LR("Q")
"RTN","LRAPBK",167,0)
 . . I $Y>(IOSL-6) D H1 Q:LR("Q")
"RTN","LRAPBK",168,0)
 . . S Z(1)=$P(^LR(LRDFN,LRSS,LRI,.1,Z,0),"^")
"RTN","LRAPBK",169,0)
 . . W !,?$S($L(Z(1))<61:14,1:2),Z(1)
"RTN","LRAPBK",170,0)
 . I LR("Q") Q
"RTN","LRAPBK",171,0)
 . D SRCASE
"RTN","LRAPBK",172,0)
 ;
"RTN","LRAPBK",173,0)
 Q:LR("Q")
"RTN","LRAPBK",174,0)
 ;
"RTN","LRAPBK",175,0)
 ; Print SNOMED codes
"RTN","LRAPBK",176,0)
 I LRB,LRSS?1(1"SP",1"CY",1"EM"),$D(^LR(LRDFN,LRSS,LRI,2,0)) D  Q:LR("Q")
"RTN","LRAPBK",177,0)
 . I $Y>(IOSL-6) D H1 Q:LR("Q")
"RTN","LRAPBK",178,0)
 . W !?14,"SNOMED codes:"
"RTN","LRAPBK",179,0)
 . D ^LRAPBK1
"RTN","LRAPBK",180,0)
 ;
"RTN","LRAPBK",181,0)
 I LRB,LRSS="AU",$O(^LR(LRDFN,"AY",0)) D  Q:LR("Q")
"RTN","LRAPBK",182,0)
 . I $Y>(IOSL-6) D H1 Q:LR("Q")
"RTN","LRAPBK",183,0)
 . W !?14,"SNOMED codes:"
"RTN","LRAPBK",184,0)
 . D AU^LRAPBK1
"RTN","LRAPBK",185,0)
 ;
"RTN","LRAPBK",186,0)
 I LRSS'="AU" D D Q:LR("Q")
"RTN","LRAPBK",187,0)
 ;
"RTN","LRAPBK",188,0)
 Q:LR("Q")
"RTN","LRAPBK",189,0)
 W !,LR("%")
"RTN","LRAPBK",190,0)
 Q
"RTN","LRAPBK",191,0)
 ;
"RTN","LRAPBK",192,0)
 ;
"RTN","LRAPBK",193,0)
D ;
"RTN","LRAPBK",194,0)
 F Z(1)=99,97 Q:LR("Q")  D
"RTN","LRAPBK",195,0)
 . S Z=0
"RTN","LRAPBK",196,0)
 . F  S Z=$O(^LR(LRDFN,LRSS,LRI,Z(1),Z)) Q:'Z  D:$Y>(IOSL-6) H1 Q:LR("Q")  W !?4,^LR(LRDFN,LRSS,LRI,Z(1),Z,0)
"RTN","LRAPBK",197,0)
 Q
"RTN","LRAPBK",198,0)
 ;
"RTN","LRAPBK",199,0)
 ;
"RTN","LRAPBK",200,0)
H ;
"RTN","LRAPBK",201,0)
 I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
"RTN","LRAPBK",202,0)
 D F^LRU
"RTN","LRAPBK",203,0)
 I $G(LRSINGLE) W !,"LOG BOOK entry for accession ",LRACC,!
"RTN","LRAPBK",204,0)
 E  W !,LRO(68)," (",LRABV,") LOG BOOK for ",LRH(0),!
"RTN","LRAPBK",205,0)
 W "# =Demographic data in file other than PATIENT file"
"RTN","LRAPBK",206,0)
 W !,"Date",?8,"Num",?14,"Patient",?35,"ID",?40,"LOC",?49,"PHYSICIAN",?67,"PATHOLOGIST",!,LR("%")
"RTN","LRAPBK",207,0)
 Q
"RTN","LRAPBK",208,0)
 ;
"RTN","LRAPBK",209,0)
 ;
"RTN","LRAPBK",210,0)
H1 ;
"RTN","LRAPBK",211,0)
 D H Q:LR("Q")
"RTN","LRAPBK",212,0)
 W !,$J(T,5),?7,$J(LRAN,5),?14
"RTN","LRAPBK",213,0)
 W:P(0)'="PATIENT" "#"
"RTN","LRAPBK",214,0)
 W $E(LRP,1,18),?34,SSN(1),?40,$E(LRLLOC,1,8),?49,$E(P(2),1,16),?67,P(1)
"RTN","LRAPBK",215,0)
 Q
"RTN","LRAPBK",216,0)
 ;
"RTN","LRAPBK",217,0)
 ;
"RTN","LRAPBK",218,0)
S ;
"RTN","LRAPBK",219,0)
 S Y=$P($G(^VA(200,+Y,0)),U)
"RTN","LRAPBK",220,0)
 Q
"RTN","LRAPBK",221,0)
 ;
"RTN","LRAPBK",222,0)
 ;
"RTN","LRAPBK",223,0)
AS I $D(^LRO(68,LRAA,1,LRW,1,LRAN,0)) S Y=$P(^(0),"^",10) D S W ! W:Y]"" ?14,"Entered by: ",Y W:LR("ASST")]"" ?49,"Autopsy Asst: ",LR("ASST")
"RTN","LRAPBK",224,0)
 Q
"RTN","LRAPBK",225,0)
 ;
"RTN","LRAPBK",226,0)
 ;
"RTN","LRAPBK",227,0)
END ;
"RTN","LRAPBK",228,0)
 K LRSPDT D V^LRU
"RTN","LRAPBK",229,0)
 Q
"RTN","LRAPBK",230,0)
 ;
"RTN","LRAPBK",231,0)
 ;
"RTN","LRAPBK",232,0)
SRCASE ; Print related surgery case info
"RTN","LRAPBK",233,0)
 ;
"RTN","LRAPBK",234,0)
 N LRDATA,LRFIELDNAME,LRFIELDNUM,LRIENS,LRJ,LRK,LRREF,LRSRTN,LRSUBFILE,LRTAB,LRX,LRY
"RTN","LRAPBK",235,0)
 ;
"RTN","LRAPBK",236,0)
 ;ZEXCEPT: IOM,IOSL,LRDFN,LRI,LRSS
"RTN","LRAPBK",237,0)
 ;
"RTN","LRAPBK",238,0)
 ; Print related surgical case #
"RTN","LRAPBK",239,0)
 S LRIENS=LRDFN_","_LRSS_","_LRI_",0"
"RTN","LRAPBK",240,0)
 I $D(^LR(LRDFN,"EPR","AD",LRIENS,1)) D
"RTN","LRAPBK",241,0)
 . S LRJ=$O(^LR(LRDFN,"EPR","AD",LRIENS,1,0)),LRREF=LRJ_","_LRDFN_","
"RTN","LRAPBK",242,0)
 . D GETDATA^LRUEPR(.LRDATA,LRREF)
"RTN","LRAPBK",243,0)
 . S LRSRTN=LRDATA(63.00013,LRREF,1,"I")
"RTN","LRAPBK",244,0)
 . I $P(LRSRTN,";",3)="" W !,"Related Surgery Case #"_$P(LRSRTN,";")
"RTN","LRAPBK",245,0)
 . E  W !,$P(LRSRTN,";",3)
"RTN","LRAPBK",246,0)
 ;
"RTN","LRAPBK",247,0)
 I '$$GET^XPAR("DIV^PKG","LR AP SURGERY REFERENCE",1,"Q") Q
"RTN","LRAPBK",248,0)
 ;
"RTN","LRAPBK",249,0)
 ; Print source of surgical case info copied to Lab package.
"RTN","LRAPBK",250,0)
 F LRJ=.2,.3,.4,.5 D  Q:LR("Q")
"RTN","LRAPBK",251,0)
 . S LRIENS=LRDFN_","_LRSS_","_LRI_","_LRJ_",0"
"RTN","LRAPBK",252,0)
 . I '$D(^LR(LRDFN,"EPR","AD",LRIENS,1)) Q
"RTN","LRAPBK",253,0)
 . I $Y>(IOSL-6) D H1 Q:LR("Q")
"RTN","LRAPBK",254,0)
 . S LRK=$O(^LR(LRDFN,"EPR","AD",LRIENS,1,0)),LRREF=LRK_","_LRDFN_","
"RTN","LRAPBK",255,0)
 . K LRDATA
"RTN","LRAPBK",256,0)
 . D GETDATA^LRUEPR(.LRDATA,LRREF)
"RTN","LRAPBK",257,0)
 . S LRSUBFILE=$S(LRSS="SP":63.08,LRSS="CY":63.09,LRSS="EM":63.02,1:"")
"RTN","LRAPBK",258,0)
 . S LRFIELDNUM=((LRJ*10)+11)/1000
"RTN","LRAPBK",259,0)
 . S LRFIELDNAME=$$GET1^DID(LRSUBFILE,LRFIELDNUM,"","LABEL")
"RTN","LRAPBK",260,0)
 . S LRX=$P(LRDATA(63.00013,LRREF,1,"I"),";",3)
"RTN","LRAPBK",261,0)
 . W !,LRFIELDNAME_": " S LRTAB=$X
"RTN","LRAPBK",262,0)
 . I IOM'<($L(LRX)+LRTAB) W LRX Q
"RTN","LRAPBK",263,0)
 . F LRK=1:1:$L(LRX," ") D
"RTN","LRAPBK",264,0)
 . . S LRY=$P(LRX," ",LRK)
"RTN","LRAPBK",265,0)
 . . I $X>LRTAB,($X+$L(LRY)+1)>IOM W !,?LRTAB,LRY Q
"RTN","LRAPBK",266,0)
 . . W:$X>LRTAB " " W LRY
"RTN","LRAPBK",267,0)
 ;
"RTN","LRAPBK",268,0)
 Q
"RTN","LRAPBR")
0^3^B6460203
"RTN","LRAPBR",1,0)
LRAPBR ;DALOI/WTY - AP Browser Print/TIU TMP Global;11/21/12  15:12
"RTN","LRAPBR",2,0)
 ;;5.2;LAB SERVICE;**259,427**;Sep 27, 1994;Build 33
"RTN","LRAPBR",3,0)
 ;
"RTN","LRAPBR",4,0)
 ;Reference to ^DPT supported by IA #918
"RTN","LRAPBR",5,0)
 ;
"RTN","LRAPBR",6,0)
INIT(LRAA,LRSS,LRI,LRDFN,LRAA1,LRAU,LRTIU,LRNTIME) ;
"RTN","LRAPBR",7,0)
 ;Define variables and arrays used for report display
"RTN","LRAPBR",8,0)
 N LRIENS,LCT,LREFLG,LRPRAC
"RTN","LRAPBR",9,0)
 S:'$D(LRTIU) LRTIU=0
"RTN","LRAPBR",10,0)
 ;KLL-Change all "-" and "=" to "- " and "=-"
"RTN","LRAPBR",11,0)
 S $P(LR("%"),"- ",IOM/2)="- "
"RTN","LRAPBR",12,0)
 I $L(LR("%"))>(IOM-1) S LR("%")=$E(LR("%"),1,(IOM-1))
"RTN","LRAPBR",13,0)
 S $P(LR("%1"),"=-",IOM/2)="=-"
"RTN","LRAPBR",14,0)
 I $L(LR("%1"))>(IOM-1) S LR("%1")=$E(LR("%1"),1,(IOM-1))
"RTN","LRAPBR",15,0)
 S LRQ(8)=$S($D(^LRO(69.2,LRAA,0)):$P(^(0),"^",8),1:"")
"RTN","LRAPBR",16,0)
 S LRQ=0,LRQ(1)=$$INS^LRU
"RTN","LRAPBR",17,0)
 I LRAU D
"RTN","LRAPBR",18,0)
 .S LRS="W",LRAP=LRDFN,LRXR="A"_LRSS,LRXREF=LRXR_"A"
"RTN","LRAPBR",19,0)
 .S LR(.21)=+$G(^LRO(69.2,LRAA,.2)),LRS(5)=1
"RTN","LRAPBR",20,0)
 .D EN^LRUA
"RTN","LRAPBR",21,0)
 .D ^LRUP
"RTN","LRAPBR",22,0)
 I 'LRAU D
"RTN","LRAPBR",23,0)
 .D SET^LRUA
"RTN","LRAPBR",24,0)
 .S LRA=1
"RTN","LRAPBR",25,0)
 .S LRS(5)=1,LRQ(2)=1
"RTN","LRAPBR",26,0)
 .S LR("DIWF")=$S($P(^LRO(69.2,LRAA,0),"^",6)="D":"D",1:"")_"W"
"RTN","LRAPBR",27,0)
MAIN ;Main Subroutine
"RTN","LRAPBR",28,0)
 K ^UTILITY($J)
"RTN","LRAPBR",29,0)
 D:'LRAU ENTER^LRAPBR1
"RTN","LRAPBR",30,0)
 D:LRAU ENTER^LRAPBR4
"RTN","LRAPBR",31,0)
 I 'LRAU,'LRTIU D
"RTN","LRAPBR",32,0)
 .D POW,^LRAPBR2
"RTN","LRAPBR",33,0)
 .I $D(^LR(LRDFN,"AU")),$P(^LR(LRDFN,"AU"),"^") D ^LRAPBR5
"RTN","LRAPBR",34,0)
 I LRTIU,'LRAU D ESIGLN^LRAPBR1
"RTN","LRAPBR",35,0)
 D:'LRAU PPL^LRAPBR1
"RTN","LRAPBR",36,0)
 D:'LRAU FOOTER^LRAPBR1
"RTN","LRAPBR",37,0)
 D:'LRTIU BROWSER
"RTN","LRAPBR",38,0)
 D END
"RTN","LRAPBR",39,0)
 Q
"RTN","LRAPBR",40,0)
POW ;Determine POW or Persian Gulf status
"RTN","LRAPBR",41,0)
 I $P($G(^LR(LRDFN,0)),"^",2)=2 D
"RTN","LRAPBR",42,0)
 .S LRPOW=0
"RTN","LRAPBR",43,0)
 .I $D(^DPT(DFN,.52)) S:$P(^(.52),U,5)="Y" LRPOW=1
"RTN","LRAPBR",44,0)
 .I $D(^DPT(DFN,.322)) S:$P($G(^(.322)),"^",10)="Y" LRPOW=1
"RTN","LRAPBR",45,0)
 .D ^LRAPBRPW
"RTN","LRAPBR",46,0)
 .K LRPOW
"RTN","LRAPBR",47,0)
 Q
"RTN","LRAPBR",48,0)
FINAL ;Final Section
"RTN","LRAPBR",49,0)
 ;Print text in field SNOMED & TC CODING (#10) of the LAB SECTION
"RTN","LRAPBR",50,0)
 ;PRINT FILE (#69.2)
"RTN","LRAPBR",51,0)
 Q:'$P($G(^LRO(69.2,LRAA,10,0)),"^",4)
"RTN","LRAPBR",52,0)
 K LRTMP,^UTILITY($J,"W")
"RTN","LRAPBR",53,0)
 S LRFILE=69.2,LRFLD=10,LRIENS=LRAA_","
"RTN","LRAPBR",54,0)
 N X,DIWR,DIWL
"RTN","LRAPBR",55,0)
 S X=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","LRTMP")
"RTN","LRAPBR",56,0)
 S DIWR=IOM-5,DIWL=5,DIWF=""
"RTN","LRAPBR",57,0)
 S X=+$$GET1^DID(LRFILE,LRFLD,"","SPECIFIER")
"RTN","LRAPBR",58,0)
 I $$GET1^DID(X,.01,"","SPECIFIER")["L" S DIWF="N"
"RTN","LRAPBR",59,0)
 S A=0 F  S A=$O(LRTMP(A)) Q:'A  S X=LRTMP(A) D ^DIWP
"RTN","LRAPBR",60,0)
 S A=0 F  S A=$O(^UTILITY($J,"W",DIWL,A)) Q:'A  D
"RTN","LRAPBR",61,0)
 .D GLENTRY^LRAPBR1(^UTILITY($J,"W",DIWL,A,0),DIWL,1)
"RTN","LRAPBR",62,0)
 K ^UTILITY($J,"W")
"RTN","LRAPBR",63,0)
 Q
"RTN","LRAPBR",64,0)
BROWSER ;
"RTN","LRAPBR",65,0)
 ;SET LRW(1)=2-DIGIT YEAR OF AUTOPSY DATE
"RTN","LRAPBR",66,0)
 I LRAU,LRQ(8)'="" S LRW(1)=$E(+$$GET1^DIQ(63,LRDFN,11,"I"),2,3)
"RTN","LRAPBR",67,0)
 S LRTITLE=$S(LRQ(8)'="":LRQ(8)_LRW(1)_" "_LRAC,1:LRAC)_" - "_LRP
"RTN","LRAPBR",68,0)
 S LRROOT="^TMP(""LRAPBR"",$J)"
"RTN","LRAPBR",69,0)
 D BROWSE^DDBR(LRROOT,"",LRTITLE)
"RTN","LRAPBR",70,0)
 Q
"RTN","LRAPBR",71,0)
END ;
"RTN","LRAPBR",72,0)
 K LRSR1,LRSR2,LRTEXT,LRTIU,LRTITLE,LRROOT
"RTN","LRAPBR",73,0)
 Q
"RTN","LRAPBR1")
0^4^B133054463
"RTN","LRAPBR1",1,0)
LRAPBR1 ;DALOI/STAFF - AP Browser Print Cont. ;03/21/13  15:28
"RTN","LRAPBR1",2,0)
 ;;5.2;LAB SERVICE;**259,317,363,350,427**;Sep 27, 1994;Build 33
"RTN","LRAPBR1",3,0)
 ;
"RTN","LRAPBR1",4,0)
 ;
"RTN","LRAPBR1",5,0)
ENTER ; from LRAPBR
"RTN","LRAPBR1",6,0)
 N LRCNT,LRTMP,LRA1,LRADESC,LRLENG1,LRLENG2,LRFILE,LRAPMD
"RTN","LRAPBR1",7,0)
 N LRFLD,LRV,LRV1,LRV2,LRX,LRB1,LRTEXT,LRSPCE,LRIENS,LRAPMR
"RTN","LRAPBR1",8,0)
 Q:'$D(^LR(LRDFN,LRSS,LRI,0))
"RTN","LRAPBR1",9,0)
 S:'LRTIU GROOT="^TMP(""LRAPBR"",$J,"
"RTN","LRAPBR1",10,0)
 S:LRTIU GROOT="^TMP(""TIUP"",$J,"
"RTN","LRAPBR1",11,0)
 ;
"RTN","LRAPBR1",12,0)
 D GETPCP^LRAPUTL(.LRPRAC,LRDFN,LRSS,LRI)
"RTN","LRAPBR1",13,0)
 ;
"RTN","LRAPBR1",14,0)
 ; If reporting lab available then use instead of VistA site name.
"RTN","LRAPBR1",15,0)
 S LRX=+$G(^LR(LRDFN,LRSS,LRI,"RF"))
"RTN","LRAPBR1",16,0)
 I LRX S LRQ(1)=$$NAME^XUAF4(LRX)
"RTN","LRAPBR1",17,0)
 ;
"RTN","LRAPBR1",18,0)
 S LRQ=0 D ^LRUA,HEADER
"RTN","LRAPBR1",19,0)
 S LR("F")=1
"RTN","LRAPBR1",20,0)
 D DASH
"RTN","LRAPBR1",21,0)
 D:LRTIU GLENTRY("$TEXT",,1)
"RTN","LRAPBR1",22,0)
 D GLENTRY("Submitted by: "_LRW(5),"",1)
"RTN","LRAPBR1",23,0)
 D GLENTRY("Date obtained: "_LRTK,44)
"RTN","LRAPBR1",24,0)
 D:LRA DASH
"RTN","LRAPBR1",25,0)
 ;
"RTN","LRAPBR1",26,0)
 S LRIENS=LRI_","_LRDFN_","
"RTN","LRAPBR1",27,0)
 ;
"RTN","LRAPBR1",28,0)
 ;
"RTN","LRAPBR1",29,0)
MAIN ;
"RTN","LRAPBR1",30,0)
 D SPEC
"RTN","LRAPBR1",31,0)
 D MODCHK
"RTN","LRAPBR1",32,0)
 D SUPBNNR
"RTN","LRAPBR1",33,0)
 ; DALOI/LMT - LR,427 - Removed comments from report to restore pre-LR,350 behavior
"RTN","LRAPBR1",34,0)
 ;D COMMENT
"RTN","LRAPBR1",35,0)
 D DIAG
"RTN","LRAPBR1",36,0)
 D DOC
"RTN","LRAPBR1",37,0)
 D WPFLD
"RTN","LRAPBR1",38,0)
 D SUPRPT
"RTN","LRAPBR1",39,0)
 D SSJR
"RTN","LRAPBR1",40,0)
 Q
"RTN","LRAPBR1",41,0)
 ;
"RTN","LRAPBR1",42,0)
 ;
"RTN","LRAPBR1",43,0)
SPEC ; List specimens
"RTN","LRAPBR1",44,0)
 ;
"RTN","LRAPBR1",45,0)
 ;ZEXCEPT: LRDFN,LRI,LRIENS,LRSF,LRSS
"RTN","LRAPBR1",46,0)
 ;
"RTN","LRAPBR1",47,0)
 N LRB,LRFILE,LRX
"RTN","LRAPBR1",48,0)
 ;
"RTN","LRAPBR1",49,0)
 D GLENTRY("Specimen (Received "_LRTK(1)_"):","",1)
"RTN","LRAPBR1",50,0)
 ;
"RTN","LRAPBR1",51,0)
 S LRFILE=+$$GET1^DID(LRSF,.012,"","SPECIFIER")
"RTN","LRAPBR1",52,0)
 S LRB=0
"RTN","LRAPBR1",53,0)
 F  S LRB=$O(^LR(LRDFN,LRSS,LRI,.1,LRB)) Q:LRB<1  D
"RTN","LRAPBR1",54,0)
 . S LRX=$$GET1^DIQ(LRFILE,LRB_","_LRIENS,.01)
"RTN","LRAPBR1",55,0)
 . D GLENTRY(LRX,"",1)
"RTN","LRAPBR1",56,0)
 ;
"RTN","LRAPBR1",57,0)
 Q
"RTN","LRAPBR1",58,0)
 ;
"RTN","LRAPBR1",59,0)
 ;
"RTN","LRAPBR1",60,0)
MODCHK ; Display modified banner if required
"RTN","LRAPBR1",61,0)
 S LRAPMR=$$GET1^DIQ(LRSF,LRIENS,.17,"I")
"RTN","LRAPBR1",62,0)
 Q:'LRAPMR
"RTN","LRAPBR1",63,0)
 S LRAPMD=$$GET1^DIQ(LRSF,LRIENS,.172,"I")
"RTN","LRAPBR1",64,0)
 D GLENTRY("","",1)
"RTN","LRAPBR1",65,0)
 S LRTEXT=""
"RTN","LRAPBR1",66,0)
 F LRCNT=1:1:$S(LRAPMD:14,1:15) D
"RTN","LRAPBR1",67,0)
 . S LRTEXT=LRTEXT_"*+"
"RTN","LRAPBR1",68,0)
 S LRTEXT=LRTEXT_" MODIFIED "
"RTN","LRAPBR1",69,0)
 S LRTEXT=LRTEXT_$S(LRAPMD:"DIAGNOSIS ",1:"REPORT ")
"RTN","LRAPBR1",70,0)
 F LRCNT=1:1:$S(LRAPMD:14,1:15) D
"RTN","LRAPBR1",71,0)
 . S LRTEXT=LRTEXT_"*+"
"RTN","LRAPBR1",72,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBR1",73,0)
 D GLENTRY("","",1)
"RTN","LRAPBR1",74,0)
 Q
"RTN","LRAPBR1",75,0)
 ;
"RTN","LRAPBR1",76,0)
 ;
"RTN","LRAPBR1",77,0)
SUPBNNR ; Display supplementary report header if one or more has been added
"RTN","LRAPBR1",78,0)
 I $P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4) D
"RTN","LRAPBR1",79,0)
 . S LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED *+*"
"RTN","LRAPBR1",80,0)
 . D GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
"RTN","LRAPBR1",81,0)
 . S LRTEXT="*+* REFER TO BOTTOM OF REPORT *+*"
"RTN","LRAPBR1",82,0)
 . D GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
"RTN","LRAPBR1",83,0)
 . D GLENTRY("","",1)
"RTN","LRAPBR1",84,0)
 Q
"RTN","LRAPBR1",85,0)
 ;
"RTN","LRAPBR1",86,0)
 ;
"RTN","LRAPBR1",87,0)
DIAG ; Display the Brief Clinical History, Preoperative Diagnosis, Operative Findings, and Postoperative Diagnosis
"RTN","LRAPBR1",88,0)
 S LRFILE=LRSF,LRCNT=0,LRIENS=LRI_","_LRDFN_","
"RTN","LRAPBR1",89,0)
 F LRFLD=.013:.001:.016 D
"RTN","LRAPBR1",90,0)
 . D:LRA DASH
"RTN","LRAPBR1",91,0)
 . S LRCNT=LRCNT+1
"RTN","LRAPBR1",92,0)
 . D GLENTRY($P($T(TEXT1+LRCNT),";",3),"",1)
"RTN","LRAPBR1",93,0)
 . D WP
"RTN","LRAPBR1",94,0)
 Q
"RTN","LRAPBR1",95,0)
 ;
"RTN","LRAPBR1",96,0)
 ;
"RTN","LRAPBR1",97,0)
DOC ; Pathologist information
"RTN","LRAPBR1",98,0)
 ;
"RTN","LRAPBR1",99,0)
 N LRIENS,LRX
"RTN","LRAPBR1",100,0)
 D GLENTRY("","",1)
"RTN","LRAPBR1",101,0)
 ;
"RTN","LRAPBR1",102,0)
 ; Retrieve surgeon/attending
"RTN","LRAPBR1",103,0)
 D ATTEND(.LRMD)
"RTN","LRAPBR1",104,0)
 D GLENTRY("Surgeon/physician: "_LRMD,27,1)
"RTN","LRAPBR1",105,0)
 I LRMD("SR-SURGEON")'="" D GLENTRY(LRMD("SR-SURGEON"),28,1)
"RTN","LRAPBR1",106,0)
 I LRMD("SR-ATTEND")'="" D GLENTRY(LRMD("SR-ATTEND"),26,1)
"RTN","LRAPBR1",107,0)
 ;I +$G(LRMD("ERR"))=601 D GLENTRY($P(LRMD("ERR"),"^",2),26,1)
"RTN","LRAPBR1",108,0)
 ;
"RTN","LRAPBR1",109,0)
 D:LRA GLENTRY(LR("%1"),"",1)
"RTN","LRAPBR1",110,0)
 D DASH
"RTN","LRAPBR1",111,0)
 D HEADER2
"RTN","LRAPBR1",112,0)
 D:LRA DASH
"RTN","LRAPBR1",113,0)
 I LRRC="" D
"RTN","LRAPBR1",114,0)
 . D GLENTRY("+*+* REPORT INCOMPLETE *+*+",20,1)
"RTN","LRAPBR1",115,0)
 . D GLENTRY("","",1)
"RTN","LRAPBR1",116,0)
 D GLENTRY("","",1)
"RTN","LRAPBR1",117,0)
 I LRRMD'="" D
"RTN","LRAPBR1",118,0)
 . S LRCNT=0 F LRA1="SP","CY","EM" D
"RTN","LRAPBR1",119,0)
 . . S LRCNT=LRCNT+1
"RTN","LRAPBR1",120,0)
 . . S LRTMP(LRA1)=$P($T(TEXT2+LRCNT),";",4)
"RTN","LRAPBR1",121,0)
 . S LRTMP=LRTMP(LRSS)
"RTN","LRAPBR1",122,0)
 . D GLENTRY(LRTMP_" "_LRRMD,31)
"RTN","LRAPBR1",123,0)
 Q
"RTN","LRAPBR1",124,0)
 ;
"RTN","LRAPBR1",125,0)
 ;
"RTN","LRAPBR1",126,0)
WPFLD ; Display Frozen Section, Gross Description, Microscopic Description and Surgical Path Diagnosis
"RTN","LRAPBR1",127,0)
 F LRCNT=1:1:4 D
"RTN","LRAPBR1",128,0)
 . S X=$T(FIELDS+LRCNT)
"RTN","LRAPBR1",129,0)
 . S LRV=$P(X,";",3),LRV1=$P(X,";",4),LRV2=$P(X,";",5)
"RTN","LRAPBR1",130,0)
 . D TEXTCHK
"RTN","LRAPBR1",131,0)
 . I $P($G(^LR(LRDFN,LRSS,LRI,LRV,0)),U,4) D
"RTN","LRAPBR1",132,0)
 . . D GLENTRY("","",1),GLENTRY(LR(69.2,LRV1),"",1)
"RTN","LRAPBR1",133,0)
 . . S LRFILE=LRSF,LRIENS=LRI_","_LRDFN_",",LRFLD=LRV
"RTN","LRAPBR1",134,0)
 . . I $P($G(^LR(LRDFN,LRSS,LRI,LRV2,0)),U,4) D
"RTN","LRAPBR1",135,0)
 . . . S LRFILE1=+$$GET1^DID(LRSF,LRV2,"","SPECIFIER")
"RTN","LRAPBR1",136,0)
 . . . D GLENTRY("*+* MODIFIED REPORT *+*",28,1)
"RTN","LRAPBR1",137,0)
 . . . D GLENTRY("(Last modified: ","",1)
"RTN","LRAPBR1",138,0)
 . . . S (LRA1,LRB1)=0
"RTN","LRAPBR1",139,0)
 . . . F  S LRA1=$O(^LR(LRDFN,LRSS,LRI,LRV2,LRA1)) Q:'LRA1  S LRB1=LRA1
"RTN","LRAPBR1",140,0)
 . . . Q:'$D(^LR(LRDFN,LRSS,LRI,LRV2,LRB1,0))
"RTN","LRAPBR1",141,0)
 . . . S LRSR1=$$GET1^DIQ(LRFILE1,LRB1_","_LRIENS,.01)
"RTN","LRAPBR1",142,0)
 . . . S LRSR2=$$GET1^DIQ(LRFILE1,LRB1_","_LRIENS,.02)
"RTN","LRAPBR1",143,0)
 . . . S LRTEXT=LRSR1_" typed by "_LRSR2_")"
"RTN","LRAPBR1",144,0)
 . . . D GLENTRY(LRTEXT,BTAB)
"RTN","LRAPBR1",145,0)
 . . D WP
"RTN","LRAPBR1",146,0)
 Q
"RTN","LRAPBR1",147,0)
 ;
"RTN","LRAPBR1",148,0)
 ;
"RTN","LRAPBR1",149,0)
SUPRPT ; Supplementary Report
"RTN","LRAPBR1",150,0)
 N LRA2
"RTN","LRAPBR1",151,0)
 I $P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),U,4) D
"RTN","LRAPBR1",152,0)
 . S LRFILE=+$$GET1^DID(LRSF,1.2,"","SPECIFIER")
"RTN","LRAPBR1",153,0)
 . S LRIENS1=LRI_","_LRDFN_","
"RTN","LRAPBR1",154,0)
 . D GLENTRY("","",1),GLENTRY("SUPPLEMENTARY REPORT(S):","",1)
"RTN","LRAPBR1",155,0)
 . S LRV=0 F  S LRV=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV)) Q:'LRV  D
"RTN","LRAPBR1",156,0)
 . . S LRIENS=LRV_","_LRIENS1
"RTN","LRAPBR1",157,0)
 . . S LRSR1=$$GET1^DIQ(LRFILE,LRIENS,.01)
"RTN","LRAPBR1",158,0)
 . . S LRSR2=+$$GET1^DIQ(LRFILE,LRIENS,.02)
"RTN","LRAPBR1",159,0)
 . . D GLENTRY("Supplementary Report Date: "_LRSR1,3,1)
"RTN","LRAPBR1",160,0)
 . . I $D(LR("R")),'LRSR2 D GLENTRY(" not verified",BTAB) Q
"RTN","LRAPBR1",161,0)
 . . I $P($G(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,0)),U,4) D
"RTN","LRAPBR1",162,0)
 . . . S LRTEXT="*+* SUPPLEMENTARY REPORT HAS BEEN ADDED/MODIFIED *+*"
"RTN","LRAPBR1",163,0)
 . . . D GLENTRY($$CJ^XLFSTR(LRTEXT,IOM),"",1)
"RTN","LRAPBR1",164,0)
 . . . D GLENTRY("(Added/Last","",1)
"RTN","LRAPBR1",165,0)
 . . . S (LRA1,LRB1)=0
"RTN","LRAPBR1",166,0)
 . . . F  S LRA1=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,LRA1)) Q:'LRA1  D
"RTN","LRAPBR1",167,0)
 . . . . S LRB1=LRA1
"RTN","LRAPBR1",168,0)
 . . . Q:'$D(^LR(LRDFN,LRSS,LRI,1.2,LRV,2,LRB1,0))
"RTN","LRAPBR1",169,0)
 . . . S LRA2=^(0),Y=+LRA2,LRA2A=$P(LRA2,"^",2),LRSGN=" Typed by ",LRDSC=" modified: "
"RTN","LRAPBR1",170,0)
 . . . I $P(LRA2,"^",3) S LRSGN=" Signed by ",LRDSC=" released: ",LRA2A=$P(LRA2,"^",3),Y=$P(LRA2,"^",4)
"RTN","LRAPBR1",171,0)
 . . . S LRA2A=$S($D(^VA(200,LRA2A,0)):$P(^(0),"^"),1:LRA2A)
"RTN","LRAPBR1",172,0)
 . . . D D^LRU
"RTN","LRAPBR1",173,0)
 . . . D GLENTRY(LRDSC_Y_LRSGN_LRA2A_")",BTAB)
"RTN","LRAPBR1",174,0)
 . . S LRFLD=1 D WP
"RTN","LRAPBR1",175,0)
 . . D GLENTRY("","",1)
"RTN","LRAPBR1",176,0)
 Q
"RTN","LRAPBR1",177,0)
 ;
"RTN","LRAPBR1",178,0)
 ;
"RTN","LRAPBR1",179,0)
COMMENT ; Print comment field (#99)
"RTN","LRAPBR1",180,0)
 ;
"RTN","LRAPBR1",181,0)
 N LRB
"RTN","LRAPBR1",182,0)
 I '$O(^LR(LRDFN,LRSS,LRI,99,0)) Q
"RTN","LRAPBR1",183,0)
 ;
"RTN","LRAPBR1",184,0)
 D GLENTRY("Comment:","",1)
"RTN","LRAPBR1",185,0)
 ;
"RTN","LRAPBR1",186,0)
 S LRB=0
"RTN","LRAPBR1",187,0)
 F  S LRB=$O(^LR(LRDFN,LRSS,LRI,99,LRB)) Q:'LRB  D
"RTN","LRAPBR1",188,0)
 . S LRB(0)=^LR(LRDFN,LRSS,LRI,99,LRB,0)
"RTN","LRAPBR1",189,0)
 . D GLENTRY(LRB(0),"",1)
"RTN","LRAPBR1",190,0)
 ;
"RTN","LRAPBR1",191,0)
 D GLENTRY("","",1)
"RTN","LRAPBR1",192,0)
 ;
"RTN","LRAPBR1",193,0)
 Q
"RTN","LRAPBR1",194,0)
 ;
"RTN","LRAPBR1",195,0)
 ;
"RTN","LRAPBR1",196,0)
SSJR ; Print special studies/journal references
"RTN","LRAPBR1",197,0)
 D ^LRAPBR3
"RTN","LRAPBR1",198,0)
 S LREFLG=1
"RTN","LRAPBR1",199,0)
 Q
"RTN","LRAPBR1",200,0)
 ;
"RTN","LRAPBR1",201,0)
 ;
"RTN","LRAPBR1",202,0)
PPL ; Print performing laboratories.
"RTN","LRAPBR1",203,0)
 N LRPL,LRJ
"RTN","LRAPBR1",204,0)
 ;
"RTN","LRAPBR1",205,0)
 D RETLST^LRRPL(.LRPL,LRDFN,LRSS,LRI,0)
"RTN","LRAPBR1",206,0)
 I $G(LRPL)<1 Q
"RTN","LRAPBR1",207,0)
 ;
"RTN","LRAPBR1",208,0)
 D GLENTRY("","",1)
"RTN","LRAPBR1",209,0)
 D GLENTRY("","",1)
"RTN","LRAPBR1",210,0)
 ;
"RTN","LRAPBR1",211,0)
 D GLENTRY("Performing Laboratory:","",1)
"RTN","LRAPBR1",212,0)
 S LRJ=0
"RTN","LRAPBR1",213,0)
 F  S LRJ=$O(LRPL(LRJ)) Q:'LRJ  D GLENTRY(LRPL(LRJ),"",1)
"RTN","LRAPBR1",214,0)
 ;
"RTN","LRAPBR1",215,0)
 D GLENTRY("","",1)
"RTN","LRAPBR1",216,0)
 ;
"RTN","LRAPBR1",217,0)
 Q
"RTN","LRAPBR1",218,0)
 ;
"RTN","LRAPBR1",219,0)
 ;
"RTN","LRAPBR1",220,0)
WP ; Display word processing fields
"RTN","LRAPBR1",221,0)
 K LRTMP,^UTILITY($J,"W")
"RTN","LRAPBR1",222,0)
 N X,DIWR,DIWL,LRINC
"RTN","LRAPBR1",223,0)
 S X=$$GET1^DIQ(LRFILE,LRIENS,LRFLD,"","LRTMP",)
"RTN","LRAPBR1",224,0)
 S DIWR=IOM-5,DIWL=5,DIWF=$G(DIWF)
"RTN","LRAPBR1",225,0)
 S X=+$$GET1^DID(LRFILE,LRFLD,"","SPECIFIER")
"RTN","LRAPBR1",226,0)
 I $$GET1^DID(X,.01,"","SPECIFIER")["L",DIWF'["N" S DIWF=DIWF_"N"
"RTN","LRAPBR1",227,0)
 S LRINC=0
"RTN","LRAPBR1",228,0)
 F  S LRINC=$O(LRTMP(LRINC)) Q:'LRINC  S X=LRTMP(LRINC) D ^DIWP
"RTN","LRAPBR1",229,0)
 S LRINC=0
"RTN","LRAPBR1",230,0)
 F  S LRINC=$O(^UTILITY($J,"W",DIWL,LRINC)) Q:'LRINC  D GLENTRY(^UTILITY($J,"W",DIWL,LRINC,0),DIWL,1)
"RTN","LRAPBR1",231,0)
 K ^UTILITY($J,"W")
"RTN","LRAPBR1",232,0)
 Q
"RTN","LRAPBR1",233,0)
 ;
"RTN","LRAPBR1",234,0)
 ;
"RTN","LRAPBR1",235,0)
HEADER ;
"RTN","LRAPBR1",236,0)
 D:LRTIU GLENTRY("$APHDR",,1)
"RTN","LRAPBR1",237,0)
 D GLENTRY("","",1)
"RTN","LRAPBR1",238,0)
 ;
"RTN","LRAPBR1",239,0)
 ; Print names of facilities printing/releasing this report.
"RTN","LRAPBR1",240,0)
 N LRN,LRPL,LRRL,LRX
"RTN","LRAPBR1",241,0)
 I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1,'LRTIU D
"RTN","LRAPBR1",242,0)
 . D PFAC^LRRP1(DUZ(2),"",1,.LRPL)
"RTN","LRAPBR1",243,0)
 . S LRN=0
"RTN","LRAPBR1",244,0)
 . F  S LRN=$O(LRPL(LRN)) Q:'LRN  D GLENTRY(LRPL(LRN),"",1)
"RTN","LRAPBR1",245,0)
 ;
"RTN","LRAPBR1",246,0)
 ; Display reporting lab
"RTN","LRAPBR1",247,0)
 I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2 D
"RTN","LRAPBR1",248,0)
 . S LRX=+$G(^LR(LRDFN,LRSS,LRI,"RF"))
"RTN","LRAPBR1",249,0)
 . I LRX<1 Q
"RTN","LRAPBR1",250,0)
 . D RL^LRRP1(LRX,1,.LRRL),GLENTRY("","",1)
"RTN","LRAPBR1",251,0)
 . S LRN=0
"RTN","LRAPBR1",252,0)
 . F  S LRN=$O(LRRL(LRN)) Q:'LRN  D GLENTRY(LRRL(LRN),"",1)
"RTN","LRAPBR1",253,0)
 ;
"RTN","LRAPBR1",254,0)
 D DASH
"RTN","LRAPBR1",255,0)
 D GLENTRY("MEDICAL RECORD |",5,1)
"RTN","LRAPBR1",256,0)
 D GLENTRY(LRAA1,40)
"RTN","LRAPBR1",257,0)
 D DASH
"RTN","LRAPBR1",258,0)
 ;
"RTN","LRAPBR1",259,0)
 ;
"RTN","LRAPBR1",260,0)
HEADER2 ;
"RTN","LRAPBR1",261,0)
 ;
"RTN","LRAPBR1",262,0)
 S LRADESC="Accession No. "_$S(LRQ(8)]"":LRQ(8)_LRW(1)_" "_LRAC,1:LRAC)
"RTN","LRAPBR1",263,0)
 S LRLENG1=$L(LRQ(1)),LRLENG2=$L(LRADESC),LRSPCE=IOM-LRLENG2-14
"RTN","LRAPBR1",264,0)
 S:LRLENG1>LRSPCE LRQ(1)=$E(LRQ(1),1,LRSPCE)
"RTN","LRAPBR1",265,0)
 ;
"RTN","LRAPBR1",266,0)
 D GLENTRY("PATHOLOGY REPORT",30,1)
"RTN","LRAPBR1",267,0)
 I '$G(^LR(LRDFN,LRSS,LRI,"RF")) D GLENTRY("Laboratory: "_LRQ(1),"",1)
"RTN","LRAPBR1",268,0)
 D GLENTRY(LRADESC,IOM-LRLENG2-1)
"RTN","LRAPBR1",269,0)
 Q
"RTN","LRAPBR1",270,0)
 ;
"RTN","LRAPBR1",271,0)
 ;
"RTN","LRAPBR1",272,0)
FOOTER ; Footer-called from ^LRAPBR
"RTN","LRAPBR1",273,0)
 D:LRTIU GLENTRY("$FTR",,1)
"RTN","LRAPBR1",274,0)
 D DASH
"RTN","LRAPBR1",275,0)
 S LRTEXT=$S('$D(LR("W")):"",1:"See signed copy in chart")
"RTN","LRAPBR1",276,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBR1",277,0)
 S LRTEXT="("_$S($D(LREFLG):"End of report",1:"See next page")_")"
"RTN","LRAPBR1",278,0)
 D GLENTRY(LRTEXT,57)
"RTN","LRAPBR1",279,0)
 D GLENTRY(LRPMD,"",1),GLENTRY(LRW(9),52),GLENTRY("| Date "_LRRC,55)
"RTN","LRAPBR1",280,0)
 D DASH
"RTN","LRAPBR1",281,0)
 D GLENTRY(LRP,"",1)
"RTN","LRAPBR1",282,0)
 S LRTEXT=$S('$D(LR("W")):"STANDARD FORM 515",1:"WORK COPY ONLY !!")
"RTN","LRAPBR1",283,0)
 D GLENTRY(LRTEXT,50)
"RTN","LRAPBR1",284,0)
 D GLENTRY("ID:"_SSN,"",1)
"RTN","LRAPBR1",285,0)
 D GLENTRY("SEX:"_SEX,16),GLENTRY(" DOB:"_DOB,BTAB)
"RTN","LRAPBR1",286,0)
 I AGE D
"RTN","LRAPBR1",287,0)
 . S LRTEXT=$S($G(VADM(6))]"":" AGE AT DEATH: ",1:" AGE: ")_AGE
"RTN","LRAPBR1",288,0)
 . D GLENTRY(LRTEXT,BTAB)
"RTN","LRAPBR1",289,0)
 D GLENTRY(" LOC:"_LRLLOC,BTAB)
"RTN","LRAPBR1",290,0)
 D GLENTRY("","",1)
"RTN","LRAPBR1",291,0)
 I LRADM'="" D GLENTRY("ADM:"_$P(LRADM,"@"),BTAB)
"RTN","LRAPBR1",292,0)
 I LRADX'="" D GLENTRY("DX:"_$E(LRADX,1,26),17)
"RTN","LRAPBR1",293,0)
 D GLENTRY("PCP:",46)
"RTN","LRAPBR1",294,0)
 I LRPRAC'="" D GLENTRY($E(LRPRAC(1),1,28),51)
"RTN","LRAPBR1",295,0)
 Q
"RTN","LRAPBR1",296,0)
 ;
"RTN","LRAPBR1",297,0)
 ;
"RTN","LRAPBR1",298,0)
ESIGLN ; Write signature block name, title, and date of signature
"RTN","LRAPBR1",299,0)
 D GLENTRY(,,1)
"RTN","LRAPBR1",300,0)
 I $D(^VA(200,DUZ,0)) D
"RTN","LRAPBR1",301,0)
 . S LRFILE=200,LRFLD=20.2,LRFLD2=20.3
"RTN","LRAPBR1",302,0)
 . S X=$$GET1^DIQ(LRFILE,DUZ,LRFLD)
"RTN","LRAPBR1",303,0)
 ; Compare DUZ to pathologist, if different, use proxy signature
"RTN","LRAPBR1",304,0)
 S:LRSS="AU" LRPATH=$$GET1^DIQ(63,LRDFN,13.6,"I")
"RTN","LRAPBR1",305,0)
 I LRSS'="AU" D
"RTN","LRAPBR1",306,0)
 . S LRFL2=$S(LRSS="EM":63.02,LRSS="CY":63.09,LRSS="SP":63.08,1:0)
"RTN","LRAPBR1",307,0)
 . S LRIENS=LRI_","_LRDFN_","
"RTN","LRAPBR1",308,0)
 . S LRPATH=$$GET1^DIQ(LRFL2,LRIENS,.02,"I")
"RTN","LRAPBR1",309,0)
 S LRPATH2=""
"RTN","LRAPBR1",310,0)
 S:LRPATH'=DUZ LRPATH2=" FOR "_$$GET1^DIQ(LRFILE,LRPATH,LRFLD)
"RTN","LRAPBR1",311,0)
 S LRTEXT="/es/ "_X_LRPATH2
"RTN","LRAPBR1",312,0)
 ; S LRTEXT="/es/ "_X
"RTN","LRAPBR1",313,0)
 D GLENTRY(LRTEXT,,1)
"RTN","LRAPBR1",314,0)
 S LRTEXT=$$GET1^DIQ(LRFILE,DUZ,LRFLD2)
"RTN","LRAPBR1",315,0)
 D GLENTRY(LRTEXT,,1)
"RTN","LRAPBR1",316,0)
 S LRTEXT="Signed "_$$FMTE^XLFDT(LRNTIME,"1MZ")
"RTN","LRAPBR1",317,0)
 D GLENTRY(LRTEXT,,1)
"RTN","LRAPBR1",318,0)
 Q
"RTN","LRAPBR1",319,0)
 ;
"RTN","LRAPBR1",320,0)
 ;
"RTN","LRAPBR1",321,0)
DASH ; Display a line of dashes
"RTN","LRAPBR1",322,0)
 D GLENTRY(LR("%"),"",1)
"RTN","LRAPBR1",323,0)
 Q
"RTN","LRAPBR1",324,0)
 ;
"RTN","LRAPBR1",325,0)
 ;
"RTN","LRAPBR1",326,0)
GLENTRY(LRPR1,LRPR2,LRPR3) ; Write to global
"RTN","LRAPBR1",327,0)
 ; LRPR1 = Text to be written to global
"RTN","LRAPBR1",328,0)
 ; LRPR2 = Tab position
"RTN","LRAPBR1",329,0)
 ; LRPR3 = 1 means start a new line.  Otherwise, write an current line.
"RTN","LRAPBR1",330,0)
 S LRPR1=$G(LRPR1)
"RTN","LRAPBR1",331,0)
 S LRPR2=+$G(LRPR2)
"RTN","LRAPBR1",332,0)
 S LRPR3=+$G(LRPR3)
"RTN","LRAPBR1",333,0)
 D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)
"RTN","LRAPBR1",334,0)
 D:'LRPR3 GLBWRT^LRAPUTL(LRPR1,LRPR2)
"RTN","LRAPBR1",335,0)
 Q
"RTN","LRAPBR1",336,0)
 ;
"RTN","LRAPBR1",337,0)
 ;
"RTN","LRAPBR1",338,0)
TEXT1 ;Text for top of report
"RTN","LRAPBR1",339,0)
 ;;BRIEF CLINICAL HISTORY:
"RTN","LRAPBR1",340,0)
 ;;PREOPERATIVE DIAGNOSIS:
"RTN","LRAPBR1",341,0)
 ;;OPERATIVE FINDINGS:
"RTN","LRAPBR1",342,0)
 ;;POSTOPERATIVE DIAGNOSIS:
"RTN","LRAPBR1",343,0)
 ;
"RTN","LRAPBR1",344,0)
TEXT2 ;Descriptive text based on section
"RTN","LRAPBR1",345,0)
 ;;SP;Pathology Resident:
"RTN","LRAPBR1",346,0)
 ;;CY;Screened by:
"RTN","LRAPBR1",347,0)
 ;;EM;Prepared by:
"RTN","LRAPBR1",348,0)
 ;
"RTN","LRAPBR1",349,0)
FIELDS ;Field numbers for word processing fields
"RTN","LRAPBR1",350,0)
 ;;1.3;.13;6
"RTN","LRAPBR1",351,0)
 ;;1;.03;7
"RTN","LRAPBR1",352,0)
 ;;1.1;.04;4
"RTN","LRAPBR1",353,0)
 ;;1.4;.14;5
"RTN","LRAPBR1",354,0)
 ;
"RTN","LRAPBR1",355,0)
TEXTCHK ; update text line counter if it is missing (Remedy 116253)
"RTN","LRAPBR1",356,0)
 N I,X,DATA
"RTN","LRAPBR1",357,0)
 S I=0
"RTN","LRAPBR1",358,0)
 K ^TMP("WP",$J)
"RTN","LRAPBR1",359,0)
 S X=$G(^LR(LRDFN,LRSS,LRI,LRV,0))
"RTN","LRAPBR1",360,0)
 I X'="",$L(X,"^")=1 D
"RTN","LRAPBR1",361,0)
 . F  S I=$O(^LR(LRDFN,LRSS,LRI,LRV,I)) Q:I=""  D
"RTN","LRAPBR1",362,0)
 . . S DATA=$G(^LR(LRDFN,LRSS,LRI,LRV,I,0))
"RTN","LRAPBR1",363,0)
 . . S ^TMP("WP",$J,I,0)=DATA
"RTN","LRAPBR1",364,0)
 I $D(^TMP("WP",$J)) D
"RTN","LRAPBR1",365,0)
 . D WP^DIE(63.08,LRI_","_LRDFN_",",LRV,"","^TMP(""WP"",$J)")
"RTN","LRAPBR1",366,0)
 . K ^TMP("WP",$J)
"RTN","LRAPBR1",367,0)
 Q
"RTN","LRAPBR1",368,0)
 ;
"RTN","LRAPBR1",369,0)
 ;
"RTN","LRAPBR1",370,0)
ATTEND(LRMD) ; Retrieve surgeon/attending
"RTN","LRAPBR1",371,0)
 ; Call with LRMD = current ordering provider array, pass by reference
"RTN","LRAPBR1",372,0)
 ;
"RTN","LRAPBR1",373,0)
 ; Update ordering provider/surgeon if Surgery package indicates change
"RTN","LRAPBR1",374,0)
 ;
"RTN","LRAPBR1",375,0)
 N LRIENS,LRX
"RTN","LRAPBR1",376,0)
 S LRIENS=LRDFN_","_LRSS_","_LRI_",0",(LRMD("SR-ATTEND"),LRMD("SR-SURGEON"))=""
"RTN","LRAPBR1",377,0)
 S LRX=$O(^LR(LRDFN,"EPR","AD",LRIENS,1,0))
"RTN","LRAPBR1",378,0)
 I LRX<1 Q
"RTN","LRAPBR1",379,0)
 ;
"RTN","LRAPBR1",380,0)
 N LRDATA,LRJ,LRORDP,LRREF,LRSRDATA,LRSRTN
"RTN","LRAPBR1",381,0)
 S LRREF=LRX_","_LRDFN_","
"RTN","LRAPBR1",382,0)
 D GETDATA^LRUEPR(.LRDATA,LRREF)
"RTN","LRAPBR1",383,0)
 S LRSRTN=LRDATA(63.00013,LRREF,1,"I")
"RTN","LRAPBR1",384,0)
 ;
"RTN","LRAPBR1",385,0)
 I $P(LRSRTN,";",2)'="SRF(" Q
"RTN","LRAPBR1",386,0)
 ;
"RTN","LRAPBR1",387,0)
 S LRORDP=+$P(^LR(LRDFN,LRSS,LRI,0),"^",7) ; Retrieve current surgeon/provider from file #63
"RTN","LRAPBR1",388,0)
 D SRCASE^LRUEPR(.LRSRDATA,+LRSRTN)
"RTN","LRAPBR1",389,0)
 ;
"RTN","LRAPBR1",390,0)
 I $G(LRSRDATA("ERR")) D  Q
"RTN","LRAPBR1",391,0)
 . S LRMD("ERR")=LRSRDATA("ERR")
"RTN","LRAPBR1",392,0)
 . D SRCASERR^LRUEPR(LRREF,LRSRTN,LRSRDATA("ERR"))
"RTN","LRAPBR1",393,0)
 ;
"RTN","LRAPBR1",394,0)
 F LRJ=.14,123 D
"RTN","LRAPBR1",395,0)
 . S LRX=LRSRDATA(130,+LRSRTN_",",LRJ,"I")
"RTN","LRAPBR1",396,0)
 . I LRX,LRORDP,LRX'=LRORDP S LRMD("SR-SURGEON")=$S(LRJ=.14:" Current Surgeon",LRJ=123:"Current Provider",1:"")_": "_$$NAME^XUSER(LRX,"G")
"RTN","LRAPBR1",397,0)
 F LRJ=.164,124 D
"RTN","LRAPBR1",398,0)
 . S LRX=LRSRDATA(130,+LRSRTN_",",LRJ,"I")
"RTN","LRAPBR1",399,0)
 . I LRX S LRMD("SR-ATTEND")=$S(LRJ=.164:" Attending Surgeon",LRJ=124:"Attending Provider",1:"")_": "_$$NAME^XUSER(LRX,"G")
"RTN","LRAPBR1",400,0)
 ;
"RTN","LRAPBR1",401,0)
 Q
"RTN","LRAPBRPW")
0^22^B10229143
"RTN","LRAPBRPW",1,0)
LRAPBRPW ;DALOI/WTY - POW Patient Browser Print ;01/29/13  16:51
"RTN","LRAPBRPW",2,0)
 ;;5.2;LAB SERVICE;**259,427**;Sep 27, 1994;Build 33
"RTN","LRAPBRPW",3,0)
 ;
"RTN","LRAPBRPW",4,0)
MAIN ;Main subroutine
"RTN","LRAPBRPW",5,0)
 N LRTEXT
"RTN","LRAPBRPW",6,0)
 D:$$GET1^DIQ(2,DFN_",",.525,"I")="Y" POW
"RTN","LRAPBRPW",7,0)
 D:$$GET1^DIQ(2,DFN_",",.32201,"I")="Y" PERSGULF
"RTN","LRAPBRPW",8,0)
 Q
"RTN","LRAPBRPW",9,0)
POW ;Prisoner-of-War text
"RTN","LRAPBRPW",10,0)
 N LRCLOC
"RTN","LRAPBRPW",11,0)
 D GLENTRY("","",1)
"RTN","LRAPBRPW",12,0)
 S LRTEXT="*** THIS PATIENT WAS A PRISONER OF WAR ***"
"RTN","LRAPBRPW",13,0)
 D GLENTRY(LRTEXT,19,1)
"RTN","LRAPBRPW",14,0)
 F I=1:1:2 D GLENTRY("","",1)
"RTN","LRAPBRPW",15,0)
 S LRCLOC=$$GET1^DIQ(2,DFN_",",".526:.01")
"RTN","LRAPBRPW",16,0)
 D:LRCLOC'="" GLENTRY("POW PERIOD: "_LRCLOC,24)
"RTN","LRAPBRPW",17,0)
 D GLENTRY("","",1)
"RTN","LRAPBRPW",18,0)
 S LRTEXT="FORWARD A DUPLICATE SET OF SLIDES, BLOCKS AND REPRESENTATIVE "
"RTN","LRAPBRPW",19,0)
 S LRTEXT=LRTEXT_"WET TISSUE TO:"
"RTN","LRAPBRPW",20,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBRPW",21,0)
 D GLENTRY("","",1)
"RTN","LRAPBRPW",22,0)
 D GLENTRY("DIRECTOR,JOINT PATHOLOGY CENTER",3,1)
"RTN","LRAPBRPW",23,0)
 D GLENTRY("ATTENTION: FORMER POW REGISTRY",3,1)
"RTN","LRAPBRPW",24,0)
 D GLENTRY("606 STEPHEN SITTER AVENUE",3,1)
"RTN","LRAPBRPW",25,0)
 D GLENTRY("SILVER SPRING, MD 20910-1290",3,1)
"RTN","LRAPBRPW",26,0)
 S LRTEXT="<A POW label (VA Form 10-5558) may be attached to packaged "
"RTN","LRAPBRPW",27,0)
 S LRTEXT=LRTEXT_"specimens>"
"RTN","LRAPBRPW",28,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBRPW",29,0)
 D GLENTRY("","",1)
"RTN","LRAPBRPW",30,0)
 D GLENTRY("MARK CASE CLEARLY AS:  FORMER POW  "_LRCLOC,"",1)
"RTN","LRAPBRPW",31,0)
 S LRTEXT="NOTE IN APPROPRIATE FORM THAT MATERIAL HAS BEEN SENT TO THE "
"RTN","LRAPBRPW",32,0)
 S LRTEXT=LRTEXT_"JPC"
"RTN","LRAPBRPW",33,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBRPW",34,0)
 I $D(LRSS),LRSS="AU" D AUNOTE
"RTN","LRAPBRPW",35,0)
 F I=1:1:2 D GLENTRY("","",1)
"RTN","LRAPBRPW",36,0)
 Q
"RTN","LRAPBRPW",37,0)
AUNOTE ;Autopsy text
"RTN","LRAPBRPW",38,0)
 D GLENTRY("","",1)
"RTN","LRAPBRPW",39,0)
 S LRTEXT="Follow Guidelines for Performing Autopsy Examination on "
"RTN","LRAPBRPW",40,0)
 S LRTEXT=LRTEXT_"Former Prisoners of War (POW's)  PROFESSIONAL "
"RTN","LRAPBRPW",41,0)
 S LRTEXT=LRTEXT_"SERVICES LETTER  IL 11-82-17"
"RTN","LRAPBRPW",42,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBRPW",43,0)
 D GLENTRY("Be sure to take appropriate samples of:","",1)
"RTN","LRAPBRPW",44,0)
 S LRTEXT="BRAIN, NERVE, TESTES, PROSTATE, URINARY BLADDER, and KIDNEY"
"RTN","LRAPBRPW",45,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBRPW",46,0)
 Q
"RTN","LRAPBRPW",47,0)
PERSGULF ;Persian Gulf text
"RTN","LRAPBRPW",48,0)
 S LRTEXT="***THIS PATIENT SERVED IN THE PERSIAN GULF WAR***"
"RTN","LRAPBRPW",49,0)
 S LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)
"RTN","LRAPBRPW",50,0)
 D GLENTRY("","",1)
"RTN","LRAPBRPW",51,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBRPW",52,0)
 F I=1:1:2 D GLENTRY("","",1)
"RTN","LRAPBRPW",53,0)
 S LRTEXT=$$CJ^XLFSTR("***************",IOM)
"RTN","LRAPBRPW",54,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBRPW",55,0)
 D GLENTRY("","",1)
"RTN","LRAPBRPW",56,0)
 S LRTEXT="Send a set of DUPLICATE paraffin blocks/smears, "
"RTN","LRAPBRPW",57,0)
 S LRTEXT=LRTEXT_"H & E slides for "
"RTN","LRAPBRPW",58,0)
 S LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)
"RTN","LRAPBRPW",59,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBRPW",60,0)
 D GLENTRY("","",1)
"RTN","LRAPBRPW",61,0)
 S LRTEXT="Anatomic Path material and a copy of the Final Pathology "
"RTN","LRAPBRPW",62,0)
 S LRTEXT=LRTEXT_"Report to "
"RTN","LRAPBRPW",63,0)
 S LRTEXT=$$CJ^XLFSTR(LRTEXT,IOM)
"RTN","LRAPBRPW",64,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBRPW",65,0)
 D GLENTRY("","",1)
"RTN","LRAPBRPW",66,0)
 S LRTEXT=$$CJ^XLFSTR("the JPC using the JPC Requisition form.  ",IOM)
"RTN","LRAPBRPW",67,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBRPW",68,0)
 F I=1:1:2 D GLENTRY("","",1)
"RTN","LRAPBRPW",69,0)
 S LRTEXT=$$CJ^XLFSTR("***************",IOM)
"RTN","LRAPBRPW",70,0)
 D GLENTRY(LRTEXT,"",1)
"RTN","LRAPBRPW",71,0)
 D GLENTRY("","",1)
"RTN","LRAPBRPW",72,0)
 Q
"RTN","LRAPBRPW",73,0)
GLENTRY(LRPR1,LRPR2,LRPR3) ;Write to global
"RTN","LRAPBRPW",74,0)
 ;LRPR1 = Text to be written to global
"RTN","LRAPBRPW",75,0)
 ;LRPR2 = Tab position
"RTN","LRAPBRPW",76,0)
 ;LRPR3 = 1 means start a new line.  Othewise, write an current line.
"RTN","LRAPBRPW",77,0)
 S LRPR3=+$G(LRPR3)
"RTN","LRAPBRPW",78,0)
 D:LRPR3 NEWLN^LRAPUTL(LRPR1,LRPR2)
"RTN","LRAPBRPW",79,0)
 D:'LRPR3 GLBWRT^LRAPUTL(LRPR1,LRPR2)
"RTN","LRAPBRPW",80,0)
 Q
"RTN","LRAPCUM")
0^37^B22712242
"RTN","LRAPCUM",1,0)
LRAPCUM ;DALOI/STAFF - AP PATIENT CUM ;03/21/13  15:28
"RTN","LRAPCUM",2,0)
 ;;5.2;LAB SERVICE;**34,72,173,248,259,350,427**;Sep 27, 1994;Build 33
"RTN","LRAPCUM",3,0)
 ;
"RTN","LRAPCUM",4,0)
 ;
"RTN","LRAPCUM",5,0)
 S IOP="HOME" D ^%ZIS,L^LRU
"RTN","LRAPCUM",6,0)
 W !!?15,LRAA(1)," PATIENT REPORT(S) DISPLAY"
"RTN","LRAPCUM",7,0)
P W ! S LR("Q")=0 K DIC D ^LRDPA Q:LRDFN=-1  D R G P
"RTN","LRAPCUM",8,0)
 ;
"RTN","LRAPCUM",9,0)
R W !!,"Is this the patient " S %=1 D YN^LRU Q:%'=1
"RTN","LRAPCUM",10,0)
 I '$D(^LR(LRDFN,LRSS)) W $C(7),!!,"No ",LRAA(1)," reports on file",! Q
"RTN","LRAPCUM",11,0)
 D S F LRI=0:0 W @IOF S LRA(1)=21,LRI=$O(^LR(LRDFN,LRSS,LRI)) Q:'LRI  S B=$G(^(LRI,0)) I B D W Q:LRA(2)?1P
"RTN","LRAPCUM",12,0)
 Q
"RTN","LRAPCUM",13,0)
C S C=0 F LRZ=0:1 S C=$O(^LR(LRDFN,LRSS,LRI,LRV,C)) Q:'C  D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P  W !?2,$P(^LR(LRDFN,LRSS,LRI,LRV,C,0),U)
"RTN","LRAPCUM",14,0)
 Q
"RTN","LRAPCUM",15,0)
F D E
"RTN","LRAPCUM",16,0)
 K ^UTILITY($J,"W")
"RTN","LRAPCUM",17,0)
 S C=0 F LRZ=0:1 S C=$O(^LR(LRDFN,LRSS,LRI,LRV,C)) Q:'C!(LRA(2)?1P)  D
"RTN","LRAPCUM",18,0)
 .D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P
"RTN","LRAPCUM",19,0)
 .S X=^LR(LRDFN,LRSS,LRI,LRV,C,0),X=$P(X,U)
"RTN","LRAPCUM",20,0)
 .D ^DIWP
"RTN","LRAPCUM",21,0)
 Q:LRA(2)?1P  D:LRZ ^DIWW
"RTN","LRAPCUM",22,0)
 Q
"RTN","LRAPCUM",23,0)
 ;
"RTN","LRAPCUM",24,0)
 ;
"RTN","LRAPCUM",25,0)
E K ^TMP($J) S DIWL=3,DIWR=IOM-3,DIWF="W"
"RTN","LRAPCUM",26,0)
 Q
"RTN","LRAPCUM",27,0)
 ;
"RTN","LRAPCUM",28,0)
 ;
"RTN","LRAPCUM",29,0)
W S Y=+B D D^LRU S LRW(1)=Y,Y=$P(B,"^",10) D D^LRU S LRW(10)=Y,Y=$P(B,"^",3) D D^LRU S LRW(3)=Y,X=$P(B,"^",2) D:X D^LRUA S LRW(2)=X,LRW(11)=$P(B,"^",11)
"RTN","LRAPCUM",30,0)
 S X=$P(B,"^",4) D:X D^LRUA S LRW(4)=X,X=$P(B,"^",7) D:X D^LRUA S LRW(7)=X
"RTN","LRAPCUM",31,0)
 ;
"RTN","LRAPCUM",32,0)
 W !,"Date Spec taken: ",LRW(1),?38,"Pathologist:",LRW(2),!,"Date Spec rec'd: ",LRW(10),?38,$S(LRSS="SP":"Resident: ",1:"Tech: "),LRW(4)
"RTN","LRAPCUM",33,0)
 W !,$S($L(LRW(3)):"Date  completed: ",1:"REPORT INCOMPLETE"),LRW(3),?38,"Accession #: ",$P(B,"^",6),!,"Submitted by: ",$P(B,"^",5),?38,"Practitioner:",LRW(7),!,LR("%")
"RTN","LRAPCUM",34,0)
 I LRW(11)="" D A W !,$C(7),"Report not verified",! G MORE
"RTN","LRAPCUM",35,0)
 I $D(^LR(LRDFN,LRSS,LRI,.1)) W !,"Specimen: " S LRV=.1 D C Q:LRA(2)?1P
"RTN","LRAPCUM",36,0)
 I $D(^LR(LRDFN,LRSS,LRI,.2)) W !,"Brief Clinical History:" S LRV=.2 D F Q:LRA(2)?1P
"RTN","LRAPCUM",37,0)
 I $D(^LR(LRDFN,LRSS,LRI,.3)) W !,"Preoperative Diagnosis:" S LRV=.3 D F Q:LRA(2)?1P
"RTN","LRAPCUM",38,0)
 I $D(^LR(LRDFN,LRSS,LRI,.4)) W !,"Operative Findings:" S LRV=.4 D F Q:LRA(2)?1P
"RTN","LRAPCUM",39,0)
 I $D(^LR(LRDFN,LRSS,LRI,.5)) W !,"Postoperative Diagnosis:" S LRV=.5 D F Q:LRA(2)?1P
"RTN","LRAPCUM",40,0)
 D SET^LRUA
"RTN","LRAPCUM",41,0)
 I $O(^LR(LRDFN,LRSS,LRI,1.3,0)) D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P  W !,LR(69.2,.13) I $P($G(^LR(LRDFN,LRSS,LRI,6,0)),U,4) S LR(0)=6 D ^LRSPRPTM
"RTN","LRAPCUM",42,0)
 S LRV=1.3 D F Q:LRA(2)?1P
"RTN","LRAPCUM",43,0)
 I $O(^LR(LRDFN,LRSS,LRI,1,0)) D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P  W !,LR(69.2,.03) I $P($G(^LR(LRDFN,LRSS,LRI,7,0)),U,4) S LR(0)=7 D ^LRSPRPTM
"RTN","LRAPCUM",44,0)
 S LRV=1 D F Q:LRA(2)?1P
"RTN","LRAPCUM",45,0)
 I $O(^LR(LRDFN,LRSS,LRI,1.1,0)) D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P  W !,LR(69.2,.04)," (Date Spec taken: ",LRW(1),")" I $P($G(^LR(LRDFN,LRSS,LRI,4,0)),U,4) S LR(0)=4 D ^LRSPRPTM
"RTN","LRAPCUM",46,0)
 S LRV=1.1 D F Q:LRA(2)?1P  I $O(^LR(LRDFN,LRSS,LRI,1.4,0)) D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P  W !,LR(69.2,.14) I $P($G(^LR(LRDFN,LRSS,LRI,5,0)),U,4) S LR(0)=5 D ^LRSPRPTM
"RTN","LRAPCUM",47,0)
 S LRV=1.4 D F Q:LRA(2)?1P
"RTN","LRAPCUM",48,0)
 I $O(^LR(LRDFN,LRSS,LRI,1.2,0)) D
"RTN","LRAPCUM",49,0)
 .W !,"Supplementary Report:"
"RTN","LRAPCUM",50,0)
 .F C=0:0 S C=$O(^LR(LRDFN,LRSS,LRI,1.2,C)) Q:'C!(LRA(2)?1P)  D
"RTN","LRAPCUM",51,0)
 ..S X=^(C,0),Y=+X,X=$P(X,U,2) D D^LRU
"RTN","LRAPCUM",52,0)
 ..W !?3,"Date: ",Y W:'X " not verified"
"RTN","LRAPCUM",53,0)
 ..D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P
"RTN","LRAPCUM",54,0)
 ..I X,$P($G(^LR(LRDFN,LRSS,LRI,1.2,C,2,0)),U,4) D
"RTN","LRAPCUM",55,0)
 ...S LRV=C,LR("Q")=LRA(2)
"RTN","LRAPCUM",56,0)
 ...D SUPA^LRSPRPT
"RTN","LRAPCUM",57,0)
 ...S LRA(2)=LR("Q")
"RTN","LRAPCUM",58,0)
 ..D:X U Q:LRA(2)?1P
"RTN","LRAPCUM",59,0)
 Q:LRA(2)?1P
"RTN","LRAPCUM",60,0)
 ;
"RTN","LRAPCUM",61,0)
 ; User must possess the LRLAB key to view SNOMED codes
"RTN","LRAPCUM",62,0)
 I $D(^LR(LRDFN,LRSS,LRI,2)) D
"RTN","LRAPCUM",63,0)
 .D B
"RTN","LRAPCUM",64,0)
 .I $D(^XUSEC("LRLAB",DUZ)) D ^LRAPCUM1
"RTN","LRAPCUM",65,0)
 Q:LRA(2)?1P
"RTN","LRAPCUM",66,0)
 ; DALOI/LMT - LR,427 - Removed comments from report to restore pre-LR,350 behavior
"RTN","LRAPCUM",67,0)
 ;I $D(^LR(LRDFN,LRSS,LRI,99)) D
"RTN","LRAPCUM",68,0)
 ;. N A
"RTN","LRAPCUM",69,0)
 ;. W !,"Comments:" S A=0
"RTN","LRAPCUM",70,0)
 ;. F  S A=$O(^LR(LRDFN,LRSS,LRI,99,A)) Q:'A  W !,$P(^(A,0),"^")
"RTN","LRAPCUM",71,0)
 D MORE
"RTN","LRAPCUM",72,0)
 Q
"RTN","LRAPCUM",73,0)
 ;
"RTN","LRAPCUM",74,0)
 ;
"RTN","LRAPCUM",75,0)
MORE R !,"'^' TO STOP: ",LRA(2):DTIME I LRA(2)["?" W $C(7) G MORE
"RTN","LRAPCUM",76,0)
 I LRA(2)?1P S A=0 Q
"RTN","LRAPCUM",77,0)
 S LRA(1)=LRA(1)+21
"RTN","LRAPCUM",78,0)
 W $C(13),$J("",15),$C(13)
"RTN","LRAPCUM",79,0)
 Q
"RTN","LRAPCUM",80,0)
 ;
"RTN","LRAPCUM",81,0)
 ;
"RTN","LRAPCUM",82,0)
S S (A,LRA(2))=0
"RTN","LRAPCUM",83,0)
 Q
"RTN","LRAPCUM",84,0)
 ;
"RTN","LRAPCUM",85,0)
 ;
"RTN","LRAPCUM",86,0)
U D E
"RTN","LRAPCUM",87,0)
 K ^UTILITY($J,"W")
"RTN","LRAPCUM",88,0)
 S E=0
"RTN","LRAPCUM",89,0)
 F LRZ=0:1 S E=$O(^LR(LRDFN,LRSS,LRI,1.2,C,1,E)) Q:'E!(LRA(2)?1P)  D
"RTN","LRAPCUM",90,0)
 .D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P
"RTN","LRAPCUM",91,0)
 .S X=^LR(LRDFN,LRSS,LRI,1.2,C,1,E,0)
"RTN","LRAPCUM",92,0)
 .D ^DIWP
"RTN","LRAPCUM",93,0)
 Q:LRA(2)?1P  D:LRZ ^DIWW
"RTN","LRAPCUM",94,0)
 Q
"RTN","LRAPCUM",95,0)
 ;
"RTN","LRAPCUM",96,0)
 ;
"RTN","LRAPCUM",97,0)
B F C=0:0 S C=$O(^LR(LRDFN,LRSS,LRI,2,C)) Q:'C!(LRA(2)?1P)  D SP
"RTN","LRAPCUM",98,0)
 Q
"RTN","LRAPCUM",99,0)
 ;
"RTN","LRAPCUM",100,0)
 ;
"RTN","LRAPCUM",101,0)
SP F G=0:0 S G=$O(^LR(LRDFN,LRSS,LRI,2,C,5,G)) Q:'G  S X=^(G,0),Y=$P(X,"^",2),E=$P(X,"^",3),E(1)=$P(X,"^")_":",E(1)=$P($P(LR(LRSS),E(1),2),";") D D^LRU S T(2)=Y D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P  D WP
"RTN","LRAPCUM",102,0)
 Q
"RTN","LRAPCUM",103,0)
 ;
"RTN","LRAPCUM",104,0)
 ;
"RTN","LRAPCUM",105,0)
WP W !,E(1)," ",E," Date: ",T(2)," ",!
"RTN","LRAPCUM",106,0)
 D E
"RTN","LRAPCUM",107,0)
 K ^UTILITY($J,"W")
"RTN","LRAPCUM",108,0)
 S F=0
"RTN","LRAPCUM",109,0)
 F LRZ=0:1 S F=$O(^LR(LRDFN,LRSS,LRI,2,C,5,G,1,F)) Q:'F!(LRA(2)?1P)  D
"RTN","LRAPCUM",110,0)
 .D:$Y>LRA(1)!'$Y MORE Q:LRA(2)?1P
"RTN","LRAPCUM",111,0)
 .S X=^LR(LRDFN,LRSS,LRI,2,C,5,G,1,F,0) D ^DIWP
"RTN","LRAPCUM",112,0)
 Q:LRA(2)?1P  D:LRZ ^DIWW
"RTN","LRAPCUM",113,0)
 Q
"RTN","LRAPCUM",114,0)
 ;
"RTN","LRAPCUM",115,0)
 ;
"RTN","LRAPCUM",116,0)
A S A=0 F  S A=$O(^LR(LRDFN,LRSS,LRI,97,A)) Q:'A  W !,^(A,0)
"RTN","LRAPCUM",117,0)
 Q
"RTN","LRAPED")
0^41^B32844009
"RTN","LRAPED",1,0)
LRAPED ;DALOI/STAFF - ANATOMIC PATH EDIT LOG-IN ;Feb 2, 2009
"RTN","LRAPED",2,0)
 ;;5.2;LAB SERVICE;**1,31,72,115,259,350,427**;Sep 27, 1994;Build 33
"RTN","LRAPED",3,0)
 ;
"RTN","LRAPED",4,0)
 N LRTMP,LRREL,LRCOMP,LRMSG
"RTN","LRAPED",5,0)
 D ^LRAP Q:'$D(Y)
"RTN","LRAPED",6,0)
 D XR^LRU
"RTN","LRAPED",7,0)
 I LRCAPA D @(LRSS_"^LRAPSWK") G:'$D(X) END
"RTN","LRAPED",8,0)
 W !!,"EDIT ",LRO(68)," (",LRABV,") Log-In/Clinical Hx for ",LRH(0)," "
"RTN","LRAPED",9,0)
 S %=1 D YN^LRU G:%<1 END
"RTN","LRAPED",10,0)
 I %=2 D  G:Y<1 END
"RTN","LRAPED",11,0)
 . S %DT="AE",%DT(0)="-N",%DT("A")="Enter YEAR: "
"RTN","LRAPED",12,0)
 . D ^%DT K %DT
"RTN","LRAPED",13,0)
 . Q:Y<1
"RTN","LRAPED",14,0)
 . S LRAD=$E(Y,1,3)_"0000",Y=LRAD D D^LRU S LRH(0)=Y
"RTN","LRAPED",15,0)
 S LRC=$E(LRAD,1,3)
"RTN","LRAPED",16,0)
G ;
"RTN","LRAPED",17,0)
 W !!,"Enter ",LRO(68)," Accession #: " R LRAN:DTIME
"RTN","LRAPED",18,0)
 G:LRAN=""!(LRAN[U) END
"RTN","LRAPED",19,0)
 I LRAN'?1N.N!($E(LRAN)=0) D  G G
"RTN","LRAPED",20,0)
 .W $C(7),!," ENTER NUMBERS ONLY, No leading zero's"
"RTN","LRAPED",21,0)
 D EDIT
"RTN","LRAPED",22,0)
 G G
"RTN","LRAPED",23,0)
 ;
"RTN","LRAPED",24,0)
 ;
"RTN","LRAPED",25,0)
EDIT ;
"RTN","LRAPED",26,0)
 N LRDIWESUB,LRFILE,LRACC
"RTN","LRAPED",27,0)
 S LRDFN=$O(^LR(LRXREF,LRC,LRABV,LRAN,0))
"RTN","LRAPED",28,0)
 I 'LRDFN W $C(7),"  Not in file" Q
"RTN","LRAPED",29,0)
 I '$D(^LR(LRDFN,0)) K ^LR(LRXREF,LRC,LRABV,LRAN,LRDFN) Q
"RTN","LRAPED",30,0)
 S X=^LR(LRDFN,0) D ^LRUP W !,LRP," ID: ",SSN," OK "
"RTN","LRAPED",31,0)
 S %=1 D YN^LRU Q:%'=1
"RTN","LRAPED",32,0)
 D @($S("CYEMSP"[LRSS:"I",1:"A"))
"RTN","LRAPED",33,0)
 Q
"RTN","LRAPED",34,0)
 ;
"RTN","LRAPED",35,0)
 ;
"RTN","LRAPED",36,0)
I ;Non-autopsy sections (SP,CY,EM)
"RTN","LRAPED",37,0)
 D GETDEF^LRAP
"RTN","LRAPED",38,0)
 S LRI=+$O(^LR(LRXREF,LRC,LRABV,LRAN,LRDFN,0))
"RTN","LRAPED",39,0)
 I '$D(^LR(LRDFN,LRSS,LRI,0)) D  Q
"RTN","LRAPED",40,0)
 . W $C(7),!,"Entry in x-ref but not in file ! X-ref deleted."
"RTN","LRAPED",41,0)
 . K ^LR(LRXREF,LRC,LRABV,LRAN,LRDFN,LRI)
"RTN","LRAPED",42,0)
 S X=^LR(LRDFN,LRSS,LRI,0),LRRC=$P(X,"^",10)
"RTN","LRAPED",43,0)
 S DA=LRI,DA(1)=LRDFN,DIE="^LR("_LRDFN_","""_LRSS_""",",(LRB,Y)=+X
"RTN","LRAPED",44,0)
 D D^LRU W !,"Specimen date: ",Y
"RTN","LRAPED",45,0)
 I $P(^LR(LRDFN,LRSS,LRI,0),"^",11)!($P(^(0),"^",3)) D  Q
"RTN","LRAPED",46,0)
 . W $C(7),!!,"Report released or completed.  Cannot edit Log-in data."
"RTN","LRAPED",47,0)
 D:LRCAPA C^LRAPSWK
"RTN","LRAPED",48,0)
 ;
"RTN","LRAPED",49,0)
DIE ;
"RTN","LRAPED",50,0)
 ;
"RTN","LRAPED",51,0)
 W ! D CK^LRU
"RTN","LRAPED",52,0)
 I $D(LR("CK")) K LR("CK") Q
"RTN","LRAPED",53,0)
 S LRACC=$P($G(^LR(LRDFN,LRSS,LRI,0)),"^",6)
"RTN","LRAPED",54,0)
 ;
"RTN","LRAPED",55,0)
 S LRDIWESUB="["_LRACC_"]"
"RTN","LRAPED",56,0)
 ;
"RTN","LRAPED",57,0)
 D SET,^DIE
"RTN","LRAPED",58,0)
 I $D(Y) D HELP G DIE
"RTN","LRAPED",59,0)
 D CK
"RTN","LRAPED",60,0)
 D:$O(^LR(LRDFN,LRSS,LRI,.1,0))&("SPCYEM"[LRSS)&(LRCAPA) C1^LRAPSWK
"RTN","LRAPED",61,0)
 D FRE^LRU
"RTN","LRAPED",62,0)
 Q
"RTN","LRAPED",63,0)
 ;
"RTN","LRAPED",64,0)
 ;
"RTN","LRAPED",65,0)
SET ; Setup fields for SP, CY and EM subscripts to edit.
"RTN","LRAPED",66,0)
 ;
"RTN","LRAPED",67,0)
 ;N LRFIELD,LRFILE
"RTN","LRAPED",68,0)
 ;S LRFILE=$S(LRSS="SP":63.08,LRSS="CY":63.09,LRSS="EM":63.02,1:"")
"RTN","LRAPED",69,0)
 ;F LRFIELD=.013,.014,.015,.016 S LRDIWESUB(LRFILE,LRFIELD)=$$SET2(LRFILE,LRFIELD,LRACC)
"RTN","LRAPED",70,0)
 ;
"RTN","LRAPED",71,0)
 S (LRJ,LRE,LRF)=""
"RTN","LRAPED",72,0)
 S DR=".08;S LRE=X;.07;S LRJ=X;S:LRJ LRJ=$P(^VA(200,LRJ,0),U);"
"RTN","LRAPED",73,0)
 S DR=DR_".011//^S X=LRJ;.012;.013;.014;.015;.016;.1;S LRG=X;.02;.021;"
"RTN","LRAPED",74,0)
 S DR=DR_".99;S LRF=X"
"RTN","LRAPED",75,0)
 ;
"RTN","LRAPED",76,0)
 I LRSS="SP" D
"RTN","LRAPED",77,0)
 . S DR(2,63.812)=".01;.06R//^S X=LRSPTOP(0);S:X LRSPTOP=X,LRSPTOP(0)=$P(^LAB(61,LRSPTOP,0),U)"
"RTN","LRAPED",78,0)
 . S DR(2,63.812)=DR(2,63.812)_";.07R//^S X=LRSAMP(0);S:X LRSAMP=X,LRSAMP(0)=$P(^LAB(62,LRSAMP,0),U)"
"RTN","LRAPED",79,0)
 ;
"RTN","LRAPED",80,0)
 I LRSS="CY" D
"RTN","LRAPED",81,0)
 . S DR(2,63.902)=".01;S LR(63.902)=X;.06R//^S X=LRSPTOP(0);S:X LRSPTOP=X,LRSPTOP(0)=$P(^LAB(61,LRSPTOP,0),U)"
"RTN","LRAPED",82,0)
 . S DR(2,63.902)=DR(2,63.902)_";.07R//^S X=LRSAMP(0);S:X LRSAMP=X,LRSAMP(0)=$P(^LAB(62,LRSAMP,0),U);S:'LRCAPA Y=""@2"";.02;@2"
"RTN","LRAPED",83,0)
 ;
"RTN","LRAPED",84,0)
 I LRSS="EM" D
"RTN","LRAPED",85,0)
 . S DR(2,63.202)=".01;.06R//^S X=LRSPTOP(0);S:X LRSPTOP=X,LRSPTOP(0)=$P(^LAB(61,LRSPTOP,0),U)"
"RTN","LRAPED",86,0)
 . S DR(2,63.202)=DR(2,63.202)_";.07R//^S X=LRSAMP(0);S:X LRSAMP=X,LRSAMP(0)=$P(^LAB(62,LRSAMP,0),U)"
"RTN","LRAPED",87,0)
 Q
"RTN","LRAPED",88,0)
 ;
"RTN","LRAPED",89,0)
 ;
"RTN","LRAPED",90,0)
SET1 ; Setup autopsy fields to edit.
"RTN","LRAPED",91,0)
 ;
"RTN","LRAPED",92,0)
 S LRJ="",DA=LRDFN,DIE="^LR(",DR="11;S LRRC=X;14.1;S LRLLOC=X;14.5;"
"RTN","LRAPED",93,0)
 S DR=DR_"14.6;S LRSVC=X;12.1;S LRMD=X;13.5:13.8"
"RTN","LRAPED",94,0)
 S:%=1 DR=DR_";16:24;26:31;25;31.1:31.4;25.1:25.9"
"RTN","LRAPED",95,0)
 D D^LRAUAW
"RTN","LRAPED",96,0)
 S (Y,LRB)=LR(63,12),LRI=9999999-$P(LRB,".")
"RTN","LRAPED",97,0)
 Q
"RTN","LRAPED",98,0)
 ;
"RTN","LRAPED",99,0)
 ;
"RTN","LRAPED",100,0)
SET2(FILE,FIELD,PREFIX) ; Build field name with specified prefix.
"RTN","LRAPED",101,0)
 ; Call with  FILE = file or subfile number
"RTN","LRAPED",102,0)
 ;           FIELD = field number of WP field
"RTN","LRAPED",103,0)
 ;          PREFIX = prefix for subject header
"RTN","LRAPED",104,0)
 ;
"RTN","LRAPED",105,0)
 N LABEL
"RTN","LRAPED",106,0)
 S LABEL=$$GET1^DID(FILE,FIELD,"","LABEL")
"RTN","LRAPED",107,0)
 I LABEL'="" S LABEL=PREFIX_" "_LABEL
"RTN","LRAPED",108,0)
 ;
"RTN","LRAPED",109,0)
 Q LABEL
"RTN","LRAPED",110,0)
 ;
"RTN","LRAPED",111,0)
 ;
"RTN","LRAPED",112,0)
A ;Autopsy
"RTN","LRAPED",113,0)
 S LRREL=+$$GET1^DIQ(63,LRDFN_",",14.7,"I")
"RTN","LRAPED",114,0)
 S LRCOMP=+$$GET1^DIQ(63,LRDFN_",",13,"I")
"RTN","LRAPED",115,0)
 I LRREL!LRCOMP D  Q
"RTN","LRAPED",116,0)
 . D EN^DDIOL($C(7)_"Report released or completed.  Cannot edit Log-in data.","","!!")
"RTN","LRAPED",117,0)
 W !!,"Edit Weights & Measurements " S %=2 D YN^LRU Q:%<1
"RTN","LRAPED",118,0)
 S LRRC=$P(^LR(LRDFN,"AU"),U),DA=LRDFN,DIE="^LR("
"RTN","LRAPED",119,0)
 D SET1,D^LRU
"RTN","LRAPED",120,0)
 W !!,"Date Died: ",Y
"RTN","LRAPED",121,0)
 I 'LRB D  Q
"RTN","LRAPED",122,0)
 . W $C(7),"?  Must have date died entered in ",LR(63,.02)," File."
"RTN","LRAPED",123,0)
 ;
"RTN","LRAPED",124,0)
 S LRACC=$P($G(^LR(LRDFN,"AU")),"^",6)
"RTN","LRAPED",125,0)
 ;
"RTN","LRAPED",126,0)
AU ;
"RTN","LRAPED",127,0)
 ;
"RTN","LRAPED",128,0)
 S LRDIWESUB="["_LRACC_"]"
"RTN","LRAPED",129,0)
 W ! D ^DIE
"RTN","LRAPED",130,0)
 I $D(Y) D HELP G AU
"RTN","LRAPED",131,0)
 D CK1
"RTN","LRAPED",132,0)
 Q
"RTN","LRAPED",133,0)
 ;
"RTN","LRAPED",134,0)
 ;
"RTN","LRAPED",135,0)
CK ;
"RTN","LRAPED",136,0)
 I '$D(^LR(LRDFN,LRSS,LRI)) D K
"RTN","LRAPED",137,0)
 Q
"RTN","LRAPED",138,0)
 ;
"RTN","LRAPED",139,0)
 ;
"RTN","LRAPED",140,0)
CK1 ;
"RTN","LRAPED",141,0)
 Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))  S X=^(0)
"RTN","LRAPED",142,0)
 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) ^(3)=LRB_"^^^^"_LRI
"RTN","LRAPED",143,0)
 S LRTMP=$P(X,U,1,2)_U_LRRC_U_$P(X,U,4,6)_U_LRLLOC_U_LRMD_U_LRSVC
"RTN","LRAPED",144,0)
 S LRTMP=LRTMP_U_$P(X,U,10)
"RTN","LRAPED",145,0)
 S ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRTMP
"RTN","LRAPED",146,0)
 S LRD=+$P(X,U,3)
"RTN","LRAPED",147,0)
 K ^LRO(68,LRAA,1,LRAD,1,"E",LRD,LRAN)
"RTN","LRAPED",148,0)
 S ^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)=""
"RTN","LRAPED",149,0)
 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,3),^(3)=LRB_U_$P(X,U,2,99)
"RTN","LRAPED",150,0)
 Q
"RTN","LRAPED",151,0)
 ;
"RTN","LRAPED",152,0)
 ;
"RTN","LRAPED",153,0)
K ;
"RTN","LRAPED",154,0)
 Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN))  D K^LRUDEL
"RTN","LRAPED",155,0)
 L +^LRO(68,LRAA):999
"RTN","LRAPED",156,0)
 K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)
"RTN","LRAPED",157,0)
 K ^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)
"RTN","LRAPED",158,0)
 S X=^LRO(68,LRAA,1,LRAD,1,0)
"RTN","LRAPED",159,0)
 S LRTMP=$P(X,"^",1,2)_"^"_(LRAN-1)_"^"_($P(X,"^",4)-1)
"RTN","LRAPED",160,0)
 S ^LRO(68,LRAA,1,LRAD,1,0)=LRTMP
"RTN","LRAPED",161,0)
 L -^LRO(68,LRAA)
"RTN","LRAPED",162,0)
 F A=1,2,3,4 D
"RTN","LRAPED",163,0)
 . I $D(^LRO(69.2,LRAA,A,LRAN)) K ^(LRAN) D
"RTN","LRAPED",164,0)
 . . S X(1)=$O(^LRO(69.2,LRAA,A,0)) S:'X(1) X(1)=0
"RTN","LRAPED",165,0)
 . . I $D(^LRO(69.2,LRAA,A,0)) D
"RTN","LRAPED",166,0)
 . . . L +^LRO(69.2,LRAA,A):999
"RTN","LRAPED",167,0)
 . . . S X=^LRO(69.2,LRAA,A,0)
"RTN","LRAPED",168,0)
 . . . S LRTMP=$P(X,"^",1,2)_"^"_X(1)_"^"_$S(X(1)=0:X(1),1:($P(X,"^",4)-1))
"RTN","LRAPED",169,0)
 . . . S ^LRO(69.2,LRAA,A,0)=LRTMP
"RTN","LRAPED",170,0)
 . . . L -^LRO(69.2,LRAA,A)
"RTN","LRAPED",171,0)
 Q
"RTN","LRAPED",172,0)
 ;
"RTN","LRAPED",173,0)
 ;
"RTN","LRAPED",174,0)
HELP ;
"RTN","LRAPED",175,0)
 W $C(7),!!,"Please do not exit EDIT with an ""^""."
"RTN","LRAPED",176,0)
 W !,"Press RETURN key repeatedly to complete the edit.",!!
"RTN","LRAPED",177,0)
 Q
"RTN","LRAPED",178,0)
 ;
"RTN","LRAPED",179,0)
 ;
"RTN","LRAPED",180,0)
END ;
"RTN","LRAPED",181,0)
 D V^LRU
"RTN","LRAPED",182,0)
 Q
"RTN","LRAPLG1")
0^1^B165428544
"RTN","LRAPLG1",1,0)
LRAPLG1 ;DALOI/CKA/JMC - LOG-IN CONT. ;11/14/12  12:44
"RTN","LRAPLG1",2,0)
 ;;5.2;LAB SERVICE;**72,121,248,308,350,427**;Sep 27, 1994;Build 33
"RTN","LRAPLG1",3,0)
 ;
"RTN","LRAPLG1",4,0)
 ; Reference to DISP^SROSPLG supported by IA #893
"RTN","LRAPLG1",5,0)
 ;
"RTN","LRAPLG1",6,0)
START ; Start logging in the specimens.
"RTN","LRAPLG1",7,0)
 N LRFND,LRMSG,LRXX
"RTN","LRAPLG1",8,0)
 ;
"RTN","LRAPLG1",9,0)
 ; Lock ^LR( and ^LRO
"RTN","LRAPLG1",10,0)
 D LOCK^DILF("^LR(LRDFN,LRSS)")
"RTN","LRAPLG1",11,0)
 I '$T D  Q
"RTN","LRAPLG1",12,0)
 . S LRMSG="This record is locked by another user. Please try later."
"RTN","LRAPLG1",13,0)
 . D EN^DDIOL(LRMSG,"","!!")
"RTN","LRAPLG1",14,0)
 ;
"RTN","LRAPLG1",15,0)
 D LOCK^DILF("^LRO(68,LRAA,1,LRAD,1,0)")
"RTN","LRAPLG1",16,0)
 I '$T D  Q
"RTN","LRAPLG1",17,0)
 . L -^LR(LRDFN,LRSS)
"RTN","LRAPLG1",18,0)
 . S LRMSG="Someone else is logging in specimens.  Please wait and try again."
"RTN","LRAPLG1",19,0)
 . D EN^DDIOL(LRMSG,"","!!")
"RTN","LRAPLG1",20,0)
 ;
"RTN","LRAPLG1",21,0)
 ; Check that accession date exists first
"RTN","LRAPLG1",22,0)
 D CHECK68^LRWLST1(LRAA,LRAD)
"RTN","LRAPLG1",23,0)
 ;
"RTN","LRAPLG1",24,0)
EN ;
"RTN","LRAPLG1",25,0)
 N LRAPDAN
"RTN","LRAPLG1",26,0)
 ;
"RTN","LRAPLG1",27,0)
 S (LRI,LRIDT)=""
"RTN","LRAPLG1",28,0)
 S LRAN=1
"RTN","LRAPLG1",29,0)
 S LRAPDAN=$$GET^XPAR("ALL","LR AP DEFAULT ACCESSION NUMBER","`"_LRAA,"Q")
"RTN","LRAPLG1",30,0)
 I LRAPDAN=2 S LRAN=+$P(^LRO(68,LRAA,1,LRAD,1,0),U,3)
"RTN","LRAPLG1",31,0)
 F  Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN))  S LRAN=LRAN+1
"RTN","LRAPLG1",32,0)
 W !!,"Assign ",LRO(68)," (",LRABV,") accession #: ",LRAN S %=1 D YN^LRU
"RTN","LRAPLG1",33,0)
 I %<1 L -^LRO(68,LRAA,1,LRAD,1,0),-^LR(LRDFN,LRSS) Q
"RTN","LRAPLG1",34,0)
 ;
"RTN","LRAPLG1",35,0)
 I %=1,$D(LRXREF),$D(^LR(LRXREF,LRH(2),LRABV,LRAN)) D  Q:$D(LRFND)
"RTN","LRAPLG1",36,0)
 . I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),$P(^(0),U) S X=LRAN D ^LRUTELL S LRFND=1
"RTN","LRAPLG1",37,0)
 . I '$D(LRFND) D ^LRAPLG2
"RTN","LRAPLG1",38,0)
 . I $D(LRFND) L -^LRO(68,LRAA,1,LRAD,1,0),-^LR(LRDFN,LRSS) Q
"RTN","LRAPLG1",39,0)
 . S %=0
"RTN","LRAPLG1",40,0)
 ;
"RTN","LRAPLG1",41,0)
 I %=1 D CRE868 I $D(LRMSG) G EN
"RTN","LRAPLG1",42,0)
 ;
"RTN","LRAPLG1",43,0)
 I %=2 D OS I $D(LRFND) K LRFND L -^LRO(68,LRAA,1,LRAD,1,0),-^LR(LRDFN,LRSS) Q
"RTN","LRAPLG1",44,0)
 ;
"RTN","LRAPLG1",45,0)
 L -^LRO(68,LRAA,1,LRAD,1,0)
"RTN","LRAPLG1",46,0)
 ;
"RTN","LRAPLG1",47,0)
 S LRAC=$P(^LRO(68,LRAA,0),U,11)_" "_$S(LRAD["0000":$E(LRAD,2,3),1:$E(LRAD,4,7))_" "_LRAN
"RTN","LRAPLG1",48,0)
 ;
"RTN","LRAPLG1",49,0)
AU ; Autopsy Specific
"RTN","LRAPLG1",50,0)
 I LRSS="AU" D ^LRAUAW Q
"RTN","LRAPLG1",51,0)
 S:'$D(^LR(LRDFN,LRSS,0)) ^(0)="^"_LRSF_"DA^0^0"
"RTN","LRAPLG1",52,0)
 ;
"RTN","LRAPLG1",53,0)
 ; If orginal login then create entry in file #63
"RTN","LRAPLG1",54,0)
LR7OFA0 ;
"RTN","LRAPLG1",55,0)
 I LRIDT="" D CRE863
"RTN","LRAPLG1",56,0)
 I LRI="" Q
"RTN","LRAPLG1",57,0)
 ;
"RTN","LRAPLG1",58,0)
 K DA,DTOUT,DIWESUB
"RTN","LRAPLG1",59,0)
 ;S DIWESUB=$E(PNM,1,27-$L(LRACC))_" ["_LRACC_"]"
"RTN","LRAPLG1",60,0)
 S LR(.07)=$S($D(SRDOC):SRDOC,1:"") K SRDOC
"RTN","LRAPLG1",61,0)
 S:LR(.07) LR(.07)=$P($G(^VA(200,LR(.07),0)),"^")
"RTN","LRAPLG1",62,0)
 S DA=LRI,DA(1)=LRDFN
"RTN","LRAPLG1",63,0)
 S DIC(0)="EQLMF",DLAYGO=63,DIE="^LR(LRDFN,LRSS,"
"RTN","LRAPLG1",64,0)
 D @LR("L")
"RTN","LRAPLG1",65,0)
 D ^DIE K DLAYGO
"RTN","LRAPLG1",66,0)
 S:'$D(LRRC) LRRC=LRNT
"RTN","LRAPLG1",67,0)
 ;
"RTN","LRAPLG1",68,0)
 ; Check if topography and collection sample entered on each specimen.
"RTN","LRAPLG1",69,0)
 ; If not entered then define Y to cause entry to be deleted.
"RTN","LRAPLG1",70,0)
 I LRSS?1(1"SP",1"CY",1"EM") D
"RTN","LRAPLG1",71,0)
 . N I,LRJ,X
"RTN","LRAPLG1",72,0)
 . S LRJ=0
"RTN","LRAPLG1",73,0)
 . F  S LRJ=$O(^LR(LRDFN,LRSS,LRI,.1,LRJ)) Q:LRJ<1  D  Q:$D(Y)
"RTN","LRAPLG1",74,0)
 . . S X=$G(^LR(LRDFN,LRSS,LRI,.1,LRJ,0))
"RTN","LRAPLG1",75,0)
 . . F I=6,7 I $P(X,"^",I)="" S Y="" Q
"RTN","LRAPLG1",76,0)
 ;
"RTN","LRAPLG1",77,0)
 ; Delete entry if prompts not answered unless report has been released.
"RTN","LRAPLG1",78,0)
 I $D(DTOUT)!$D(Y) D  Q
"RTN","LRAPLG1",79,0)
 . N DA,DIK
"RTN","LRAPLG1",80,0)
 . I LRSS?1(1"SP",1"CY",1"EM"),($P(^LR(LRDFN,LRSS,LRI,0),"^",11)!$P(^LR(LRDFN,LRSS,LRI,0),"^",15)) Q
"RTN","LRAPLG1",81,0)
 . W $C(7),!!,"All Prompts not answered - <ENTRY DELETED>"
"RTN","LRAPLG1",82,0)
 . S DA(1)=LRDFN,DA=LRI
"RTN","LRAPLG1",83,0)
 . S DIK="^LR("_DA(1)_","""_LRSS_""","
"RTN","LRAPLG1",84,0)
 . D ^DIK,X,END
"RTN","LRAPLG1",85,0)
 ;
"RTN","LRAPLG1",86,0)
 D GETSTCS ; Store specimen topography, coll sample in temp array
"RTN","LRAPLG1",87,0)
 ;
"RTN","LRAPLG1",88,0)
TST ; Get the ordered test and store in temp array
"RTN","LRAPLG1",89,0)
 N II
"RTN","LRAPLG1",90,0)
 D ORDTST
"RTN","LRAPLG1",91,0)
 ; Delete entry if no ordered tests unless report has been released.
"RTN","LRAPLG1",92,0)
 I II=2 D  Q
"RTN","LRAPLG1",93,0)
 . I LRSS?1(1"SP",1"CY",1"EM"),($P(^LR(LRDFN,LRSS,LRI,0),"^",11)!$P(^LR(LRDFN,LRSS,LRI,0),"^",15)) Q
"RTN","LRAPLG1",94,0)
 . N DA,DIK
"RTN","LRAPLG1",95,0)
 . W $C(7),!!,"No ordered test selected - <ENTRY DELETED>"
"RTN","LRAPLG1",96,0)
 . S DA(1)=LRDFN,DA=LRI,DIK="^LR("_DA(1)_","""_LRSS_""","
"RTN","LRAPLG1",97,0)
 . D ^DIK,X,END
"RTN","LRAPLG1",98,0)
 ;
"RTN","LRAPLG1",99,0)
 I LRSS="CY",LRCAPA D CK^LRAPCWK
"RTN","LRAPLG1",100,0)
 ;
"RTN","LRAPLG1",101,0)
 ; Check for surgery case references and move info if user wants surgical case info copied to Lab.
"RTN","LRAPLG1",102,0)
 I LRSS="SP" D SPMOVE
"RTN","LRAPLG1",103,0)
 ;
"RTN","LRAPLG1",104,0)
 ; Fill out the stub accession with related info
"RTN","LRAPLG1",105,0)
 I '$D(LRC(5)) S LRC(5)=""
"RTN","LRAPLG1",106,0)
 D ^LRUWLF
"RTN","LRAPLG1",107,0)
 ;
"RTN","LRAPLG1",108,0)
 I LRCAPA D
"RTN","LRAPLG1",109,0)
 . I LRSS="CY" D ^LRAPCWK
"RTN","LRAPLG1",110,0)
 . I LRSS?1(1"SP",1"EM") D ^LRAPSWK
"RTN","LRAPLG1",111,0)
 ;
"RTN","LRAPLG1",112,0)
 I LRSS?1(1"SP",1"CY",1"EM") D ^LRSPGD
"RTN","LRAPLG1",113,0)
 ;
"RTN","LRAPLG1",114,0)
 D OERR^LR7OB63D,LDSI
"RTN","LRAPLG1",115,0)
 ;
"RTN","LRAPLG1",116,0)
 Q
"RTN","LRAPLG1",117,0)
 ;
"RTN","LRAPLG1",118,0)
 ;
"RTN","LRAPLG1",119,0)
LDSI ; LDSI tasks
"RTN","LRAPLG1",120,0)
 ;
"RTN","LRAPLG1",121,0)
 N LRLLOC,LRALOC,LRPRAC,LROUTINE,LROPL,LRODT,LRNT,LRFILE,LRIENS,LRORD,LRORDR,LRSRDT,LRTST
"RTN","LRAPLG1",122,0)
 ;
"RTN","LRAPLG1",123,0)
 ; Get variables for ORUT node
"RTN","LRAPLG1",124,0)
 S LROUTINE=$P($G(^LAB(69.9,1,3)),"^",2)    ;default urgency
"RTN","LRAPLG1",125,0)
 S LRPROVL=LRMD(1)    ;Ordering provider-CKA
"RTN","LRAPLG1",126,0)
 ; Get ORDER TYPE
"RTN","LRAPLG1",127,0)
 ;S LROT=??
"RTN","LRAPLG1",128,0)
 S LRORDR="SP" ;Default to 'Send Patient' for now
"RTN","LRAPLG1",129,0)
 S LRNT=$$NOW^XLFDT() ;Date ordered = current date/time
"RTN","LRAPLG1",130,0)
 S LRODT=$P(LRNT,".")
"RTN","LRAPLG1",131,0)
 ; Get Provider, Location abbrev, Collection date/time
"RTN","LRAPLG1",132,0)
 S LRFILE=$S(LRSS="SP":63.08,LRSS="CY":63.09,LRSS="EM":63.02,1:"")
"RTN","LRAPLG1",133,0)
 S LRIENS=LRI_","_LRDFN_","
"RTN","LRAPLG1",134,0)
 S LRPRAC=+$$GET1^DIQ(LRFILE,LRIENS,.07,"I")
"RTN","LRAPLG1",135,0)
 S LRLLOC=$$GET1^DIQ(LRFILE,LRIENS,.08,"I")
"RTN","LRAPLG1",136,0)
 I LRLLOC="" S LRLLOC="NO ABRV"
"RTN","LRAPLG1",137,0)
 S LRSDT=+$$GET1^DIQ(LRFILE,LRIENS,.01,"I")
"RTN","LRAPLG1",138,0)
 S LRSRDT=$$GET1^DIQ(LRFILE,LRIENS,.1,"I") ; Specimen received date/time
"RTN","LRAPLG1",139,0)
 ; Get CPRS Order #
"RTN","LRAPLG1",140,0)
 S ORIFN="" ; Default to blank for now
"RTN","LRAPLG1",141,0)
 ;
"RTN","LRAPLG1",142,0)
 ; Get Lab Order #, update file #69 and #68
"RTN","LRAPLG1",143,0)
 S (LRORD,LRSPEC,LRTST,LRSAMP,LRADD,LROT)="",LRCNT=1
"RTN","LRAPLG1",144,0)
 F  S LRSPEC=$O(LRXX(LRSPEC)) Q:'LRSPEC  D
"RTN","LRAPLG1",145,0)
 . N LRRECINF
"RTN","LRAPLG1",146,0)
 . S LRSAMP=$P(LRXX(LRSPEC),"^",1),LRNLT=$P(LRXX(LRSPEC),"^",2),LRTST=$P(LRXX(LRSPEC),"^",3)
"RTN","LRAPLG1",147,0)
 . Q:'LRTST
"RTN","LRAPLG1",148,0)
 . ; Add entry in #69 for each specimen
"RTN","LRAPLG1",149,0)
 . I LRORD S LRADD=1 D ZSN^LR7OFAO("",.LRRECINF)
"RTN","LRAPLG1",150,0)
 . ; Get Lab Order # first time thru
"RTN","LRAPLG1",151,0)
 . D:'LRORD EN^LR7OFAO(LRODT,LRDFN,LRSAMP,LRORDR,LRNT,LRPRAC,LRLLOC,LRSDT,ORIFN,LRSPEC,LRSS,LRTST,LRUID,.LRRECINF)
"RTN","LRAPLG1",152,0)
 . S LRSN=+$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,5),LRCDT=0,LREAL=""
"RTN","LRAPLG1",153,0)
 . I LRSN>0 S LRCDT=$P($G(^LRO(69,LRODT,1,LRSN,1)),"^",1,2),LREAL=$P(LRCDT,"^",2),LRCDT=+LRCDT
"RTN","LRAPLG1",154,0)
 . D UPD68,UPD63
"RTN","LRAPLG1",155,0)
 . S LRCNT=LRCNT+1
"RTN","LRAPLG1",156,0)
 ;
"RTN","LRAPLG1",157,0)
 Q
"RTN","LRAPLG1",158,0)
 ;
"RTN","LRAPLG1",159,0)
 ;
"RTN","LRAPLG1",160,0)
UPD68 ; Update #68 with required test data
"RTN","LRAPLG1",161,0)
 N LRFILE,LRERR,IEN,LRIEN
"RTN","LRAPLG1",162,0)
 S LRFILE=68.04,IEN(1)=LRTST
"RTN","LRAPLG1",163,0)
 S LRIEN="?+1,"_LRAN_","_LRAD_","_LRAA_","
"RTN","LRAPLG1",164,0)
 S FDA(3,LRFILE,LRIEN,.01)=LRTST
"RTN","LRAPLG1",165,0)
 S FDA(3,LRFILE,LRIEN,1)=LROUTINE
"RTN","LRAPLG1",166,0)
 D UPDATE^DIE("","FDA(3)","IEN","LRERR(3)")
"RTN","LRAPLG1",167,0)
 I $D(LRERR(3)) D LRMSG("UPD68-3~LRAPLG1",.LRERR)
"RTN","LRAPLG1",168,0)
 ;. S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTST,0)=LRTST_"^"_LROUTINE
"RTN","LRAPLG1",169,0)
 ;
"RTN","LRAPLG1",170,0)
 ; Update #68 with specimen data
"RTN","LRAPLG1",171,0)
 K LRFILE,FDAIEN,IEN
"RTN","LRAPLG1",172,0)
 S LRFILE=68.05
"RTN","LRAPLG1",173,0)
 ; Check or Set top node for 68.05
"RTN","LRAPLG1",174,0)
 S FDAIEN="?+"_LRCNT_","_LRAN_","_LRAD_","_LRAA_","
"RTN","LRAPLG1",175,0)
 S FDA(31,LRFILE,FDAIEN,.01)=LRSPEC
"RTN","LRAPLG1",176,0)
 S FDA(31,LRFILE,FDAIEN,1)=LRSAMP
"RTN","LRAPLG1",177,0)
 D UPDATE^DIE("","FDA(31)","IEN","LRERR(31)")
"RTN","LRAPLG1",178,0)
 I $D(LRERR(31)) D LRMSG("UPD68-31~LRAPLG1",.LRERR)
"RTN","LRAPLG1",179,0)
 ;
"RTN","LRAPLG1",180,0)
 Q
"RTN","LRAPLG1",181,0)
 ;
"RTN","LRAPLG1",182,0)
 ;
"RTN","LRAPLG1",183,0)
UPD63 ; Update ORUT Node in #63
"RTN","LRAPLG1",184,0)
 S LRTSORU=LRTST,LRURG=9,LRI=LRIDT
"RTN","LRAPLG1",185,0)
 D SLRSS^LRWLST11
"RTN","LRAPLG1",186,0)
 D ORUT^LRWLST11
"RTN","LRAPLG1",187,0)
 ;. S ^LR(LRDFN,LRSS,LRI,"ORUT",LRCNT,0)=LRNLT_"^"_LROUTINE_"^"_ORIFN_"^"_LRORD_"^"_LROT_"^"_LRPRAC_"^^"_LRSPEC_"^"_LRSAMP
"RTN","LRAPLG1",188,0)
 ;
"RTN","LRAPLG1",189,0)
 Q
"RTN","LRAPLG1",190,0)
 ;
"RTN","LRAPLG1",191,0)
 ;
"RTN","LRAPLG1",192,0)
X ; from LRAUAW
"RTN","LRAPLG1",193,0)
 I "CYEMSP"[LRSS K ^LR(LRXREF,LRH(2),LRABV,LRAN)
"RTN","LRAPLG1",194,0)
 I LRSS="AU" D
"RTN","LRAPLG1",195,0)
 . I $D(^LR(LRDFN,"AV")) K ^LR(LRDFN,"AV")
"RTN","LRAPLG1",196,0)
 . I $D(^LR(LRDFN,"AW")) K ^LR(LRDFN,"AW")
"RTN","LRAPLG1",197,0)
 . I $D(^LR(LRDFN,"AWI")) K ^LR(LRDFN,"AWI")
"RTN","LRAPLG1",198,0)
 . I $D(LRRC) K ^LR("AAUA",+$E(LRRC,1,3),LRABV,LRAN),^LR("AAU",+LRRC,LRDFN)
"RTN","LRAPLG1",199,0)
 I $G(LRRC)>1 K:LRSS?1(1"SP",1"CY",1"EM") ^LR(LRXR,LRRC,LRDFN,LRI)
"RTN","LRAPLG1",200,0)
 K LRRC
"RTN","LRAPLG1",201,0)
 Q
"RTN","LRAPLG1",202,0)
 ;
"RTN","LRAPLG1",203,0)
 ;
"RTN","LRAPLG1",204,0)
OS ; User choosing accession number
"RTN","LRAPLG1",205,0)
 N DIR,DIROUT,DIRUT,DTOUT,LRSPEC,X,Y
"RTN","LRAPLG1",206,0)
 S DIR(0)="N^1:999999:0^D OSDIR^LRAPLG1"
"RTN","LRAPLG1",207,0)
 S DIR("A")="Enter Accession #"
"RTN","LRAPLG1",208,0)
 D ^DIR
"RTN","LRAPLG1",209,0)
 I $D(DIRUT) S LRFND=1 Q
"RTN","LRAPLG1",210,0)
 S LRAN=Y
"RTN","LRAPLG1",211,0)
 ;
"RTN","LRAPLG1",212,0)
 I $G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D  Q
"RTN","LRAPLG1",213,0)
 . I $D(LRXREF),$D(^LR(LRXREF,LRH(2),LRABV,LRAN,LRDFN)) D
"RTN","LRAPLG1",214,0)
 . . S (LRI,LRIDT)=$O(^LR(LRXREF,LRH(2),LRABV,LRAN,LRDFN,0))
"RTN","LRAPLG1",215,0)
 . . I LRIDT S LRSD=$P($G(^LR(LRDFN,LRSS,LRIDT,0)),"^")
"RTN","LRAPLG1",216,0)
 ;
"RTN","LRAPLG1",217,0)
 I $D(LRXREF),$D(^LR(LRXREF,LRH(2),LRABV,LRAN)) D ^LRAPLG2 Q
"RTN","LRAPLG1",218,0)
 ;
"RTN","LRAPLG1",219,0)
 D CRE868
"RTN","LRAPLG1",220,0)
 I $D(LRMSG) S LRFND=1
"RTN","LRAPLG1",221,0)
 Q
"RTN","LRAPLG1",222,0)
 ;
"RTN","LRAPLG1",223,0)
 ;R !!,"Enter Accession #: ",X:DTIME I X=""!(X[U) S LRFND=1 Q
"RTN","LRAPLG1",224,0)
 ;I X'?1N.N!(X<1)!(X>99999) W $C(7),!!,"ENTER A WHOLE NUMBER FROM 1 TO 99999",! G OS
"RTN","LRAPLG1",225,0)
 ;I $D(^LRO(68,LRAA,1,LRAD,1,X,0)),$P(^(0),U) D ^LRUTELL G OS
"RTN","LRAPLG1",226,0)
 ;S LRAN=X
"RTN","LRAPLG1",227,0)
 ;S ^LRO(68,LRAA,1,LRAD,1,X,0)=LRDFN
"RTN","LRAPLG1",228,0)
 ;I $D(LRXREF),$D(^LR(LRXREF,LRH(2),LRABV,X)) D
"RTN","LRAPLG1",229,0)
 ;. D ^LRAPLG2 S LRFND=1
"RTN","LRAPLG1",230,0)
 ;L -^LRO(68,LRAA,1,LRAD,1,0)
"RTN","LRAPLG1",231,0)
 ;
"RTN","LRAPLG1",232,0)
 ;
"RTN","LRAPLG1",233,0)
OSDIR ; Called from DIR call in OS above
"RTN","LRAPLG1",234,0)
 ;
"RTN","LRAPLG1",235,0)
 ;ZEXCEPT: LRAA,LRAD,LRDFN,X
"RTN","LRAPLG1",236,0)
 ;
"RTN","LRAPLG1",237,0)
 ; Accession number doesn't exist in file #68 - quit, OK to use this number
"RTN","LRAPLG1",238,0)
 I $O(^LRO(68,LRAA,1,LRAD,1,+X,""))="" Q
"RTN","LRAPLG1",239,0)
 ;
"RTN","LRAPLG1",240,0)
 N LRX
"RTN","LRAPLG1",241,0)
 S LRX=$G(^LRO(68,LRAA,1,LRAD,1,+X,0))
"RTN","LRAPLG1",242,0)
 I LRX<1 K X Q
"RTN","LRAPLG1",243,0)
 ;
"RTN","LRAPLG1",244,0)
 ; Stub entry which matches on LRDFN
"RTN","LRAPLG1",245,0)
 I LRX=LRDFN Q
"RTN","LRAPLG1",246,0)
 ;
"RTN","LRAPLG1",247,0)
 I $P(LRX,U)'=LRDFN S X=+X D ^LRUTELL K X
"RTN","LRAPLG1",248,0)
 ;
"RTN","LRAPLG1",249,0)
 Q
"RTN","LRAPLG1",250,0)
 ;
"RTN","LRAPLG1",251,0)
 ;
"RTN","LRAPLG1",252,0)
ORDTST ; Prompt for ordered test(s); translate to NLT code for storage in ORUT
"RTN","LRAPLG1",253,0)
 ; Add NLT code to temp array LRXX (This code currently assumes one ordered test per accession)
"RTN","LRAPLG1",254,0)
 ;
"RTN","LRAPLG1",255,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LRNLT,LRWKCD,XX
"RTN","LRAPLG1",256,0)
 S (LRNLT,LRWKCD)="",II=0
"RTN","LRAPLG1",257,0)
 S DIR(0)="P^LAB(60,:AEMOQ",DIR("B")=$G(LRTST(0))
"RTN","LRAPLG1",258,0)
 S DIR("S")="I $P(^LAB(60,Y,0),""^"",4)=LRSS,""IBO""[$P(^LAB(60,Y,0),""^"",3),$P($G(^LAB(60,Y,64)),""^"")"
"RTN","LRAPLG1",259,0)
 D ^DIR
"RTN","LRAPLG1",260,0)
 I $D(DIRUT) S II=2 Q
"RTN","LRAPLG1",261,0)
 S LRWKCD=+$G(^LAB(60,+Y,64)),LRNLT=$P($G(^LAM(LRWKCD,0)),"^",2),II=1
"RTN","LRAPLG1",262,0)
 S XX=0
"RTN","LRAPLG1",263,0)
 F  S XX=$O(LRXX(XX)) Q:'XX  S $P(LRXX(XX),"^",2)=LRNLT_"^"_+Y
"RTN","LRAPLG1",264,0)
 ;
"RTN","LRAPLG1",265,0)
 Q
"RTN","LRAPLG1",266,0)
 ;
"RTN","LRAPLG1",267,0)
 ;
"RTN","LRAPLG1",268,0)
GETSTCS ;Get spec top and coll samp
"RTN","LRAPLG1",269,0)
 N LRI
"RTN","LRAPLG1",270,0)
 K LRXX
"RTN","LRAPLG1",271,0)
 S LRI=0,(LRXX,X)=""
"RTN","LRAPLG1",272,0)
 F  S LRI=$O(^LR(LRDFN,LRSS,LRIDT,.1,LRI)) Q:'LRI  D
"RTN","LRAPLG1",273,0)
 . S X=$G(^LR(LRDFN,LRSS,LRIDT,.1,LRI,0))
"RTN","LRAPLG1",274,0)
 . I $P(X,"^",6)'="" S LRXX($P(X,"^",6))=$P(X,"^",7)_"^"
"RTN","LRAPLG1",275,0)
 Q
"RTN","LRAPLG1",276,0)
 ;
"RTN","LRAPLG1",277,0)
 ;
"RTN","LRAPLG1",278,0)
CRE868 ; Create accession number in file 68
"RTN","LRAPLG1",279,0)
 N LRFDA,LRFDAIEN,LRIEN
"RTN","LRAPLG1",280,0)
 K LRMSG
"RTN","LRAPLG1",281,0)
 S LRIEN="+1,"_LRAD_","_LRAA_","
"RTN","LRAPLG1",282,0)
 S LRFDAIEN(1)=LRAN
"RTN","LRAPLG1",283,0)
 S LRFDA(1,68.02,LRIEN,.01)=LRDFN
"RTN","LRAPLG1",284,0)
 D UPDATE^DIE("S","LRFDA(1)","LRFDAIEN","LRMSG")
"RTN","LRAPLG1",285,0)
 I $D(LRMSG) S LRSD=LRAD D LRMSG("EN~LRAPGL1",.LRMSG) Q
"RTN","LRAPLG1",286,0)
 S X=LRAN
"RTN","LRAPLG1",287,0)
 Q
"RTN","LRAPLG1",288,0)
 ;
"RTN","LRAPLG1",289,0)
 ;
"RTN","LRAPLG1",290,0)
CRE863 ; Create entry in file #63
"RTN","LRAPLG1",291,0)
 ;
"RTN","LRAPLG1",292,0)
 N DIR,DIRUT,DTOUT,DUOUT,X,Y
"RTN","LRAPLG1",293,0)
 S DIR(0)="DO^:NOW:ET"
"RTN","LRAPLG1",294,0)
 S DIR("A")="Date/time Specimen taken",DIR("B")="NOW"
"RTN","LRAPLG1",295,0)
 D ^DIR K DIR
"RTN","LRAPLG1",296,0)
 I Y<1 D END Q
"RTN","LRAPLG1",297,0)
 S (LRY,LRSD)=Y,LRI=9999999-LRY
"RTN","LRAPLG1",298,0)
 ;
"RTN","LRAPLG1",299,0)
 ; Process and get unique LRI
"RTN","LRAPLG1",300,0)
 F  Q:'$D(^LR(LRDFN,LRSS,LRI,0))  D
"RTN","LRAPLG1",301,0)
 . S (LRSD,LRY)=$$FMADD^XLFDT(LRY,,,,1)
"RTN","LRAPLG1",302,0)
 . S LRI=9999999-LRY
"RTN","LRAPLG1",303,0)
 ;
"RTN","LRAPLG1",304,0)
 N LRFDA,LRIEN,LRFILE,LRFDAIEN
"RTN","LRAPLG1",305,0)
 K DIERR,LRMSG
"RTN","LRAPLG1",306,0)
 S LRACC=LRAC,LRNT=$$NOW^XLFDT()
"RTN","LRAPLG1",307,0)
 S LRFILE=$S(LRSS="SP":63.08,LRSS="CY":63.09,LRSS="EM":63.02,1:63.08)
"RTN","LRAPLG1",308,0)
 S LRFDAIEN(1)=LRI
"RTN","LRAPLG1",309,0)
 S LRIEN="+1,"_LRDFN_","
"RTN","LRAPLG1",310,0)
 S LRFDA(2,LRFILE,LRIEN,.01)=LRSD
"RTN","LRAPLG1",311,0)
 S LRFDA(2,LRFILE,LRIEN,.06)=LRACC
"RTN","LRAPLG1",312,0)
 ;
"RTN","LRAPLG1",313,0)
 D UPDATE^DIE("","LRFDA(2)","LRFDAIEN","LRMSG")
"RTN","LRAPLG1",314,0)
 L -^LR(LRDFN,LRSS)
"RTN","LRAPLG1",315,0)
 I $D(LRMSG) D LRMSG("F~LRAPLG1",.LRMSG) Q
"RTN","LRAPLG1",316,0)
 ;
"RTN","LRAPLG1",317,0)
 S (LRI,LRIDT)=LRFDAIEN(1)
"RTN","LRAPLG1",318,0)
 ;
"RTN","LRAPLG1",319,0)
 Q
"RTN","LRAPLG1",320,0)
 ;
"RTN","LRAPLG1",321,0)
 ;
"RTN","LRAPLG1",322,0)
SPMOVE ; Copy surgery information into lab package
"RTN","LRAPLG1",323,0)
 ;  - store surgery package reference to retrieve surgeon/attending.
"RTN","LRAPLG1",324,0)
 ;  - LRFLAG used to determine if data copied from Surgery packge and moved to Lab and generate notice.
"RTN","LRAPLG1",325,0)
 ;         if no data before and data after call to SROSPLG then add disclaimer.
"RTN","LRAPLG1",326,0)
 ;
"RTN","LRAPLG1",327,0)
 S X="SROSPLG" X ^%ZOSF("TEST")
"RTN","LRAPLG1",328,0)
 I '$T Q
"RTN","LRAPLG1",329,0)
 ;
"RTN","LRAPLG1",330,0)
 N I,LRFIELD,LRFLAG,LRJ,LRSREF,LRSRTN,LRWP
"RTN","LRAPLG1",331,0)
 S LRFLAG="",LRSRTN=$G(SRTN)
"RTN","LRAPLG1",332,0)
 I LRSRTN D
"RTN","LRAPLG1",333,0)
 . N LRDATA,LRDIE
"RTN","LRAPLG1",334,0)
 . S LRDATA(.01)=LRDFN_","_LRSS_","_LRI_",0"
"RTN","LRAPLG1",335,0)
 . S LRDATA(.02)=1
"RTN","LRAPLG1",336,0)
 . S LRDATA(1)=LRSRTN_";SRF("
"RTN","LRAPLG1",337,0)
 . D SETREF^LRUEPR(LRDFN,LRDATA(.01),.LRDATA,1)
"RTN","LRAPLG1",338,0)
 . F I=.2,.3,.4,.5 I '$O(^LR(LRDFN,LRSS,LRI,I,0)) S $P(LRFLAG,"^",I*10)=1
"RTN","LRAPLG1",339,0)
 ;
"RTN","LRAPLG1",340,0)
 D DISP^SROSPLG
"RTN","LRAPLG1",341,0)
 ;
"RTN","LRAPLG1",342,0)
 ; Create notation on where info came from if site wants reference.
"RTN","LRAPLG1",343,0)
 ;  also store referece as external package reference.
"RTN","LRAPLG1",344,0)
 S LRSREF=$$GET^XPAR("DIV^PKG","LR AP SURGERY REFERENCE",1,"Q")
"RTN","LRAPLG1",345,0)
 S LRFIELD(.013)="(#60) BRIEF CLIN HISTORY"
"RTN","LRAPLG1",346,0)
 S LRFIELD(.014)="(#32) PRINCIPAL PRE-OP DIAGNOSIS, (#.72) OTHER PREOP DIAGNOSIS"
"RTN","LRAPLG1",347,0)
 S LRFIELD(.015)="(#59) OPERATIVE FINDINGS"
"RTN","LRAPLG1",348,0)
 S LRFIELD(.016)="(#34) PRINCIPAL POST-OP DIAG, (#.74) OTHER POSTOP DIAGS"
"RTN","LRAPLG1",349,0)
 S LRWP(1)=" "
"RTN","LRAPLG1",350,0)
 F LRJ=.2,.3,.4,.5 I $P(LRFLAG,"^",LRJ*10),$O(^LR(LRDFN,LRSS,LRI,LRJ,0)) D
"RTN","LRAPLG1",351,0)
 . N LRDATA,LRDIE
"RTN","LRAPLG1",352,0)
 . S LRFIELD=$P("^.013^.014^.015^.016","^",LRJ*10)
"RTN","LRAPLG1",353,0)
 . S LRWP(2)="Information automatically documented from SURGERY package case #"_LRSRTN_" Field "_LRFIELD(LRFIELD)
"RTN","LRAPLG1",354,0)
 . I LRSREF=1 D WP^DIE(63.08,LRI_","_LRDFN_",",LRFIELD,"A","LRWP","LRDIE(LRFIELD)")
"RTN","LRAPLG1",355,0)
 . S LRDATA(.01)=LRDFN_","_LRSS_","_LRI_","_LRJ_",0"
"RTN","LRAPLG1",356,0)
 . S LRDATA(.02)=1
"RTN","LRAPLG1",357,0)
 . S LRDATA(1)=LRSRTN_";SRF(;"_LRWP(2)
"RTN","LRAPLG1",358,0)
 . D SETREF^LRUEPR(LRDFN,LRDATA(.01),.LRDATA,1)
"RTN","LRAPLG1",359,0)
 ;
"RTN","LRAPLG1",360,0)
 Q
"RTN","LRAPLG1",361,0)
 ;
"RTN","LRAPLG1",362,0)
 ;
"RTN","LRAPLG1",363,0)
LRMSG(LRRNAME,LRFMERR) ;
"RTN","LRAPLG1",364,0)
 ; Filing error notification
"RTN","LRAPLG1",365,0)
 ; Inputs
"RTN","LRAPLG1",366,0)
 ;  LRRNAME: Routine name  (TAG~RTN)
"RTN","LRAPLG1",367,0)
 ;  LRFMERR:<byref> FileMan error local array
"RTN","LRAPLG1",368,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LRDIE
"RTN","LRAPLG1",369,0)
 S LRRNAME=$TR($G(LRRNAME),"^","~")
"RTN","LRAPLG1",370,0)
 M LRDIE=LRFMERR
"RTN","LRAPLG1",371,0)
 D MAILALRT^LRWLST12(LRRNAME,.LRFMERR)
"RTN","LRAPLG1",372,0)
 S DIR(0)="EA"
"RTN","LRAPLG1",373,0)
 S DIR("A",1)="Filing error in "_LRRNAME_" for this accession/specimen"
"RTN","LRAPLG1",374,0)
 S DIR("A")="Press the return key to continue"
"RTN","LRAPLG1",375,0)
 D ^DIR
"RTN","LRAPLG1",376,0)
 Q
"RTN","LRAPLG1",377,0)
 ;
"RTN","LRAPLG1",378,0)
 ;
"RTN","LRAPLG1",379,0)
OUT ;
"RTN","LRAPLG1",380,0)
 ; Exit point
"RTN","LRAPLG1",381,0)
 Q
"RTN","LRAPLG1",382,0)
 ;
"RTN","LRAPLG1",383,0)
 ;
"RTN","LRAPLG1",384,0)
END ; from LRAUAW, LRAPLG2
"RTN","LRAPLG1",385,0)
 ; Lock Accession file
"RTN","LRAPLG1",386,0)
 D LOCK^DILF("^LRO(68,LRAA,1,LRAD,1,0)")
"RTN","LRAPLG1",387,0)
 I '$T D EN^DDIOL("Someone else is logging in specimens.  Please wait and try again.","","!!") Q
"RTN","LRAPLG1",388,0)
 ;
"RTN","LRAPLG1",389,0)
 N DIK,DA
"RTN","LRAPLG1",390,0)
 S DA=LRAN,DA(1)=LRAD,DA(2)=LRAA
"RTN","LRAPLG1",391,0)
 S DIK="^LRO(68,"_DA(2)_",1,"_DA(1)_",1,"
"RTN","LRAPLG1",392,0)
 D ^DIK
"RTN","LRAPLG1",393,0)
 ;
"RTN","LRAPLG1",394,0)
 L -^LRO(68,LRAA,1,LRAD,1,0)
"RTN","LRAPLG1",395,0)
 Q
"RTN","LRAPLG1",396,0)
 ;
"RTN","LRAPLG1",397,0)
 ;
"RTN","LRAPLG1",398,0)
FIX ; Entry point to delete an orphan AP entry in file #63
"RTN","LRAPLG1",399,0)
 ;
"RTN","LRAPLG1",400,0)
 N DA,DFN,DIC,DIK,DIR,DIROUT,DIRUT,DIQ,DR,DTOUT
"RTN","LRAPLG1",401,0)
 N LRAA,LRABV,LRAC,LRAD,LRAN,LRDFN,LRDPA,LRDPF,LRH,LRI,LRRC,LRSS,LRWHN,LRXR,LRXREF
"RTN","LRAPLG1",402,0)
 N AGE,PNM,SEX,X,Y
"RTN","LRAPLG1",403,0)
 ;
"RTN","LRAPLG1",404,0)
 D ^LRAP Q:'$D(Y)
"RTN","LRAPLG1",405,0)
 D XR^LRU
"RTN","LRAPLG1",406,0)
 ;
"RTN","LRAPLG1",407,0)
 I LRSS'?1(1"SP",1"CY",1"EM") W !,"This program only supports SP, CY and EM subscripts",! Q
"RTN","LRAPLG1",408,0)
 ;
"RTN","LRAPLG1",409,0)
 S LRH(2)=$E(LRAD,1,3),LRWHN=$E(LRAD,2,3)
"RTN","LRAPLG1",410,0)
 ;
"RTN","LRAPLG1",411,0)
 D EN1^LRUPS Q:LRAN=-1
"RTN","LRAPLG1",412,0)
 I $P(^LR(LRDFN,LRSS,LRI,0),"^",11)'="" W !,"Report has been released!",! Q
"RTN","LRAPLG1",413,0)
 I $D(^LR(LRDFN,LRSS,LRI,2005)) D  Q
"RTN","LRAPLG1",414,0)
 . W !,"Report has associated images in IMAGING package!"
"RTN","LRAPLG1",415,0)
 . W !,"Disposition these images before deleting this entry!",!
"RTN","LRAPLG1",416,0)
 ;
"RTN","LRAPLG1",417,0)
 K DR
"RTN","LRAPLG1",418,0)
 S DIC="^LR("_LRDFN_","""_LRSS_""",",DA(1)=LRDFN,DA=LRI,DIQ(0)="ACR"
"RTN","LRAPLG1",419,0)
 D EN^DIQ
"RTN","LRAPLG1",420,0)
 ;
"RTN","LRAPLG1",421,0)
 S DIR(0)="Y",DIR("A")="DELETE this entry",DIR("B")="NO"
"RTN","LRAPLG1",422,0)
 D ^DIR
"RTN","LRAPLG1",423,0)
 I Y<1 Q
"RTN","LRAPLG1",424,0)
 ;
"RTN","LRAPLG1",425,0)
 K DIR
"RTN","LRAPLG1",426,0)
 S DIR(0)="Y",DIR("A")="Are you sure",DIR("B")="NO"
"RTN","LRAPLG1",427,0)
 D ^DIR
"RTN","LRAPLG1",428,0)
 I Y<1 Q
"RTN","LRAPLG1",429,0)
 ;
"RTN","LRAPLG1",430,0)
 ; Lock record
"RTN","LRAPLG1",431,0)
 D LOCK^DILF("^LR(LRDFN,LRSS,LRI)")
"RTN","LRAPLG1",432,0)
 I '$T D  Q
"RTN","LRAPLG1",433,0)
 . D EN^DDIOL("Someone else is accessing this record.  Please wait and try again.","","!!")
"RTN","LRAPLG1",434,0)
 . D KVA^VADPT,V^LRU
"RTN","LRAPLG1",435,0)
 ;
"RTN","LRAPLG1",436,0)
 K DA,DIK
"RTN","LRAPLG1",437,0)
 S DA=LRI,DA(1)=LRDFN,DIK="^LR("_DA(1)_","""_LRSS_""","
"RTN","LRAPLG1",438,0)
 D ^DIK
"RTN","LRAPLG1",439,0)
 ;
"RTN","LRAPLG1",440,0)
 ; Cleanup some cross-references.
"RTN","LRAPLG1",441,0)
 I LRSS?1(1"SP",1"CY",1"EM") D
"RTN","LRAPLG1",442,0)
 . K ^LR(LRXREF,LRH(2),LRABV,LRAN,LRDFN,LRI)
"RTN","LRAPLG1",443,0)
 . I $G(LRRC)>1 K ^LR(LRXR,LRRC,LRDFN,LRI)
"RTN","LRAPLG1",444,0)
 ;
"RTN","LRAPLG1",445,0)
 I LRSS="AU" D
"RTN","LRAPLG1",446,0)
 . I $D(^LR(LRDFN,"AV")) K ^LR(LRDFN,"AV")
"RTN","LRAPLG1",447,0)
 . I $D(^LR(LRDFN,"AW")) K ^LR(LRDFN,"AW")
"RTN","LRAPLG1",448,0)
 . I $D(^LR(LRDFN,"AWI")) K ^LR(LRDFN,"AWI")
"RTN","LRAPLG1",449,0)
 . I $D(LRRC) K ^LR("AAUA",+$E(LRRC,1,3),LRABV,LRAN),^LR("AAU",+LRRC,LRDFN)
"RTN","LRAPLG1",450,0)
 ;
"RTN","LRAPLG1",451,0)
 ; Release lock
"RTN","LRAPLG1",452,0)
 L -^LR(LRDFN,LRSS,LRI)
"RTN","LRAPLG1",453,0)
 ;
"RTN","LRAPLG1",454,0)
 W !!,"Entry deleted",!
"RTN","LRAPLG1",455,0)
 D KVA^VADPT,V^LRU
"RTN","LRAPLG1",456,0)
 ;
"RTN","LRAPLG1",457,0)
 Q
"RTN","LRAPPOW")
0^21^B8842650
"RTN","LRAPPOW",1,0)
LRAPPOW ;DALOI/REG/WTY - POW PATIENT LOOK-UP ;01/29/13  16:51
"RTN","LRAPPOW",2,0)
 ;;5.2;LAB SERVICE;**72,114,259,427**;Sep 27, 1994;Build 33
"RTN","LRAPPOW",3,0)
 ;
"RTN","LRAPPOW",4,0)
 ;Reference to ^DIC(22 supported by IA #935
"RTN","LRAPPOW",5,0)
 ;Reference to ^DPT supported by IA #918
"RTN","LRAPPOW",6,0)
 ;
"RTN","LRAPPOW",7,0)
 ;16-OCT-01;WTY;Unwrapped code and added device handling
"RTN","LRAPPOW",8,0)
 ;
"RTN","LRAPPOW",9,0)
 S:'$D(LRSF515) LRSF515=0
"RTN","LRAPPOW",10,0)
 S:'$D(LR("Q")) LR("Q")=0
"RTN","LRAPPOW",11,0)
 I $D(^DPT(DFN,.52)),$P(^(.52),U,5)="Y" D  Q:LR("Q")
"RTN","LRAPPOW",12,0)
 .S X=$P(^(.52),U,6)
"RTN","LRAPPOW",13,0)
 .D FLG
"RTN","LRAPPOW",14,0)
 I $D(^DPT(DFN,.322)) D
"RTN","LRAPPOW",15,0)
 .S X=$P($G(^(.322)),"^",10)
"RTN","LRAPPOW",16,0)
 .D:X="Y" R
"RTN","LRAPPOW",17,0)
 Q
"RTN","LRAPPOW",18,0)
FLG ;
"RTN","LRAPPOW",19,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",20,0)
 W !!?19,$C(7),"*** THIS PATIENT WAS A PRISONER OF WAR ***"
"RTN","LRAPPOW",21,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",22,0)
 W !!
"RTN","LRAPPOW",23,0)
 I X S X=$S($D(^DIC(22,X,0)):$P(^(0),U,1),1:"") W ?24,"POW PERIOD: ",X
"RTN","LRAPPOW",24,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",25,0)
 W !!,"FORWARD A DUPLICATE SET OF SLIDES,BLOCKS AND REPRESENTATIVE "
"RTN","LRAPPOW",26,0)
 W "WET TISSUE TO:"
"RTN","LRAPPOW",27,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",28,0)
 W !!,?3,"DIRECTOR,JOINT PATHOLOGY CENTER"
"RTN","LRAPPOW",29,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",30,0)
 W !,?3,"ATTENTION: FORMER POW REGISTRY"
"RTN","LRAPPOW",31,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",32,0)
 W !,?3,"606 STEPHEN SITTER AVENUE"
"RTN","LRAPPOW",33,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",34,0)
 W !,?3,"SILVER SPRING, MD 20910-1290",!,"<A POW label (VA Form 10-5558) may "
"RTN","LRAPPOW",35,0)
 W "be attached to packaged specimens>"
"RTN","LRAPPOW",36,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",37,0)
 W !!,"MARK CASE CLEARLY AS:"
"RTN","LRAPPOW",38,0)
 W "  FORMER POW  ",X
"RTN","LRAPPOW",39,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",40,0)
 W !,"NOTE IN APPROPRIATE FORM THAT MATERIAL HAS BEEN SENT TO THE JPC"
"RTN","LRAPPOW",41,0)
 I $D(LRSS),LRSS="AU" D NOTE
"RTN","LRAPPOW",42,0)
 W !!
"RTN","LRAPPOW",43,0)
 Q
"RTN","LRAPPOW",44,0)
NOTE ;
"RTN","LRAPPOW",45,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",46,0)
 W !!,"Follow Guidelines for Performing Autopsy Examination on Former "
"RTN","LRAPPOW",47,0)
 W "Prisoners of War (POW's)  PROFESSIONAL SERVICES LETTER  IL 11-82-17"
"RTN","LRAPPOW",48,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",49,0)
 W !,"Be sure to take appropriate samples of:"
"RTN","LRAPPOW",50,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",51,0)
 W !,"BRAIN, NERVE, TESTES, PROSTATE, URINARY BLADDER, and KIDNEY"
"RTN","LRAPPOW",52,0)
 Q
"RTN","LRAPPOW",53,0)
R ;
"RTN","LRAPPOW",54,0)
 N LRTMP
"RTN","LRAPPOW",55,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",56,0)
 S LRTMP="***THIS PATIENT SERVED IN THE PERSIAN GULF WAR***"
"RTN","LRAPPOW",57,0)
 W $C(7),!!,$$CJ^XLFSTR(LRTMP,IOM)
"RTN","LRAPPOW",58,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",59,0)
 W !!
"RTN","LRAPPOW",60,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",61,0)
 W !,$$CJ^XLFSTR("***************",IOM)
"RTN","LRAPPOW",62,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",63,0)
 S LRTMP="Send a set of DUPLICATE paraffin blocks/smears, "
"RTN","LRAPPOW",64,0)
 S LRTMP=LRTMP_"H & E slides for "
"RTN","LRAPPOW",65,0)
 W !!,$$CJ^XLFSTR(LRTMP,IOM)
"RTN","LRAPPOW",66,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",67,0)
 S LRTMP="Anatomic Path material and a copy of the Final Pathology "
"RTN","LRAPPOW",68,0)
 S LRTMP=LRTMP_"Report to "
"RTN","LRAPPOW",69,0)
 W !!,$$CJ^XLFSTR(LRTMP,IOM)
"RTN","LRAPPOW",70,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",71,0)
 W !!,$$CJ^XLFSTR("the JPC using the JPC Requisition form.  ",IOM)
"RTN","LRAPPOW",72,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",73,0)
 W !!
"RTN","LRAPPOW",74,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",75,0)
 W !,$$CJ^XLFSTR("***************",IOM)
"RTN","LRAPPOW",76,0)
 D PAGE Q:LR("Q")
"RTN","LRAPPOW",77,0)
 W !
"RTN","LRAPPOW",78,0)
 Q
"RTN","LRAPPOW",79,0)
PAGE ;
"RTN","LRAPPOW",80,0)
 Q:'LRSF515
"RTN","LRAPPOW",81,0)
 D:$Y>(IOSL-13) F^LRAPF,^LRAPF
"RTN","LRAPPOW",82,0)
 Q
"RTN","LRAPRES")
0^42^B184608349
"RTN","LRAPRES",1,0)
LRAPRES ;DALOI/STAFF - AP ESIG RELEASE REPORT ;06/18/13  13:41
"RTN","LRAPRES",2,0)
 ;;5.2;LAB SERVICE;**259,295,317,315,350,427**;Sep 27, 1994;Build 33
"RTN","LRAPRES",3,0)
 ;
"RTN","LRAPRES",4,0)
 ;
"RTN","LRAPRES",5,0)
 ; Reference to NEW^TIUPNAPI supported by IA #1911
"RTN","LRAPRES",6,0)
 ; Reference to SETPARM^TIULE supported by IA #2863
"RTN","LRAPRES",7,0)
 ; Reference to File #8925.1 supported by IA #5033
"RTN","LRAPRES",8,0)
 ; Reference to TGET^TIUSRVR1 supported by IA #2944
"RTN","LRAPRES",9,0)
 ; Reference to $$DDEFIEN^TIUFLF7 supported by IA #5352
"RTN","LRAPRES",10,0)
 ; Reference to EXTRACT^TIULQ supported by IA #2693
"RTN","LRAPRES",11,0)
 ;
"RTN","LRAPRES",12,0)
 ; ZEXCEPT is used to identify variables which are external to a specific TAG
"RTN","LRAPRES",13,0)
 ;         used in conjunction with Eclipse M-editor.
"RTN","LRAPRES",14,0)
 ;
"RTN","LRAPRES",15,0)
MAIN ;
"RTN","LRAPRES",16,0)
 N LRMSG,LRDEM,LREND,LRQUIT,LRNTIME,LRPRCLSS,LRVCDE,LRMTCH
"RTN","LRAPRES",17,0)
 N LRPCEXP,LRESCPT,LRPCSTR,USRSEL
"RTN","LRAPRES",18,0)
 S LRESCPT=0
"RTN","LRAPRES",19,0)
 D TITLE
"RTN","LRAPRES",20,0)
 I LRQUIT D END Q
"RTN","LRAPRES",21,0)
 D CPTCHK
"RTN","LRAPRES",22,0)
 F  D  Q:LRQUIT
"RTN","LRAPRES",23,0)
 . S LRQUIT=0
"RTN","LRAPRES",24,0)
 . D MENU
"RTN","LRAPRES",25,0)
 . Q:LRQUIT
"RTN","LRAPRES",26,0)
 . S USRSEL=$G(LRSEL)
"RTN","LRAPRES",27,0)
 . D  ; Protect USRSEL var
"RTN","LRAPRES",28,0)
 . . N USRSEL
"RTN","LRAPRES",29,0)
 . . D SECTION
"RTN","LRAPRES",30,0)
 . Q:LRQUIT
"RTN","LRAPRES",31,0)
 . S LREND=0
"RTN","LRAPRES",32,0)
 . I USRSEL="E" S LREND=0 D CLSSCHK^LRAPRES1(DUZ,.LREND)
"RTN","LRAPRES",33,0)
 . Q:LREND
"RTN","LRAPRES",34,0)
 . D ACCYR
"RTN","LRAPRES",35,0)
 . Q:LRQUIT
"RTN","LRAPRES",36,0)
 . D ACCPN
"RTN","LRAPRES",37,0)
 D END
"RTN","LRAPRES",38,0)
 Q
"RTN","LRAPRES",39,0)
 ;
"RTN","LRAPRES",40,0)
 ;
"RTN","LRAPRES",41,0)
ACCPN ; Prompt for accession number or patient name
"RTN","LRAPRES",42,0)
 N USRSEL1
"RTN","LRAPRES",43,0)
 S USRSEL1=$G(USRSEL) ;from MAIN
"RTN","LRAPRES",44,0)
 F  D  Q:LREND
"RTN","LRAPRES",45,0)
 . S (LRQUIT,LREND)=0
"RTN","LRAPRES",46,0)
 . D CPTCHK
"RTN","LRAPRES",47,0)
 . D LOOKUP^LRAPUTL(.LRDATA,LRH(0),LRO(68),LRSS,LRAD,LRAA)
"RTN","LRAPRES",48,0)
 . Q:'LRDATA
"RTN","LRAPRES",49,0)
 . I LRDATA=-1 S LREND=1 Q
"RTN","LRAPRES",50,0)
 . S LRDFN=LRDATA,LRI=LRDATA(1)
"RTN","LRAPRES",51,0)
 . S LRIENS=LRI_","_LRDFN_","
"RTN","LRAPRES",52,0)
 . I USRSEL1="E" D  Q:LRQUIT
"RTN","LRAPRES",53,0)
 . . D RELCHK
"RTN","LRAPRES",54,0)
 . . Q:LRQUIT
"RTN","LRAPRES",55,0)
 . . D SETRL^LRVERA(LRDFN,LRSS,$S('LRAU:LRI,1:0),DUZ(2))
"RTN","LRAPRES",56,0)
 . . D:'LRZ(2) BROWSE
"RTN","LRAPRES",57,0)
 . . D ESIG
"RTN","LRAPRES",58,0)
 . . Q:LRQUIT
"RTN","LRAPRES",59,0)
 . . S LRNTIME=$$NOW^XLFDT
"RTN","LRAPRES",60,0)
 . . I 'LRZ(2) D TIUPREP,STORE
"RTN","LRAPRES",61,0)
 . . Q:LRQUIT
"RTN","LRAPRES",62,0)
 . . D RELEASE
"RTN","LRAPRES",63,0)
 . . Q:LRQUIT
"RTN","LRAPRES",64,0)
 . . D:'LRZ(2) MAIN^LRAPRES1(LRDFN,LRSS,LRI,LRSF,LRP,LRAC)
"RTN","LRAPRES",65,0)
 . . D OERR^LR7OB63D
"RTN","LRAPRES",66,0)
 . I USRSEL1="C" D
"RTN","LRAPRES",67,0)
 . . Q:$T(CPT^LRCAPES)=""
"RTN","LRAPRES",68,0)
 . . S LRPRO=DUZ
"RTN","LRAPRES",69,0)
 . . D PROVIDR^LRAPUTL
"RTN","LRAPRES",70,0)
 . . Q:LRQUIT
"RTN","LRAPRES",71,0)
 . . D CPT^LRCAPES(LRAA,LRAD,LRAN,LRPRO)
"RTN","LRAPRES",72,0)
 . I USRSEL1="V" D
"RTN","LRAPRES",73,0)
 . . D DEMARR
"RTN","LRAPRES",74,0)
 . . D INIT^LRAPSNMD(LRDFN,LRSS,LRI,LRSF,LRAA,LRAN,LRAD,.LRDEM,1)
"RTN","LRAPRES",75,0)
 Q
"RTN","LRAPRES",76,0)
 ;
"RTN","LRAPRES",77,0)
 ;
"RTN","LRAPRES",78,0)
TITLE ; Title
"RTN","LRAPRES",79,0)
 S LRQUIT=0
"RTN","LRAPRES",80,0)
 D CK^LRAP
"RTN","LRAPRES",81,0)
 I Y=-1 S LRQUIT=1 Q
"RTN","LRAPRES",82,0)
 W @IOF
"RTN","LRAPRES",83,0)
 S LRTEXT="Release/Electronically Sign Pathology Reports"
"RTN","LRAPRES",84,0)
 S LRMSG(1)=$$CJ^XLFSTR(LRTEXT,IOM)
"RTN","LRAPRES",85,0)
 S LRMSG(1,"F")="!!"
"RTN","LRAPRES",86,0)
 S LRMSG(2)="",LRMSG(2,"F")="!"
"RTN","LRAPRES",87,0)
 D EN^DDIOL(.LRMSG) K LRMSG
"RTN","LRAPRES",88,0)
 Q
"RTN","LRAPRES",89,0)
 ;
"RTN","LRAPRES",90,0)
 ;
"RTN","LRAPRES",91,0)
CPTCHK ; Determine if CPT is activated
"RTN","LRAPRES",92,0)
 Q:$T(ES^LRCAPES)=""
"RTN","LRAPRES",93,0)
 S LRESCPT=$$ES^LRCAPES()
"RTN","LRAPRES",94,0)
 Q
"RTN","LRAPRES",95,0)
 ;
"RTN","LRAPRES",96,0)
 ;
"RTN","LRAPRES",97,0)
DEMARR ;
"RTN","LRAPRES",98,0)
 I LRAU D
"RTN","LRAPRES",99,0)
 . S LRPRO=$$GET1^DIQ(63,LRDFN_",",13.5,"I")
"RTN","LRAPRES",100,0)
 . S LRPRO(1)=$$GET1^DIQ(63,LRDFN_",",13.5)
"RTN","LRAPRES",101,0)
 I 'LRAU D
"RTN","LRAPRES",102,0)
 . S LRPRO=$$GET1^DIQ(LRSF,LRI_","_LRDFN_",",.07,"I")
"RTN","LRAPRES",103,0)
 . S LRPRO(1)=$$GET1^DIQ(LRSF,LRI_","_LRDFN_",",.07)
"RTN","LRAPRES",104,0)
 S LRDEM("SEX")=SEX,LRDEM("DOB")=DOB
"RTN","LRAPRES",105,0)
 S LRDEM("AGE")=AGE
"RTN","LRAPRES",106,0)
 S LRDEM("SEC")=LRAA(1),LRDEM("PNM")=PNM
"RTN","LRAPRES",107,0)
 S LRDEM("SSN")=SSN,LRDEM("PRO")=LRPRO(1)
"RTN","LRAPRES",108,0)
 I LRAU D
"RTN","LRAPRES",109,0)
 . S LRDEM("DTH")=$P(VADM(6),"^",2)
"RTN","LRAPRES",110,0)
 . S LRDEM("AUDT")=$$GET1^DIQ(63,LRDFN_",",11)
"RTN","LRAPRES",111,0)
 . S LRDEM("AUTYP")=$$GET1^DIQ(63,LRDFN_",",13.7)
"RTN","LRAPRES",112,0)
 Q
"RTN","LRAPRES",113,0)
 ;
"RTN","LRAPRES",114,0)
 ;
"RTN","LRAPRES",115,0)
MENU ;
"RTN","LRAPRES",116,0)
 N DIR,X,Y
"RTN","LRAPRES",117,0)
 S DIR(0)="SO^"
"RTN","LRAPRES",118,0)
 S:LRESCPT DIR(0)=DIR(0)_"C:CPT Coding;"
"RTN","LRAPRES",119,0)
 S DIR(0)=DIR(0)_"E:Electronically Sign Reports;V:View SNOMED Codes"
"RTN","LRAPRES",120,0)
 S DIR("A")="Selection"
"RTN","LRAPRES",121,0)
 D ^DIR
"RTN","LRAPRES",122,0)
 I $D(DIRUT) S LRQUIT=1 Q
"RTN","LRAPRES",123,0)
 S LRSEL=Y
"RTN","LRAPRES",124,0)
 Q
"RTN","LRAPRES",125,0)
 ;
"RTN","LRAPRES",126,0)
 ;
"RTN","LRAPRES",127,0)
SECTION ; Choose Anatomic Pathology section (AU,SP,CY,EM)
"RTN","LRAPRES",128,0)
 N LRMSG
"RTN","LRAPRES",129,0)
 W !
"RTN","LRAPRES",130,0)
 D ^LRAP
"RTN","LRAPRES",131,0)
 I '$D(Y)!('$D(LRSS)) S LRQUIT=1 Q
"RTN","LRAPRES",132,0)
 S:LRO(68)="EM" LRO(68)="ELECTRON MICROSCOPY"
"RTN","LRAPRES",133,0)
 S LRAU=0            ; LRAU = 0 - Not Autopsy
"RTN","LRAPRES",134,0)
 S:LRSS="AU" LRAU=1  ;      = 1 - Autopsy
"RTN","LRAPRES",135,0)
 I LRCAPA D  Q:LRQUIT
"RTN","LRAPRES",136,0)
 . S X=""
"RTN","LRAPRES",137,0)
 . S:LRSS="CY" X="CYTOLOGY REPORTING"
"RTN","LRAPRES",138,0)
 . S:LRSS="SP" X="SURGICAL PATH REPORTING"
"RTN","LRAPRES",139,0)
 . D:X'="" X^LRUWK
"RTN","LRAPRES",140,0)
 . S:'$D(X) LRQUIT=1
"RTN","LRAPRES",141,0)
 ;
"RTN","LRAPRES",142,0)
 S LRSOP="Z"
"RTN","LRAPRES",143,0)
 S LRMSG(1)=LRO(68)_" ("_LRABV_")",LRMSG(1,"F")="!?20"
"RTN","LRAPRES",144,0)
 S LRMSG(2)="",LRMSG(2,"F")="!"
"RTN","LRAPRES",145,0)
 D EN^DDIOL(.LRMSG)
"RTN","LRAPRES",146,0)
 Q
"RTN","LRAPRES",147,0)
 ;
"RTN","LRAPRES",148,0)
 ;
"RTN","LRAPRES",149,0)
ACCYR ; Determine Accession Year
"RTN","LRAPRES",150,0)
 D ACCYR^LRAPUTL(.LRAD1,LRH(0),LRAA,LRO(68))
"RTN","LRAPRES",151,0)
 I LRAD1=-1 S LRQUIT=1 Q
"RTN","LRAPRES",152,0)
 I LRAD1 S LRAD=$P(LRAD1,U),LRH(0)=$P(LRAD1,U,2)
"RTN","LRAPRES",153,0)
 Q
"RTN","LRAPRES",154,0)
 ;
"RTN","LRAPRES",155,0)
 ;
"RTN","LRAPRES",156,0)
RELCHK ; Perform series of checks
"RTN","LRAPRES",157,0)
 N LRPAT,LRSRLST,LRSRREL
"RTN","LRAPRES",158,0)
 S LRQUIT=0
"RTN","LRAPRES",159,0)
 I 'LRAU D  Q:LRQUIT
"RTN","LRAPRES",160,0)
 . S LRPAT=+$$GET1^DIQ(LRSF,LRIENS,.02,"I")
"RTN","LRAPRES",161,0)
 . S LRZ=$$GET1^DIQ(LRSF,LRIENS,.03,"I")
"RTN","LRAPRES",162,0)
 . S LRZ(1)=$$GET1^DIQ(LRSF,LRIENS,.13,"I")
"RTN","LRAPRES",163,0)
 . S LRZ(1.1)=$$GET1^DIQ(LRSF,LRIENS,.13)
"RTN","LRAPRES",164,0)
 . S LRZ(2)=$$GET1^DIQ(LRSF,LRIENS,.11,"I")
"RTN","LRAPRES",165,0)
 . I 'LRZ,'LRZ(2) D
"RTN","LRAPRES",166,0)
 . . W $C(7)
"RTN","LRAPRES",167,0)
 . . S LRMSG="No date report completed.  Cannot release."
"RTN","LRAPRES",168,0)
 . . D EN^DDIOL(LRMSG,"","!!") K LRMSG
"RTN","LRAPRES",169,0)
 . . S LRQUIT=1
"RTN","LRAPRES",170,0)
 ;
"RTN","LRAPRES",171,0)
 I LRAU D  Q:LRQUIT
"RTN","LRAPRES",172,0)
 . I $G(^LR(LRDFN,"AU"))="" D  Q
"RTN","LRAPRES",173,0)
 . . S LRMSG="No information found for this accession in the "
"RTN","LRAPRES",174,0)
 . . S LRMSG=LRMSG_"LAB DATA file (#63)."
"RTN","LRAPRES",175,0)
 . . D EN^DDIOL(LRMSG,"","!!") K LRMSG
"RTN","LRAPRES",176,0)
 . . S LRQUIT=1
"RTN","LRAPRES",177,0)
 . S LRPAT=+$$GET1^DIQ(63,LRDFN_",",13.6,"I")
"RTN","LRAPRES",178,0)
 . S LRZ=$$GET1^DIQ(63,LRDFN_",",13,"I")
"RTN","LRAPRES",179,0)
 . S LRZ(1)=$$GET1^DIQ(63,LRDFN_",",14.8,"I")
"RTN","LRAPRES",180,0)
 . S LRZ(1.1)=$$GET1^DIQ(63,LRDFN_",",14.8)
"RTN","LRAPRES",181,0)
 . S LRZ(2)=$$GET1^DIQ(63,LRDFN_",",14.7,"I")
"RTN","LRAPRES",182,0)
 . ; KLL-CHECK FOR PROVISIONAL DATE OR DATE REPORT COMPLETED
"RTN","LRAPRES",183,0)
 . S LRZ(3)=$$GET1^DIQ(63,LRDFN_",",14.9,"I")
"RTN","LRAPRES",184,0)
 . I 'LRZ,'LRZ(3) D
"RTN","LRAPRES",185,0)
 . . W $C(7)
"RTN","LRAPRES",186,0)
 . . S LRMSG="Provisional or date report completed required.  Cannot release."
"RTN","LRAPRES",187,0)
 . . D EN^DDIOL(LRMSG,"","!!") K LRMSG
"RTN","LRAPRES",188,0)
 . . S LRQUIT=1
"RTN","LRAPRES",189,0)
 I 'LRPAT,'LRZ(2) D
"RTN","LRAPRES",190,0)
 . W $C(7)
"RTN","LRAPRES",191,0)
 . S LRMSG="Pathologist or Cytotechnologist entry missing. Cannot release."
"RTN","LRAPRES",192,0)
 . D EN^DDIOL(LRMSG,"","!!") K LRMSG
"RTN","LRAPRES",193,0)
 . S LRQUIT=1
"RTN","LRAPRES",194,0)
 D:'LRZ(2) SUPCHK^LRAPR1
"RTN","LRAPRES",195,0)
 Q:LRQUIT
"RTN","LRAPRES",196,0)
 I LRZ(2) D  Q:LRQUIT
"RTN","LRAPRES",197,0)
 . W $C(7)
"RTN","LRAPRES",198,0)
 . S LRMSG="Report " S:LRZ(2)=1 LRMSG=LRMSG_"has already been "
"RTN","LRAPRES",199,0)
 . S LRMSG=LRMSG_"released "
"RTN","LRAPRES",200,0)
 . S Y=LRZ(2) D DD^%DT S:LRZ(2)>1 LRMSG=LRMSG_Y
"RTN","LRAPRES",201,0)
 . S:LRZ(1)'="" LRMSG=LRMSG_" by "_LRZ(1.1)
"RTN","LRAPRES",202,0)
 . D EN^DDIOL(LRMSG,"","!!") K LRMSG
"RTN","LRAPRES",203,0)
 . S:'LRAU LRQUIT=1
"RTN","LRAPRES",204,0)
 ; KLL-DON'T ALLOW UNRELEASE IF REPT COMPLETED DATE EXISTS FOR AU
"RTN","LRAPRES",205,0)
 I LRZ(2),LRZ S LRQUIT=1
"RTN","LRAPRES",206,0)
 S LRMSG="" D EN^DDIOL(LRMSG,"","!") K LRMSG
"RTN","LRAPRES",207,0)
 ; Don't allow unrelease if supp report not released for AU
"RTN","LRAPRES",208,0)
 I LRZ(2),'LRZ D
"RTN","LRAPRES",209,0)
 . S LRSRLST=$P($G(^LR(LRDFN,84,0)),"^",4)
"RTN","LRAPRES",210,0)
 . Q:'LRSRLST
"RTN","LRAPRES",211,0)
 . S LRSRREL=$P($G(^LR(LRDFN,84,LRSRLST,0)),"^",2)
"RTN","LRAPRES",212,0)
 . I 'LRSRREL D
"RTN","LRAPRES",213,0)
 . . N LRMSG
"RTN","LRAPRES",214,0)
 . . S LRMSG=$C(7)_"Supplementary report has not been released. Cannot use this option."
"RTN","LRAPRES",215,0)
 . . D EN^DDIOL(LRMSG,"","!!")
"RTN","LRAPRES",216,0)
 . . S LRQUIT=1
"RTN","LRAPRES",217,0)
 Q:LRQUIT
"RTN","LRAPRES",218,0)
 I LRZ(2),'LRZ D
"RTN","LRAPRES",219,0)
 . S DIR(0)="YA",DIR("B")="NO"
"RTN","LRAPRES",220,0)
 . S DIR("A")="Unrelease report? "
"RTN","LRAPRES",221,0)
 . D ^DIR
"RTN","LRAPRES",222,0)
 . I 'Y S LRQUIT=1
"RTN","LRAPRES",223,0)
 Q
"RTN","LRAPRES",224,0)
 ;
"RTN","LRAPRES",225,0)
 ;
"RTN","LRAPRES",226,0)
BROWSE ; Display the report in the browser
"RTN","LRAPRES",227,0)
 N DIR,DIRUT,DTOUT,DUOUT,X,Y
"RTN","LRAPRES",228,0)
 ;
"RTN","LRAPRES",229,0)
 ; Check if user's terminal supports browser functionality
"RTN","LRAPRES",230,0)
 I '$$TEST^DDBRT D  Q
"RTN","LRAPRES",231,0)
 . S DIR("A",1)="This terminal does not support the needed functionality to use the Browser!"
"RTN","LRAPRES",232,0)
 . S DIR("A",2)="Unable to display report on terminal."
"RTN","LRAPRES",233,0)
 . S DIR("A")="Press any key to continue."
"RTN","LRAPRES",234,0)
 . S DIR(0)="EA" D ^DIR
"RTN","LRAPRES",235,0)
 ;
"RTN","LRAPRES",236,0)
 S DIR(0)="YA",DIR("B")="YES"
"RTN","LRAPRES",237,0)
 S DIR("A")="View the report before signing? "
"RTN","LRAPRES",238,0)
 D ^DIR
"RTN","LRAPRES",239,0)
 I Y<1 Q
"RTN","LRAPRES",240,0)
 ;
"RTN","LRAPRES",241,0)
 K ^TMP("LRAPBR",$J)
"RTN","LRAPRES",242,0)
 S LRMSG=$$CJ^XLFSTR("*** Report is being processed.  One moment please. ***",IOM)
"RTN","LRAPRES",243,0)
 D EN^DDIOL(LRMSG,"","!!")
"RTN","LRAPRES",244,0)
 D INIT^LRAPBR(LRAA,LRSS,LRI,LRDFN,LRO(68),LRAU,0)
"RTN","LRAPRES",245,0)
 Q
"RTN","LRAPRES",246,0)
 ;
"RTN","LRAPRES",247,0)
 ;
"RTN","LRAPRES",248,0)
ESIG ; Prompt for electronic signature
"RTN","LRAPRES",249,0)
 S LRQUIT=0
"RTN","LRAPRES",250,0)
 D SIG^XUSESIG
"RTN","LRAPRES",251,0)
 I X1="" D  Q
"RTN","LRAPRES",252,0)
 . W "  SIGNATURE NOT VERIFIED"
"RTN","LRAPRES",253,0)
 . S LRQUIT=1
"RTN","LRAPRES",254,0)
 Q
"RTN","LRAPRES",255,0)
 ;
"RTN","LRAPRES",256,0)
 ;
"RTN","LRAPRES",257,0)
TIUPREP ;
"RTN","LRAPRES",258,0)
 K ^TMP("TIUP",$J)
"RTN","LRAPRES",259,0)
 S LRMSG="*** Report is being processed"
"RTN","LRAPRES",260,0)
 ; Exclude patient files 67, 67.1, 67.2, 67.3, 62.3 from TIU storage
"RTN","LRAPRES",261,0)
 ;
"RTN","LRAPRES",262,0)
 I LRDPF'=62.3,LRDPF'[67 S LRMSG=LRMSG_" for storage in TIU"
"RTN","LRAPRES",263,0)
 S LRMSG=LRMSG_".  One moment please. ***"
"RTN","LRAPRES",264,0)
 S LRMSG=$$CJ^XLFSTR(LRMSG,IOM)
"RTN","LRAPRES",265,0)
 D EN^DDIOL(LRMSG,"","!!")
"RTN","LRAPRES",266,0)
 ;
"RTN","LRAPRES",267,0)
 D INIT^LRAPBR(LRAA,LRSS,LRI,LRDFN,LRO(68),LRAU,1,LRNTIME)
"RTN","LRAPRES",268,0)
 Q
"RTN","LRAPRES",269,0)
 ;
"RTN","LRAPRES",270,0)
 ;
"RTN","LRAPRES",271,0)
RELEASE ; Release the report
"RTN","LRAPRES",272,0)
 N LRMSG
"RTN","LRAPRES",273,0)
 ;
"RTN","LRAPRES",274,0)
 ; Store REPORT RELEASE DATE/TIME and RELEASED BY
"RTN","LRAPRES",275,0)
 I 'LRAU D
"RTN","LRAPRES",276,0)
 . S LRRC=$$GET1^DIQ(LRSF,LRIENS,.1,"I")
"RTN","LRAPRES",277,0)
 . I LRCAPA D C^LRAPSWK
"RTN","LRAPRES",278,0)
 . S DR=".11////^S X=LRNTIME;.13////^S X=DUZ"
"RTN","LRAPRES",279,0)
 . S DIE="^LR(LRDFN,LRSS,",DA=LRI,DA(1)=LRDFN
"RTN","LRAPRES",280,0)
 . S LRA=^LR(LRDFN,LRSS,LRI,0) ; Set LRA for xref call to LRWOMEN
"RTN","LRAPRES",281,0)
 ;
"RTN","LRAPRES",282,0)
 ; Store AUTOPSY RELEASE DATE/TIME and AUTOPSY RELEASED BY
"RTN","LRAPRES",283,0)
 I LRAU D
"RTN","LRAPRES",284,0)
 . S DR="14.7////^S X=$S(LRZ(2):""@"",1:LRNTIME);"
"RTN","LRAPRES",285,0)
 . S DR=DR_"14.8////^S X=$S(LRZ(2):""@"",1:DUZ);"
"RTN","LRAPRES",286,0)
 . S DIE="^LR(",DA=LRDFN
"RTN","LRAPRES",287,0)
 ;
"RTN","LRAPRES",288,0)
 D CK^LRU
"RTN","LRAPRES",289,0)
 Q:$D(LR("CK"))
"RTN","LRAPRES",290,0)
 D ^DIE
"RTN","LRAPRES",291,0)
 ;
"RTN","LRAPRES",292,0)
 ; Update accession with completion status
"RTN","LRAPRES",293,0)
 D ACCCOMP
"RTN","LRAPRES",294,0)
 ;
"RTN","LRAPRES",295,0)
 ; Update clinical reminders
"RTN","LRAPRES",296,0)
 D UPDATE^LRPXRM(LRDFN,$G(LRSS,"AU"),$G(LRI))
"RTN","LRAPRES",297,0)
 ;
"RTN","LRAPRES",298,0)
 D FRE^LRU
"RTN","LRAPRES",299,0)
 S LRMSG="*** Report "
"RTN","LRAPRES",300,0)
 I LRZ(2),LRAU S LRMSG=LRMSG_"un"
"RTN","LRAPRES",301,0)
 S LRMSG=LRMSG_"released. ***"
"RTN","LRAPRES",302,0)
 D EN^DDIOL($$CJ^XLFSTR(LRMSG,IOM),"","!!")
"RTN","LRAPRES",303,0)
 ;
"RTN","LRAPRES",304,0)
 ; Record workload
"RTN","LRAPRES",305,0)
 I "CYSP"[LRSS,LRCAPA D WKLD
"RTN","LRAPRES",306,0)
 ;
"RTN","LRAPRES",307,0)
 ; Check if supported subscript, released and LEDI accession and send results back to submitting facility.
"RTN","LRAPRES",308,0)
 I LRSS?1(1"SP",1"CY",1"EM"),$$GET1^DIQ(LRSF,LRI_","_LRDFN_",",.11,"I") D LEDI^LRVR0
"RTN","LRAPRES",309,0)
 ;
"RTN","LRAPRES",310,0)
 ;I LRCAPA,"SPCYEM"[LRSS,LRD(1)'="","MBA"[LRD(1) D C1^LRAPSWK
"RTN","LRAPRES",311,0)
 Q
"RTN","LRAPRES",312,0)
 ;
"RTN","LRAPRES",313,0)
 ;
"RTN","LRAPRES",314,0)
STORE ; Store report in TIU
"RTN","LRAPRES",315,0)
 N LRTITLE,LRIENS,LRFILE,LRFDA,LRTIUPTR,LRMSG
"RTN","LRAPRES",316,0)
 I LRDPF=62.3!(LRDPF[67) D REFRRL^LRAPUTL Q
"RTN","LRAPRES",317,0)
 S:LRSS="SP" LRO68="SURGICAL PATHOLOGY"
"RTN","LRAPRES",318,0)
 S:LRSS="CY" LRO68="CYTOPATHOLOGY"
"RTN","LRAPRES",319,0)
 S:LRSS="EM" LRO68="ELECTRON MICROSCOPY"
"RTN","LRAPRES",320,0)
 S:LRSS="AU" LRO68="AUTOPSY"
"RTN","LRAPRES",321,0)
 D SETPARM^TIULE
"RTN","LRAPRES",322,0)
 S LRTITLE=$$DDEFIEN^TIUFLF7("LR "_LRO68_" REPORT","TL")
"RTN","LRAPRES",323,0)
 I 'LRTITLE D
"RTN","LRAPRES",324,0)
 . W $C(7)
"RTN","LRAPRES",325,0)
 . S LRMSG="No TIU title for this lab report.  Cannot release."
"RTN","LRAPRES",326,0)
 . D EN^DDIOL(LRMSG,"","!!") K LRMSG
"RTN","LRAPRES",327,0)
 . S LRQUIT=1
"RTN","LRAPRES",328,0)
 Q:LRQUIT
"RTN","LRAPRES",329,0)
 ; Set parameter to 1 for e-sig verification in TIU; if e-sig fails,
"RTN","LRAPRES",330,0)
 ;      TIU will abort creation of doc in ^TIU(8925, and return
"RTN","LRAPRES",331,0)
 ;      an error, tiufn=-1,-1.
"RTN","LRAPRES",332,0)
 D NEW^TIUPNAPI(.LRTIUPTR,DFN,DUZ,LRNTIME,LRTITLE,,,,DUZ,,1)
"RTN","LRAPRES",333,0)
 I LRTIUPTR="-1^-1" D  Q
"RTN","LRAPRES",334,0)
 .S LRMSG(1)="     *** Signature in TIU failed. ***"
"RTN","LRAPRES",335,0)
 .S LRMSG(2,"F")="!!!"
"RTN","LRAPRES",336,0)
 .S LRMSG(2)="Possible causes:"
"RTN","LRAPRES",337,0)
 .S LRMSG(3,"F")="!!"
"RTN","LRAPRES",338,0)
 .S LRMSG(3)="1. Report contains 3 sequential characters matching those defined"
"RTN","LRAPRES",339,0)
 .S LRMSG(4)="in the BLANK CHARACTER STRING field (#1.06), TIU PARAMETERS file (#8925.99)"
"RTN","LRAPRES",340,0)
 .S LRMSG(5)="which are "_$P(TIUPRM1,U,6)_"."
"RTN","LRAPRES",341,0)
 .S LRMSG(6,"F")="!!"
"RTN","LRAPRES",342,0)
 .S LRMSG(6)="To correct this situation use a data entry option to remove"
"RTN","LRAPRES",343,0)
 .S LRMSG(7)="these characters from this report."
"RTN","LRAPRES",344,0)
 .S LRMSG(8,"F")="!!"
"RTN","LRAPRES",345,0)
 .S LRMSG(8)="2.  There is some other TIU document setup problem."
"RTN","LRAPRES",346,0)
 .S LRMSG(9,"F")="!!"
"RTN","LRAPRES",347,0)
 .S LRMSG(9)="Report this situation to the Laboratory ADP Coordinator."
"RTN","LRAPRES",348,0)
 .S LRMSG(10)="     *** Report storage in TIU failed. ***"
"RTN","LRAPRES",349,0)
 .S LRMSG(10,"F")="!!!"
"RTN","LRAPRES",350,0)
 .D EN^DDIOL(.LRMSG,"","!!")
"RTN","LRAPRES",351,0)
 .S LRQUIT=1
"RTN","LRAPRES",352,0)
 I +LRTIUPTR=-1 D  Q
"RTN","LRAPRES",353,0)
 . S LRMSG="*** Report storage in TIU failed. ***"
"RTN","LRAPRES",354,0)
 . S LRMSG=$$CJ^XLFSTR(LRMSG,IOM)
"RTN","LRAPRES",355,0)
 . D EN^DDIOL(LRMSG,"","!!")
"RTN","LRAPRES",356,0)
 . S LRQUIT=1
"RTN","LRAPRES",357,0)
 S LRMSG="*** Report storage in TIU is complete. ***"
"RTN","LRAPRES",358,0)
 S LRMSG=$$CJ^XLFSTR(LRMSG,IOM)
"RTN","LRAPRES",359,0)
 D EN^DDIOL(LRMSG,"","!!")
"RTN","LRAPRES",360,0)
 ;CKA-Calculate checksum of TIU report text
"RTN","LRAPRES",361,0)
 D EXTRACT^TIULQ(+LRTIUPTR,"LRTIU",,,,1,,1)
"RTN","LRAPRES",362,0)
 S $P(LRTIU(+LRTIUPTR,"TEXT",0),U,5)=$P(LRTIU(+LRTIUPTR,1201,"I"),".")
"RTN","LRAPRES",363,0)
 S LRCHKSUM=$$CHKSUM^XUSESIG1("LRTIU("_+LRTIUPTR_",""TEXT"")")
"RTN","LRAPRES",364,0)
 K LRTIU
"RTN","LRAPRES",365,0)
 ;
"RTN","LRAPRES",366,0)
 ; Store pointer & checksum information in the LAB DATA (#63) file
"RTN","LRAPRES",367,0)
 S LRIENS="+1,"_$S('LRAU:LRI_",",1:"")_LRDFN_","
"RTN","LRAPRES",368,0)
 S LRFILE=$S(LRSS="SP":63.19,LRSS="CY":63.47,LRSS="EM":63.49,1:"")
"RTN","LRAPRES",369,0)
 S:LRFILE="" LRFILE=$S(LRSS="AU":63.101,1:"")
"RTN","LRAPRES",370,0)
 S LRFDA(1,LRFILE,LRIENS,.01)=LRNTIME
"RTN","LRAPRES",371,0)
 S LRFDA(1,LRFILE,LRIENS,1)=+LRTIUPTR
"RTN","LRAPRES",372,0)
 S LRFDA(1,LRFILE,LRIENS,2)=LRCHKSUM
"RTN","LRAPRES",373,0)
 D UPDATE^DIE("","LRFDA(1)")
"RTN","LRAPRES",374,0)
 D RETRACT^LRAPRES1(LRDFN,LRSS,LRI,+LRTIUPTR)
"RTN","LRAPRES",375,0)
 Q
"RTN","LRAPRES",376,0)
 ;
"RTN","LRAPRES",377,0)
 ;
"RTN","LRAPRES",378,0)
WKLD ; Capture workload
"RTN","LRAPRES",379,0)
 N ERR,FILE,FILE1,IENS,IENS1,LRIEN,LRFDA,LROUT,RNUM
"RTN","LRAPRES",380,0)
 S LRK=$P(^LR(LRDFN,LRSS,LRI,0),"^",11) Q:'LRK
"RTN","LRAPRES",381,0)
 Q:$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0))
"RTN","LRAPRES",382,0)
 S RNUM=1,IENS="+"_RNUM_","_LRAN_","_LRAD_","_LRAA_","
"RTN","LRAPRES",383,0)
 S FILE=68.04,LRIEN(1)=LRT
"RTN","LRAPRES",384,0)
 S LRFDA(1,FILE,IENS,.01)=LRT
"RTN","LRAPRES",385,0)
 S LRFDA(1,FILE,IENS,1)=50
"RTN","LRAPRES",386,0)
 S LRFDA(1,FILE,IENS,3)=DUZ
"RTN","LRAPRES",387,0)
 S LRFDA(1,FILE,IENS,4)=LRK
"RTN","LRAPRES",388,0)
 S C=0,FILE1=68.14
"RTN","LRAPRES",389,0)
 F  S C=$O(LRT(C)) Q:'C  D
"RTN","LRAPRES",390,0)
 . S RNUM=RNUM+1,LRIEN(RNUM)=C
"RTN","LRAPRES",391,0)
 . S IENS1="+"_RNUM_","_IENS
"RTN","LRAPRES",392,0)
 . S LRFDA(1,FILE1,IENS1,.01)=C
"RTN","LRAPRES",393,0)
 . S LRFDA(1,FILE1,IENS1,.02)=1
"RTN","LRAPRES",394,0)
 . S LRFDA(1,FILE1,IENS1,.03)=0
"RTN","LRAPRES",395,0)
 . S LRFDA(1,FILE1,IENS1,.04)=0
"RTN","LRAPRES",396,0)
 . S LRFDA(1,FILE1,IENS1,1)=LRK
"RTN","LRAPRES",397,0)
 . S LRFDA(1,FILE1,IENS1,2)=DUZ
"RTN","LRAPRES",398,0)
 . S LRFDA(1,FILE1,IENS1,3)=DUZ(2)
"RTN","LRAPRES",399,0)
 . S LRFDA(1,FILE1,IENS1,4)=LRAA
"RTN","LRAPRES",400,0)
 . S LRFDA(1,FILE1,IENS1,5)=LRAA
"RTN","LRAPRES",401,0)
 . S LRFDA(1,FILE1,IENS1,6)=LRAA
"RTN","LRAPRES",402,0)
 D UPDATE^DIE("","LRFDA(1)","LRIEN","LROUT")
"RTN","LRAPRES",403,0)
 Q
"RTN","LRAPRES",404,0)
 ;
"RTN","LRAPRES",405,0)
 ;
"RTN","LRAPRES",406,0)
ACCCOMP ; Complete tests on accession
"RTN","LRAPRES",407,0)
 ;
"RTN","LRAPRES",408,0)
 N LRERR,LRFDA,LRFILE,LRIENS,LRK,LRORDT,LRSN,LRSRDT,LRT,LRX
"RTN","LRAPRES",409,0)
 ;
"RTN","LRAPRES",410,0)
 ;ZEXCEPT: LRAA,LRAD,LRAN,LRDFN,LRDUZ,LRI,LRSS
"RTN","LRAPRES",411,0)
 ;
"RTN","LRAPRES",412,0)
 ; Retrieve d/t released
"RTN","LRAPRES",413,0)
 I LRSS="AU" S LRK=$P(^LR(LRDFN,LRSS),"^",15)
"RTN","LRAPRES",414,0)
 E  S LRK=$P(^LR(LRDFN,LRSS,LRI,0),"^",11)
"RTN","LRAPRES",415,0)
 I LRK="" Q
"RTN","LRAPRES",416,0)
 ;
"RTN","LRAPRES",417,0)
 ; Lab Arrival d/t
"RTN","LRAPRES",418,0)
 I LRSS="AU" S LRSRDT=$P(^LR(LRDFN,LRSS),"^",1)
"RTN","LRAPRES",419,0)
 E  S LRSRDT=$P(^LR(LRDFN,LRSS,LRI,0),"^",10)
"RTN","LRAPRES",420,0)
 ;
"RTN","LRAPRES",421,0)
 ; Don't update workload tests (urgency>49)
"RTN","LRAPRES",422,0)
 S LRT=0,LRFILE=68.04
"RTN","LRAPRES",423,0)
 F  S LRT=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT)) Q:LRT<.5  D
"RTN","LRAPRES",424,0)
 . I $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRT,0),"^",2)>49 Q
"RTN","LRAPRES",425,0)
 . K LRIENS,LRFDA,LRERR(1)
"RTN","LRAPRES",426,0)
 . S LRIENS=LRT_","_LRAN_","_LRAD_","_LRAA_","
"RTN","LRAPRES",427,0)
 . S LRFDA(1,LRFILE,LRIENS,3)=$S($G(LRDUZ):LRDUZ,$G(DUZ):DUZ,1:"")
"RTN","LRAPRES",428,0)
 . S LRFDA(1,LRFILE,LRIENS,4)=LRK
"RTN","LRAPRES",429,0)
 . D UPDATE^DIE("","LRFDA(1)","","LRERR(1)")
"RTN","LRAPRES",430,0)
 ;
"RTN","LRAPRES",431,0)
 ; Update order with release date/time if available.
"RTN","LRAPRES",432,0)
 ;  - check for lab arrival time and update if missing
"RTN","LRAPRES",433,0)
 S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
"RTN","LRAPRES",434,0)
 S LRORDT=$P(LRX,"^",4),LRSN=$P(LRX,"^",5)
"RTN","LRAPRES",435,0)
 I LRORDT>0,LRSN>0,$D(^LRO(69,LRORDT,1,LRSN,0)) D
"RTN","LRAPRES",436,0)
 . K LRFILE,LRIENS
"RTN","LRAPRES",437,0)
 . S LRIENS=LRSN_","_LRORDT_",",LRFILE=69.01
"RTN","LRAPRES",438,0)
 . I $P($G(^LRO(69,LRORDT,1,LRSN,3)),"^")="",LRSRDT S LRFDA(2,LRFILE,LRIENS,20)=LRSRDT
"RTN","LRAPRES",439,0)
 . S LRFDA(2,LRFILE,LRIENS,21)=LRK
"RTN","LRAPRES",440,0)
 . D UPDATE^DIE("","LRFDA(2)","","LRERR(2)")
"RTN","LRAPRES",441,0)
 ;
"RTN","LRAPRES",442,0)
 Q
"RTN","LRAPRES",443,0)
 ;
"RTN","LRAPRES",444,0)
 ;
"RTN","LRAPRES",445,0)
END ; Clean-up variables and quit
"RTN","LRAPRES",446,0)
 K LRAD1,LRDATA,LRAU,LRRDTE,LRTEXT,LRSEL,LRFILE,LRIENS,LRIENS1
"RTN","LRAPRES",447,0)
 K LRFDA,ERR,IENS,LROUT,LRIEN,LRTMP
"RTN","LRAPRES",448,0)
 K ^TMP("LRAPBR",$J),^TMP("TIUP",$J)
"RTN","LRAPRES",449,0)
 D:$T(CLEAN^LRCAPES)'="" CLEAN^LRCAPES
"RTN","LRAPRES",450,0)
 D V^LRU
"RTN","LRAPRES",451,0)
 Q
"RTN","LRLIST")
0^12^B49008370
"RTN","LRLIST",1,0)
LRLIST ;DALOI/STAFF - LAB RESULTS LIST ;05/06/13
"RTN","LRLIST",2,0)
 ;;5.2;LAB SERVICE;**44,86,153,201,427**;Sep 27, 1994;Build 33
"RTN","LRLIST",3,0)
 ;
"RTN","LRLIST",4,0)
 ;
"RTN","LRLIST",5,0)
 W !,"Summary List (Supervisors')  >>> NOT FOR WARD USE <<<",!
"RTN","LRLIST",6,0)
 ;
"RTN","LRLIST",7,0)
EN K ^TMP("LR",$J),LRAA
"RTN","LRLIST",8,0)
 D DATE^LRWU G END:Y<1 S LRAD=Y,DIC="^LRO(68,",DIC(0)="AEQ",LRNL=0
"RTN","LRLIST",9,0)
 S LRRDT=$$FMTE^XLFDT(Y,1)
"RTN","LRLIST",10,0)
 F  D ^DIC Q:Y<1  D CHKDAT^LRLSTWRL Q:Y<1  S DIC("A")="ANOTHER ONE: ",LRNL=LRNL+1,LRAA(LRNL)=+Y,LRAA(LRNL,1)=$P(Y,U,2),LRSS(LRNL)=$P(^LRO(68,LRAA(LRNL),0),U,2)
"RTN","LRLIST",11,0)
 K DIC G EN:$G(LRNL)<1
"RTN","LRLIST",12,0)
 S LRDATE=-1
"RTN","LRLIST",13,0)
 I $P(^LRO(68,LRAA(1),0),U,2)="MI" S %DT("A")="Report date approved to display: " D DATE^LRWU G END:$G(LREND) S LRDATE=Y
"RTN","LRLIST",14,0)
 ;
"RTN","LRLIST",15,0)
C K DIRUT,DIR S DIR("A")="List By",DIR(0)="S^1:ACCESSION NUMBER;2:PATIENT"
"RTN","LRLIST",16,0)
 D ^DIR G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT)) END
"RTN","LRLIST",17,0)
 S LRX=Y
"RTN","LRLIST",18,0)
 D RANGE G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT)) C
"RTN","LRLIST",19,0)
 ;
"RTN","LRLIST",20,0)
INST K DIR S DIR(0)="PO^4:AQENM",DIR("A")="Optional -  Select Collecting Institution "
"RTN","LRLIST",21,0)
 F  D ^DIR Q:Y=""!($E(Y=U))!(Y<1)  S:Y LRINST=+Y,LRINST(LRINST)="",DIR("A")="Select Another Collecting Institution "
"RTN","LRLIST",22,0)
 K DIR,DIRUT G:$E(Y)=U END
"RTN","LRLIST",23,0)
 ;
"RTN","LRLIST",24,0)
ALL W !!?5,"Do you wish to see all tests including Common Accessions " S %=1 D YN^DICN G:%=0 ALL G:%<1 END S:%=1 LRALL=""
"RTN","LRLIST",25,0)
 S %ZIS="MQ" D ^%ZIS G END:POP
"RTN","LRLIST",26,0)
 I $D(IO("Q")) S ZTRTN="DQ^LRLIST",ZTIO=ION,ZTDESC="Summary List (Supervisors')",ZTSAVE("LR*")="" D ^%ZTLOAD G END
"RTN","LRLIST",27,0)
 ;
"RTN","LRLIST",28,0)
C2 ;
"RTN","LRLIST",29,0)
 S $P(LREQ,"=",IOM)="",S=1 K DX S DX(0)="Q"
"RTN","LRLIST",30,0)
 I $E(IOST,1,2)="C-" S DX(0)="S S=$Y I S>(IOSL-8) N X,Y K DIR S DIR(0)=""E"" D ^DIR K DIR S S=$S($D(DIRUT):0,1:1) Q:$D(DIRUT)  W @IOF D HDR^LRLIST S S=$S($D(DIRUT):0,1:1)"
"RTN","LRLIST",31,0)
 I IOST?1"P".E S DX(0)="S S=$Y I S>(IOSL-8) W @IOF D HDR^LRLIST S S=$Y"
"RTN","LRLIST",32,0)
 U IO D HDR G L10:LRX=1,L20:LRX=2,END
"RTN","LRLIST",33,0)
 ;
"RTN","LRLIST",34,0)
L10 ;
"RTN","LRLIST",35,0)
 I $D(LRALL) F LRAA=1:1:LRNL F LRL=LRFAN-1:0 S LRL=$O(^LRO(68,LRAA(LRAA),1,LRAD,1,LRL)) Q:(LRL>LRLAN)!(LRL<LRFAN)!(S=0)  S ^TMP("LR",$J,LRL,LRAA)=""
"RTN","LRLIST",36,0)
 I '$D(LRALL) F LRAA=1:1:LRNL S LRL=LRFAN-1 F  S LRL=$O(^LRO(68,LRAA(LRAA),1,LRAD,1,LRL)) Q:(LRL>LRLAN)!(LRL<LRFAN)  I $O(^(LRL,4,0)) S ^TMP("LR",$J,LRL,LRAA)=""
"RTN","LRLIST",37,0)
 F LRAN=0:0 S LRAN=$O(^TMP("LR",$J,LRAN)) Q:LRAN<1!($D(DIRUT))!($D(DUOUT))!($D(DUOUT))  F LRAA=0:0 S LRAA=$O(^TMP("LR",$J,LRAN,LRAA)) Q:LRAA<1  D PR Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
"RTN","LRLIST",38,0)
 W !! G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT)) END
"RTN","LRLIST",39,0)
 W "END OF REPORT",! G END
"RTN","LRLIST",40,0)
 ;
"RTN","LRLIST",41,0)
 ;
"RTN","LRLIST",42,0)
L20 ;
"RTN","LRLIST",43,0)
 F LRAA=1:1:LRNL D L22 Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!(S=0)
"RTN","LRLIST",44,0)
 S LRPNM=""
"RTN","LRLIST",45,0)
 F  S LRPNM=$O(^TMP("LR",$J,LRPNM)) Q:LRPNM=""!($D(DTOUT))!($D(DUOUT))!($D(DIRUT))  S PNM=$P(LRPNM,U),SSN=$P(LRPNM,U,2) D L26
"RTN","LRLIST",46,0)
 W !! G:$D(DTOUT)!($D(DUOUT))!($D(DIRUT)) END
"RTN","LRLIST",47,0)
 W !,"END OF REPORT",! G END
"RTN","LRLIST",48,0)
 ;
"RTN","LRLIST",49,0)
 ;
"RTN","LRLIST",50,0)
L22 ;
"RTN","LRLIST",51,0)
 F LRAN=LRFAN-1:0 S LRAN=$O(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN)) Q:LRAN<1!(LRAN>LRLAN)!($D(DTOUT))!($D(DUOUT))!($D(DIRUT))!(S=0)  D L23
"RTN","LRLIST",52,0)
 Q
"RTN","LRLIST",53,0)
 ;
"RTN","LRLIST",54,0)
 ;
"RTN","LRLIST",55,0)
L23 ;
"RTN","LRLIST",56,0)
 I '$D(LRALL),'$O(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,4,0)) Q
"RTN","LRLIST",57,0)
 I $G(LRINST),'$D(LRINST(+$P($G(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,.3)),U,3))) Q
"RTN","LRLIST",58,0)
 Q:'$D(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,0))  Q:'$D(^(3))  S LRDFN=+^(0),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D DEM^LRX S:$L(PNM) ^TMP("LR",$J,PNM_U_SSN,LRAA,LRAN)=DOB Q
"RTN","LRLIST",59,0)
 ;
"RTN","LRLIST",60,0)
 ;
"RTN","LRLIST",61,0)
L26 ;
"RTN","LRLIST",62,0)
 F LRAA=0:0 S LRAA=$O(^TMP("LR",$J,LRPNM,LRAA)) Q:LRAA<1!($D(DTOUT))!($D(DUOUT))!($D(DIRUT))!(S=0)  D L28
"RTN","LRLIST",63,0)
 Q
"RTN","LRLIST",64,0)
 ;
"RTN","LRLIST",65,0)
 ;
"RTN","LRLIST",66,0)
L28 ;
"RTN","LRLIST",67,0)
 F LRAN=0:0 S LRAN=$O(^TMP("LR",$J,LRPNM,LRAA,LRAN)) Q:LRAN<1!($D(DTOUT))!($D(DUOUT))!($D(DIRUT))!(S=0)  D PR
"RTN","LRLIST",68,0)
 Q
"RTN","LRLIST",69,0)
 ;
"RTN","LRLIST",70,0)
 ;
"RTN","LRLIST",71,0)
PR ;
"RTN","LRLIST",72,0)
 I '$D(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,0)) W !!?10," Accession ",LRAN," deleted ",!!,$C(7) Q
"RTN","LRLIST",73,0)
 I $G(LRINST),'$D(LRINST(+$P($G(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,.3)),U,3))) Q
"RTN","LRLIST",74,0)
 Q:'$D(^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,3))
"RTN","LRLIST",75,0)
 S LRIDT=9999999-^(3),LRDFN=+^LRO(68,LRAA(LRAA),1,LRAD,1,LRAN,0),LRINT=$P(^(0),U,5),LRODT=$P(^(0),U,4) G PR1:LRDATE<1
"RTN","LRLIST",76,0)
 S LRSET=0
"RTN","LRLIST",77,0)
 F I=1,5,8,11,16 I $D(^LR(LRDFN,"MI",LRIDT,I)),((+^(I))\1)=LRDATE S LRSET=1 Q
"RTN","LRLIST",78,0)
 Q:'LRSET
"RTN","LRLIST",79,0)
 ;
"RTN","LRLIST",80,0)
PR1 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D DEM^LRX
"RTN","LRLIST",81,0)
 ;I $E(IOST,1,2)="C-",$Y>(IOSL-8) N X,Y K DIR S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT)!($D(DUOUT))!($D(DTOUT))!(S=0)  W @IOF D HDR S S=$Y
"RTN","LRLIST",82,0)
 ;I IOST?1"P".E&($Y>(IOSL-6)) W @IOF D HDR ;ONLY FOR USE ON A PRINTER
"RTN","LRLIST",83,0)
 X DX(0) Q:S=0
"RTN","LRLIST",84,0)
 ;
"RTN","LRLIST",85,0)
 D DASH^LRX
"RTN","LRLIST",86,0)
 W !!,PNM,?40,SSN,!,LRAA(LRAA,1)," ACC:  ",$S($D(^LRO(68,+LRAA(LRAA),1,LRAD,1,LRAN,.2)):^(.2),1:"no acc")
"RTN","LRLIST",87,0)
 W ?45,$S($D(^LRO(68,+LRAA(LRAA),1,LRAD,1,LRAN,.1)):"  ORDER #: "_^(.1),1:"")
"RTN","LRLIST",88,0)
 I LRINT D
"RTN","LRLIST",89,0)
 . N LRX
"RTN","LRLIST",90,0)
 . S LRX=$P($G(^LRO(69,LRODT,1,LRINT,0)),U,2)
"RTN","LRLIST",91,0)
 . I LRX S LRX=$$NAME^XUSER(LRX,"F") W !,"Person placing order: ",LRX
"RTN","LRLIST",92,0)
 ;
"RTN","LRLIST",93,0)
 I $D(^LRO(68,+LRAA(LRAA),1,LRAD,1,LRAN,4)) D
"RTN","LRLIST",94,0)
 . N LRX
"RTN","LRLIST",95,0)
 . S LRIN=+$O(^(4,"B",0))
"RTN","LRLIST",96,0)
 . I LRIN,$D(^LRO(68,+LRAA(LRAA),1,LRAD,1,LRAN,4,LRIN)) D
"RTN","LRLIST",97,0)
 . . S LRIN=$P($G(^LRO(68,+LRAA(LRAA),1,LRAD,1,LRAN,4,LRIN,0)),U,4)
"RTN","LRLIST",98,0)
 . . I LRIN<1 Q
"RTN","LRLIST",99,0)
 . . S LRX=$$NAME^XUSER(LRIN,"F")
"RTN","LRLIST",100,0)
 . . I LRX'="" W "   Person performing test: ",$E(LRX,1,(IOM-($X+1)))
"RTN","LRLIST",101,0)
 X DX(0) Q:S=0
"RTN","LRLIST",102,0)
 ;
"RTN","LRLIST",103,0)
 I '$D(LRSS(+$G(LRAA))) W !," ACCESSION #: ",LRAN," HAS AN ERROR NOTIFY SYSTEM MANAGER >>> ",!! Q
"RTN","LRLIST",104,0)
 IF '$D(^LR(LRDFN,LRSS(LRAA),LRIDT,0)) W !," ACCESSION #: ",LRAN,"  >>>>ERROR PLEASE NOTIFY SYSTEM MANAGER<<<<<",! Q
"RTN","LRLIST",105,0)
 ;
"RTN","LRLIST",106,0)
 W ! S DIC="^LR("_LRDFN_","""_LRSS(LRAA)_""",",DR="0"_$S(LRLONG:":99999999",1:""),DA=LRIDT
"RTN","LRLIST",107,0)
 X DX(0) Q:S=0  D EN^LRDIQ Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!(S=0)
"RTN","LRLIST",108,0)
 I $G(LRLONG)=2 F DR="ORU","ORUT" Q:S=0  X DX(0) Q:S=0  D EN^LRDIQ Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!(S=0)
"RTN","LRLIST",109,0)
 Q
"RTN","LRLIST",110,0)
 ;
"RTN","LRLIST",111,0)
 ;
"RTN","LRLIST",112,0)
TOF Q:S=0  X DX(0)
"RTN","LRLIST",113,0)
 ;S S=$Y I $E(IOST,1,2)="P-",$Y>(IOSL-6) W @IOF D HDR S S=$Y Q
"RTN","LRLIST",114,0)
 ;I $E(IOST,1,2)="C-",$Y>(IOSL-8) N X,Y S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT)!($D(DUOUT))!($D(DTOUT))!(S=0)  W @IOF D HDR S S=$Y
"RTN","LRLIST",115,0)
 Q
"RTN","LRLIST",116,0)
 ;
"RTN","LRLIST",117,0)
 ;
"RTN","LRLIST",118,0)
END ;
"RTN","LRLIST",119,0)
 W ! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC
"RTN","LRLIST",120,0)
 K DIC,D1,DIR,A,AGE,DFN,DOB,DR,LRAN,LRINST,S,SEX,T,ZZ,ZZY
"RTN","LRLIST",121,0)
 K LRNG1,LRNG11,LRNG12,LRNG2,LRNG3,LRNG4,LRNG5
"RTN","LRLIST",122,0)
 K DTOUT,DUOUT,DIRUT,LR,LRDFN,LRDPF,LRIDT,LRODT,LRPRAC,LRRB,LRTREA,LRWRD,PNM
"RTN","LRLIST",123,0)
 K SSN,VA,LREQ
"RTN","LRLIST",124,0)
 K ^TMP("LR",$J),LRPNM,LRDATE,LRLONG,ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK,%H
"RTN","LRLIST",125,0)
 K C1,D0,DA,DICS,DL,DSC,DX,LRL,LAST,LRAA,LRAD,LRALL,LRDX,LREDT,LREND,LRFAN
"RTN","LRLIST",126,0)
 K LRIN,LRINT,LRLAN,LRLINE,LRNL,LRSET,LRSS,LRWDTL,LRRDT,LRRPG,LRX,POP,IO("Q")
"RTN","LRLIST",127,0)
 D KVAR^VADPT
"RTN","LRLIST",128,0)
 Q
"RTN","LRLIST",129,0)
 ;
"RTN","LRLIST",130,0)
 ;
"RTN","LRLIST",131,0)
HDR ;
"RTN","LRLIST",132,0)
 I $G(LRDBUG),$S($D(DTOUT):1,$D(DUOUT):1,$D(DIRUT):1,S=0:1,1:0) W !,"88888"
"RTN","LRLIST",133,0)
 Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))!(S=0) 
"RTN","LRLIST",134,0)
 I '$G(LRRPG) S LRRPG=1 W:$E(IOST,1,2)="C-" @IOF
"RTN","LRLIST",135,0)
 ;
"RTN","LRLIST",136,0)
HD1 ;
"RTN","LRLIST",137,0)
 W "SUMMARY LIST (SUPERVISORS') FOR DATE: ",LRRDT,?(IOM-12),"PAGE: ",LRRPG,!
"RTN","LRLIST",138,0)
 W "     >> NOT FOR WARD USE <<" W:$L(LRRDT)=4 ?40,"Report for date: ",$$FMTE^XLFDT($S(LRDATE>0:LRDATE,1:$$DT^XLFDT),"D")
"RTN","LRLIST",139,0)
 W !,"ACCESSION AREA(S): " F ZZ=1:1:LRNL W LRAA(ZZ,1),"   "
"RTN","LRLIST",140,0)
 I $O(LRINST(0)) W !,"Collecting Site(s) " S ZZ=0 F  S ZZ=$O(LRINST(ZZ)) Q:ZZ=""  W $P(^DIC(4,ZZ,0),U)," / "
"RTN","LRLIST",141,0)
 W !,LREQ S S=$Y
"RTN","LRLIST",142,0)
 S LRRPG=LRRPG+1
"RTN","LRLIST",143,0)
 Q
"RTN","LRLIST",144,0)
 ;
"RTN","LRLIST",145,0)
 ;
"RTN","LRLIST",146,0)
RANGE ;
"RTN","LRLIST",147,0)
 K DIR,DIRUT S DIR("B")="S",DIR(0)="S^L:LONG;S:SHORT;E:EXTENDED",LRLONG=0
"RTN","LRLIST",148,0)
 S DIR("?")="Long listing shows verified results where short list does not."
"RTN","LRLIST",149,0)
 S DIR("?",1)="Extended provides demographics results and normal ranges."
"RTN","LRLIST",150,0)
 D ^DIR K DIR
"RTN","LRLIST",151,0)
 Q:$D(DTOUT)!($D(DUOUT))!($D(DIRUT))
"RTN","LRLIST",152,0)
 S LRLONG=$S(Y["L":1,Y["E":2,1:0)
"RTN","LRLIST",153,0)
 D LRAN^LRWU3 Q
"RTN","LRLIST",154,0)
 ;
"RTN","LRLIST",155,0)
 ;
"RTN","LRLIST",156,0)
TST S LRAA(1)=42,LRAA(1,1)="CHEMISTRY",LRNL=1,LRALL="",LRSS(1)="CH"
"RTN","LRLIST",157,0)
 ;LRAD=DATE TO SCAN,LRRDT=DATE PRINT FORMAT,LRFAN=STARTING NUMBER
"RTN","LRLIST",158,0)
 ;LRX=REPORT SORT,LRLAN=LAST ACCESSION #
"RTN","LRLIST",159,0)
DQ U IO S:$D(ZTQUEUED) ZTREQ="@"
"RTN","LRLIST",160,0)
 S:'$D(LRLONG) LRLONG=1
"RTN","LRLIST",161,0)
 I '$G(LRAD) S X="T-1",%DT="X" D ^%DT S LRAD=Y
"RTN","LRLIST",162,0)
 I '$L($G(LRRDT)) S LRRDT=$$FMTE^XLFDT(LRAD,1)
"RTN","LRLIST",163,0)
 S:'$G(LRX) LRX=2 S:'$D(LRFAN) LRFAN=1
"RTN","LRLIST",164,0)
 S:'$G(LRLAN) LRLAN=30
"RTN","LRLIST",165,0)
 S:'$G(LRDATE) LRDATE=-1
"RTN","LRLIST",166,0)
 G C2
"RTN","LRMIEDZ2")
0^29^B69802337
"RTN","LRMIEDZ2",1,0)
LRMIEDZ2 ;DALIO/JMC - MICROBIOLOGY EDIT ROUTINE ;02/27/13  03:32
"RTN","LRMIEDZ2",2,0)
 ;;5.2;LAB SERVICE;**23,104,242,295,350,427**;Sep 27, 1994;Build 33
"RTN","LRMIEDZ2",3,0)
 ;
"RTN","LRMIEDZ2",4,0)
 ; from LRFAST,LRMIEDZ,LRVER
"RTN","LRMIEDZ2",5,0)
 ;
"RTN","LRMIEDZ2",6,0)
 ; Reference to ^DIE global supported by ICR #5002
"RTN","LRMIEDZ2",7,0)
 ;
"RTN","LRMIEDZ2",8,0)
PAT ;
"RTN","LRMIEDZ2",9,0)
 N LRUID
"RTN","LRMIEDZ2",10,0)
 ;
"RTN","LRMIEDZ2",11,0)
 I '$D(LRAN) S LRAN=""
"RTN","LRMIEDZ2",12,0)
 F  S:LRAN="" LRAN=$$ACCPRMPT(LRAA,LRAD) Q:LRAN<0  D
"RTN","LRMIEDZ2",13,0)
 . I +LRAN=0 D  Q
"RTN","LRMIEDZ2",14,0)
 . . D QUES
"RTN","LRMIEDZ2",15,0)
 . . S LRAN=""
"RTN","LRMIEDZ2",16,0)
 . ;
"RTN","LRMIEDZ2",17,0)
 . S LRANOK=1
"RTN","LRMIEDZ2",18,0)
 . S LRCAPOK=1
"RTN","LRMIEDZ2",19,0)
 . D PAT1
"RTN","LRMIEDZ2",20,0)
 . L -^LR(LRDFN,"MI",LRIDT)
"RTN","LRMIEDZ2",21,0)
 . D LEDI^LRVR0
"RTN","LRMIEDZ2",22,0)
 . K LRTS
"RTN","LRMIEDZ2",23,0)
 . I LRCAPOK&($P(LRPARAM,U,14)) D ^LRCAPV1
"RTN","LRMIEDZ2",24,0)
 . S LRAN=""
"RTN","LRMIEDZ2",25,0)
 ;
"RTN","LRMIEDZ2",26,0)
 ;
"RTN","LRMIEDZ2",27,0)
 Q
"RTN","LRMIEDZ2",28,0)
 ;
"RTN","LRMIEDZ2",29,0)
 ;
"RTN","LRMIEDZ2",30,0)
ACCPRMPT(LRAA,LRAD) ;Prompt for accession number or UID
"RTN","LRMIEDZ2",31,0)
 ;
"RTN","LRMIEDZ2",32,0)
 ; Call with LRAA = Accession Area
"RTN","LRMIEDZ2",33,0)
 ;           LRAD = Accession Date
"RTN","LRMIEDZ2",34,0)
 ; 
"RTN","LRMIEDZ2",35,0)
 ; Accession number/UID entered must have the same accession
"RTN","LRMIEDZ2",36,0)
 ; area and date as LRAA and LRAD
"RTN","LRMIEDZ2",37,0)
 ; 
"RTN","LRMIEDZ2",38,0)
 ;   Returns LRAN = 0  (not valid input)
"RTN","LRMIEDZ2",39,0)
 ;                = -1 (user wants to exit - they entered up-arrow, pressed the Enter/Return key, or timed out)
"RTN","LRMIEDZ2",40,0)
 ;                = >0 (valid accession number)
"RTN","LRMIEDZ2",41,0)
 ;
"RTN","LRMIEDZ2",42,0)
 N DIR,DIRUT,DTOUT,DUOUT,LRAN,LRANOK,LRX,LRY,X,Y
"RTN","LRMIEDZ2",43,0)
 ;
"RTN","LRMIEDZ2",44,0)
 S LRAN=0
"RTN","LRMIEDZ2",45,0)
 ;
"RTN","LRMIEDZ2",46,0)
 W !!
"RTN","LRMIEDZ2",47,0)
 ;
"RTN","LRMIEDZ2",48,0)
 S DIR(0)="FO^1:30",DIR("A")="Select MICROBIOLOGY Accession or UID"
"RTN","LRMIEDZ2",49,0)
 S DIR("?")="^D QUES^LRMIEDZ2"
"RTN","LRMIEDZ2",50,0)
 D ^DIR
"RTN","LRMIEDZ2",51,0)
 I Y=""!$D(DIRUT) Q -1
"RTN","LRMIEDZ2",52,0)
 S LRX=Y
"RTN","LRMIEDZ2",53,0)
 ;
"RTN","LRMIEDZ2",54,0)
 S:$L(LRX)>2 ^DISV(DUZ,"LRACC")=LRX
"RTN","LRMIEDZ2",55,0)
 S:LRX=" " LRX=$S($D(^DISV(DUZ,"LRACC")):^("LRACC"),1:"?")
"RTN","LRMIEDZ2",56,0)
 ;
"RTN","LRMIEDZ2",57,0)
 I $D(^LRO(68,"C",LRX)) D  Q LRAN
"RTN","LRMIEDZ2",58,0)
 . S LRY=$$CHECKUID^LRWU4(LRX,"MI")
"RTN","LRMIEDZ2",59,0)
 . I 'LRY Q
"RTN","LRMIEDZ2",60,0)
 . I $P(LRY,U,2)'=LRAA!($P(LRY,U,3)'=LRAD) Q
"RTN","LRMIEDZ2",61,0)
 . S LRAN=$P(LRY,U,4)
"RTN","LRMIEDZ2",62,0)
 . W " (",$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),"^"),")"
"RTN","LRMIEDZ2",63,0)
 ;
"RTN","LRMIEDZ2",64,0)
 S LRANOK=1
"RTN","LRMIEDZ2",65,0)
 S X=LRX
"RTN","LRMIEDZ2",66,0)
 D LRANX^LRMIU4
"RTN","LRMIEDZ2",67,0)
 I 'LRANOK S LRAN=0
"RTN","LRMIEDZ2",68,0)
 ;
"RTN","LRMIEDZ2",69,0)
 Q LRAN
"RTN","LRMIEDZ2",70,0)
 ;
"RTN","LRMIEDZ2",71,0)
 ;
"RTN","LRMIEDZ2",72,0)
QUES ;
"RTN","LRMIEDZ2",73,0)
 ;
"RTN","LRMIEDZ2",74,0)
 W $C(7),!,"Enter the accession number or the unique identifier (UID)."
"RTN","LRMIEDZ2",75,0)
 W !,"If entering the accession number, enter just the number portion."
"RTN","LRMIEDZ2",76,0)
 W !,?5," e.g., if the accession is MICRO 13 30173, enter 30173."
"RTN","LRMIEDZ2",77,0)
 W !,?5," Only accessions from subscript MI are selectable."
"RTN","LRMIEDZ2",78,0)
 W !,"If entering the UID, enter the entire 10-15 characters."
"RTN","LRMIEDZ2",79,0)
 W !
"RTN","LRMIEDZ2",80,0)
 W !,"The accession number/UID entered must have the same accession"
"RTN","LRMIEDZ2",81,0)
 W !,"area and date as the first accession entered."
"RTN","LRMIEDZ2",82,0)
 ;
"RTN","LRMIEDZ2",83,0)
 Q
"RTN","LRMIEDZ2",84,0)
 ;
"RTN","LRMIEDZ2",85,0)
 ;
"RTN","LRMIEDZ2",86,0)
PAT1 ; Called from above and LRFAST
"RTN","LRMIEDZ2",87,0)
 ;
"RTN","LRMIEDZ2",88,0)
 ; Set LRANOK if called from LRFAST and not set
"RTN","LRMIEDZ2",89,0)
 I $G(LRANOK)="" N LRANOK S LRANOK=1
"RTN","LRMIEDZ2",90,0)
 ;
"RTN","LRMIEDZ2",91,0)
 S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
"RTN","LRMIEDZ2",92,0)
 S LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^")
"RTN","LRMIEDZ2",93,0)
 S LRIDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",5),LRCDT=+^(3),LREAL=$P(^(3),U,2),LRI=+$O(^(5,0)),LRSPEC=$S($D(^(LRI,0)):+^(0),1:"")
"RTN","LRMIEDZ2",94,0)
 ;
"RTN","LRMIEDZ2",95,0)
 I '$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) D  Q
"RTN","LRMIEDZ2",96,0)
 . W !,"No tests associated with this accession" S LRANOK=0
"RTN","LRMIEDZ2",97,0)
 . Q:$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))," ")=$P(^LRO(68,LRAA,0),U,11)
"RTN","LRMIEDZ2",98,0)
 . W !,"Verify with accession #: ",$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))
"RTN","LRMIEDZ2",99,0)
 ;
"RTN","LRMIEDZ2",100,0)
 ; Insure DILOCKTM is defined
"RTN","LRMIEDZ2",101,0)
 I $G(DILOCKTM)="" D
"RTN","LRMIEDZ2",102,0)
 . N DIQUIET
"RTN","LRMIEDZ2",103,0)
 . S DIQUIET=1 D DT^DICRW
"RTN","LRMIEDZ2",104,0)
 ;
"RTN","LRMIEDZ2",105,0)
 L +^LR(LRDFN,"MI",LRIDT):DILOCKTM
"RTN","LRMIEDZ2",106,0)
 I '$T W !!?10,"Someone else is editing this accession ",!,$C(7) S LRANOK=0 Q
"RTN","LRMIEDZ2",107,0)
 I '$D(^LR(LRDFN,"MI",LRIDT,0)) D BB S (LRCAPOK,LRANOK)=0 Q
"RTN","LRMIEDZ2",108,0)
 S (LRBG0,Y(0))=^LR(LRDFN,"MI",LRIDT,0)
"RTN","LRMIEDZ2",109,0)
 ;
"RTN","LRMIEDZ2",110,0)
 D PATINFO
"RTN","LRMIEDZ2",111,0)
 ;
"RTN","LRMIEDZ2",112,0)
 I $$GET^XPAR("USR^DIV^PKG","LR MI VERIFY DISPLAY PROVIDER",1,"Q") D PROV
"RTN","LRMIEDZ2",113,0)
 ;
"RTN","LRMIEDZ2",114,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","LRMIEDZ2",115,0)
 I $P(^LR(LRDFN,"MI",LRIDT,0),U,3) D
"RTN","LRMIEDZ2",116,0)
 . S DIR("A",1)="Final report has been verified by microbiology supervisor."
"RTN","LRMIEDZ2",117,0)
 . S DIR("A",2)="If you proceed in editing, this report will need to be reverified."
"RTN","LRMIEDZ2",118,0)
 . S DIR("B")="NO"
"RTN","LRMIEDZ2",119,0)
 E  S DIR("B")="YES"
"RTN","LRMIEDZ2",120,0)
 S DIR(0)="YO",DIR("A")="Edit this accession"
"RTN","LRMIEDZ2",121,0)
 D ^DIR
"RTN","LRMIEDZ2",122,0)
 I Y<1 S (LRCAPOK,LRANOK)=0 D ASKXQA W ! Q
"RTN","LRMIEDZ2",123,0)
 ;
"RTN","LRMIEDZ2",124,0)
 ;
"RTN","LRMIEDZ2",125,0)
AUDRTN ;
"RTN","LRMIEDZ2",126,0)
 ;
"RTN","LRMIEDZ2",127,0)
 I $P(^LR(LRDFN,"MI",LRIDT,0),U,3)!$P(^LR(LRDFN,"MI",LRIDT,0),U,9) S LRUNDO=1
"RTN","LRMIEDZ2",128,0)
 ;
"RTN","LRMIEDZ2",129,0)
 D EC^LRMIEDZ4
"RTN","LRMIEDZ2",130,0)
 I N=0 W !,"No Tests on Accession" S (LRCAPOK,LRANOK)=0 Q
"RTN","LRMIEDZ2",131,0)
 I '$D(LRNPTP) D
"RTN","LRMIEDZ2",132,0)
 . I N=1 S LRI=1 Q
"RTN","LRMIEDZ2",133,0)
 . N DIR,DIROUT,DIRUT,DTOUT,DUOUT
"RTN","LRMIEDZ2",134,0)
 . S DIR(0)="NO^1:"_N_":0",DIR("A")="Select Test",DIR("B")=1
"RTN","LRMIEDZ2",135,0)
 . D ^DIR
"RTN","LRMIEDZ2",136,0)
 . I Y<1 S (LRCAPOK,LRANOK)=0 Q
"RTN","LRMIEDZ2",137,0)
 . S LRI=Y
"RTN","LRMIEDZ2",138,0)
 I LRANOK=0 Q
"RTN","LRMIEDZ2",139,0)
 I LRTX(LRI)="" W !,"EDIT CODE IN FILE 60 NOT DEFINED.",! S (LRCAPOK,LRANOK)=0 Q
"RTN","LRMIEDZ2",140,0)
 ;
"RTN","LRMIEDZ2",141,0)
 S LRTS=LRTS(LRI) D:LRUNDO UNDO^LRMIEDZ
"RTN","LRMIEDZ2",142,0)
 K DR
"RTN","LRMIEDZ2",143,0)
 S DA=LRIDT,DA(1)=LRDFN,DIE="^LR(LRDFN,""MI"","
"RTN","LRMIEDZ2",144,0)
 ;
"RTN","LRMIEDZ2",145,0)
 S LRSB=$S(LRTX(LRI)["11.5":1,LRTX(LRI)["23":11,LRTX(LRI)["19":8,LRTX(LRI)["15":5,LRTX(LRI)["34":16,1:"")
"RTN","LRMIEDZ2",146,0)
 S LRFIFO=LRTX(LRI)["FIFO",(LREND,LRSAME)=0 D:'LRFIFO TIME^LRMIEDZ3 I LREND K DR Q
"RTN","LRMIEDZ2",147,0)
 ;
"RTN","LRMIEDZ2",148,0)
 S LRSSC=$P(^LR(LRDFN,"MI",LRIDT,0),U,5)_U_$P(^(0),U,11)
"RTN","LRMIEDZ2",149,0)
 ;
"RTN","LRMIEDZ2",150,0)
 ;
"RTN","LRMIEDZ2",151,0)
AUDPT ;
"RTN","LRMIEDZ2",152,0)
 ; Check for "B" x-ref on #.01 field.
"RTN","LRMIEDZ2",153,0)
 F I=3,6,9,12,17 I $D(^LR(LRDFN,"MI",LRIDT,I)),'$D(^LR(LRDFN,"MI",LRIDT,I,"B")) D SETBINDX^LRMIBUG(LRDFN,LRIDT,I)
"RTN","LRMIEDZ2",154,0)
 ;
"RTN","LRMIEDZ2",155,0)
 I $D(LRLEDI) Q
"RTN","LRMIEDZ2",156,0)
 ;
"RTN","LRMIEDZ2",157,0)
 ; Set Y(0) for backward compatibility
"RTN","LRMIEDZ2",158,0)
 S Y(0)=LRBG0
"RTN","LRMIEDZ2",159,0)
 ;
"RTN","LRMIEDZ2",160,0)
 ; Execute code does not contain an edit template but fields/code
"RTN","LRMIEDZ2",161,0)
 I LRTX(LRI)'["S DR=""[",LRSB D  Q
"RTN","LRMIEDZ2",162,0)
 . X LRTX(LRI)
"RTN","LRMIEDZ2",163,0)
 . D EDIT^LRRPLU(LRDFN,LRSS,LRIDT) ; performing lab
"RTN","LRMIEDZ2",164,0)
 . D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) ; clinical reminders
"RTN","LRMIEDZ2",165,0)
 . D:'LREND EC3 K DR
"RTN","LRMIEDZ2",166,0)
 . D:LRUNDO&$P($G(^LR(LRDFN,"MI",LRIDT,LRSB)),U)'="" VT^LRMIUT1
"RTN","LRMIEDZ2",167,0)
 . D ASKXQA ; ask CPRS alerts
"RTN","LRMIEDZ2",168,0)
 ;
"RTN","LRMIEDZ2",169,0)
 ; Execute code contains an edit template name
"RTN","LRMIEDZ2",170,0)
 S (X,DR)=$P($P(LRTX(LRI),"[",2),"]",1) S:X'="" X=+$O(^DIE("B",X,0)) I X<1,'$D(^DIE(+X,"DR",2,63.05)) W !,DR," template doesn't exist for Microbiology." K DR  Q
"RTN","LRMIEDZ2",171,0)
 S J=1 F  S J=+$O(^DIE(X,"DR",J)) Q:J<1  S K=+$O(^DIE(X,"DR",J,0)),DR(J-1,K)=^DIE(X,"DR",J,K)
"RTN","LRMIEDZ2",172,0)
 S DR=DR(1,63.05)
"RTN","LRMIEDZ2",173,0)
 D ^DIE
"RTN","LRMIEDZ2",174,0)
 ;
"RTN","LRMIEDZ2",175,0)
 ; Ask for performing laboratory assignment
"RTN","LRMIEDZ2",176,0)
 D EDIT^LRRPLU(LRDFN,LRSS,LRIDT)
"RTN","LRMIEDZ2",177,0)
 ;
"RTN","LRMIEDZ2",178,0)
 ; Call clincial reminders
"RTN","LRMIEDZ2",179,0)
 D UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
"RTN","LRMIEDZ2",180,0)
 ;
"RTN","LRMIEDZ2",181,0)
 D EC3
"RTN","LRMIEDZ2",182,0)
 ;
"RTN","LRMIEDZ2",183,0)
 ; Ask to send CPRS alert
"RTN","LRMIEDZ2",184,0)
 D ASKXQA
"RTN","LRMIEDZ2",185,0)
 ;
"RTN","LRMIEDZ2",186,0)
 K DR
"RTN","LRMIEDZ2",187,0)
 Q
"RTN","LRMIEDZ2",188,0)
 ;
"RTN","LRMIEDZ2",189,0)
 ;
"RTN","LRMIEDZ2",190,0)
BB ;
"RTN","LRMIEDZ2",191,0)
 W !,">>>>ERROR - NO ENTRY IN FILE #63 - PLEASE NOTIFY SYSTEM MANAGER<<^ <<<",!
"RTN","LRMIEDZ2",192,0)
 Q
"RTN","LRMIEDZ2",193,0)
 ;
"RTN","LRMIEDZ2",194,0)
 ;
"RTN","LRMIEDZ2",195,0)
EC3 ;
"RTN","LRMIEDZ2",196,0)
 S LRSSCN=$P(^LR(LRDFN,"MI",LRIDT,0),U,5)_U_$P(^(0),U,11)
"RTN","LRMIEDZ2",197,0)
 D:LRSSCN'=LRSSC UPDATE
"RTN","LRMIEDZ2",198,0)
 K LRSSCN,LRSSC S LRSAME=1
"RTN","LRMIEDZ2",199,0)
 D TIME^LRMIEDZ3 D:'LREND STF^LRMIUT
"RTN","LRMIEDZ2",200,0)
 Q
"RTN","LRMIEDZ2",201,0)
 ;
"RTN","LRMIEDZ2",202,0)
 ;
"RTN","LRMIEDZ2",203,0)
UPDATE ;
"RTN","LRMIEDZ2",204,0)
 D CHECK
"RTN","LRMIEDZ2",205,0)
 K LRSSCOM,LRSSCOM1,LRSSCA,LRSSCAA,LRSSCAY,LRSSCAN,LRSSCOD,LRSSCON
"RTN","LRMIEDZ2",206,0)
 Q
"RTN","LRMIEDZ2",207,0)
 ;
"RTN","LRMIEDZ2",208,0)
 ;
"RTN","LRMIEDZ2",209,0)
CHECK ;
"RTN","LRMIEDZ2",210,0)
 S LRSSCA=$P(^LR(LRDFN,"MI",LRIDT,0),U,6),LRSSCAA=+$O(^LRO(68,"B",$P(LRSSCA," "),0))
"RTN","LRMIEDZ2",211,0)
 S X=$P(LRSSCA," ",2) D ^%DT S LRSSCAY=Y,LRSSCAN=$P(LRSSCA," ",3)
"RTN","LRMIEDZ2",212,0)
 S J=0 F  S J=+$O(^LRO(68,LRSSCAA,1,LRSSCAY,1,LRSSCAN,5,J)) Q:J<1  I ^(J,0)=LRSSC S ^(0)=LRSSCN Q
"RTN","LRMIEDZ2",213,0)
 I J<1 Q
"RTN","LRMIEDZ2",214,0)
 S LRSSCOD=$P(^LRO(68,LRSSCAA,1,LRSSCAY,1,LRSSCAN,0),U,4),LRSSCON=^(.1)
"RTN","LRMIEDZ2",215,0)
 S J=0 F  S J=+$O(^LRO(69,LRSSCOD,1,J)) Q:J<1  I $D(^(J,.1)),^(.1)=LRSSCON D ORDER Q
"RTN","LRMIEDZ2",216,0)
 Q
"RTN","LRMIEDZ2",217,0)
 ;
"RTN","LRMIEDZ2",218,0)
 ;
"RTN","LRMIEDZ2",219,0)
ORDER ;
"RTN","LRMIEDZ2",220,0)
 S $P(^LRO(69,LRSSCOD,1,J,0),U,3)=$P(LRSSCN,U,2)
"RTN","LRMIEDZ2",221,0)
 S K=0 F  S K=+$O(^LRO(69,LRSSCOD,1,J,4,K)) Q:K<1  I ^(K,0)=LRSSC S ^(0)=LRSSCN Q
"RTN","LRMIEDZ2",222,0)
 Q
"RTN","LRMIEDZ2",223,0)
 ;
"RTN","LRMIEDZ2",224,0)
 ;
"RTN","LRMIEDZ2",225,0)
PATINFO ; Display patient information
"RTN","LRMIEDZ2",226,0)
 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRUNDO=0
"RTN","LRMIEDZ2",227,0)
 D PT^LRX
"RTN","LRMIEDZ2",228,0)
 W !!,?5,PNM,"   SSN: ",SSN
"RTN","LRMIEDZ2",229,0)
 I LRDPF=2 W "   LOC: ",$S(LRWRD'="":LRWRD,1:$S($D(^LR(LRDFN,.1)):^(.1),1:"??")),!
"RTN","LRMIEDZ2",230,0)
 ;
"RTN","LRMIEDZ2",231,0)
 I LRDPF?1(1"62.3",1"67.2",1"67.3",1"67.4") Q
"RTN","LRMIEDZ2",232,0)
 ;
"RTN","LRMIEDZ2",233,0)
 W !,"Pat Info: ",$P($G(^LR(LRDFN,.091)),U)
"RTN","LRMIEDZ2",234,0)
 W ?34," Sex: ",$S(SEX="M":"MALE",SEX="F":"FEMALE",1:SEX)
"RTN","LRMIEDZ2",235,0)
 W ?48," Age: ",$$CALCAGE^LRRPU(DOB,LRCDT)," as of ",$$FMTE^XLFDT(LRCDT,"1D")
"RTN","LRMIEDZ2",236,0)
 Q
"RTN","LRMIEDZ2",237,0)
 ;
"RTN","LRMIEDZ2",238,0)
 ;
"RTN","LRMIEDZ2",239,0)
PROV ; Display provider and contact numbers.
"RTN","LRMIEDZ2",240,0)
 N LRPRAC,LRX
"RTN","LRMIEDZ2",241,0)
 S LRPRAC=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,8)
"RTN","LRMIEDZ2",242,0)
 I LRPRAC>0,LRPRAC=+LRPRAC D GETS^DIQ(200,LRPRAC_",",".01;.132;.137;.138","E","LRPRAC(LRPRAC)","LRERR")
"RTN","LRMIEDZ2",243,0)
 ;
"RTN","LRMIEDZ2",244,0)
 W !,"Provider: "
"RTN","LRMIEDZ2",245,0)
 ;
"RTN","LRMIEDZ2",246,0)
 I LRPRAC,$D(LRPRAC(LRPRAC,200)) D  Q
"RTN","LRMIEDZ2",247,0)
 . W LRPRAC(LRPRAC,200,LRPRAC_",",.01,"E"),?40," Voice pager: ",LRPRAC(LRPRAC,200,LRPRAC_",",.137,"E")
"RTN","LRMIEDZ2",248,0)
 . W !,"   Phone: ",LRPRAC(LRPRAC,200,LRPRAC_",",.132,"E"),?38," Digital pager: ",LRPRAC(LRPRAC,200,LRPRAC_",",.138,"E")
"RTN","LRMIEDZ2",249,0)
 ;
"RTN","LRMIEDZ2",250,0)
 S LRX=""
"RTN","LRMIEDZ2",251,0)
 I LRPRAC?1"REF:"1.AN!(LRDPF=67) S LRX=$$REFDOC^LRRP1(LRDFN,LRSS,LRIDT)
"RTN","LRMIEDZ2",252,0)
 I LRX'="" W LRX
"RTN","LRMIEDZ2",253,0)
 E  W LRPRAC
"RTN","LRMIEDZ2",254,0)
 ;
"RTN","LRMIEDZ2",255,0)
 Q
"RTN","LRMIEDZ2",256,0)
 ;
"RTN","LRMIEDZ2",257,0)
 ;
"RTN","LRMIEDZ2",258,0)
ASKXQA ; Determine if user should be ask to send CPRS Alert
"RTN","LRMIEDZ2",259,0)
 ;
"RTN","LRMIEDZ2",260,0)
 N LRDEFAULT
"RTN","LRMIEDZ2",261,0)
 ;
"RTN","LRMIEDZ2",262,0)
 ; No CPRS alert for non-PATIENT file (#2) patients
"RTN","LRMIEDZ2",263,0)
 I +LRDPF'=2 Q
"RTN","LRMIEDZ2",264,0)
 ;
"RTN","LRMIEDZ2",265,0)
 S LRDEFAULT=$$GET^XPAR("USR^DIV^PKG","LR MI VERIFY CPRS ALERT",1,"Q")
"RTN","LRMIEDZ2",266,0)
 I LRDEFAULT>0 D ASKXQA^LR7ORB3(LRDFN,"MI",LRIDT,LRUID,LRDEFAULT)
"RTN","LRMIEDZ2",267,0)
 ;
"RTN","LRMIEDZ2",268,0)
 Q
"RTN","LRMINEW1")
0^28^B8232594
"RTN","LRMINEW1",1,0)
LRMINEW1 ;DALOI/STAFF - NEW DATA TO BE REVIEWED/VERIFIED ;02/26/13  16:21
"RTN","LRMINEW1",2,0)
 ;;5.2;LAB SERVICE;**295,350,427**;Sep 27, 1994;Build 33
"RTN","LRMINEW1",3,0)
 ;
"RTN","LRMINEW1",4,0)
 ;
"RTN","LRMINEW1",5,0)
VER ;
"RTN","LRMINEW1",6,0)
 N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
"RTN","LRMINEW1",7,0)
 ;
"RTN","LRMINEW1",8,0)
 W !!,"Indicate those you wish to exclude from verification."
"RTN","LRMINEW1",9,0)
 D CHECK
"RTN","LRMINEW1",10,0)
 ;
"RTN","LRMINEW1",11,0)
 I $O(LRAN(0))>0 D
"RTN","LRMINEW1",12,0)
 . W !,"Verifying all but the following:"
"RTN","LRMINEW1",13,0)
 . S LRAN=0
"RTN","LRMINEW1",14,0)
 . F  S LRAN=$O(LRAN(LRAN)) Q:LRAN=""  W !,LRAN
"RTN","LRMINEW1",15,0)
 ;
"RTN","LRMINEW1",16,0)
 S DIR(0)="YO"
"RTN","LRMINEW1",17,0)
 S DIR("A")="Want the approved reports to be printed at the requesting locations"
"RTN","LRMINEW1",18,0)
 S DIR("B")="NO"
"RTN","LRMINEW1",19,0)
 D ^DIR
"RTN","LRMINEW1",20,0)
 I $D(DIRUT) Q
"RTN","LRMINEW1",21,0)
 S LRMIQUE=+Y
"RTN","LRMINEW1",22,0)
 ;
"RTN","LRMINEW1",23,0)
 K DIR
"RTN","LRMINEW1",24,0)
 S DIR(0)="YO"
"RTN","LRMINEW1",25,0)
 S DIR("A")="Are you ready to verify",DIR("B")="NO"
"RTN","LRMINEW1",26,0)
 S DIR("?",1)="If you're not sure, it's not too late to quit."
"RTN","LRMINEW1",27,0)
 S DIR("?")="Enter either 'Y' or 'N'."
"RTN","LRMINEW1",28,0)
 D ^DIR
"RTN","LRMINEW1",29,0)
 I Y'=1 Q
"RTN","LRMINEW1",30,0)
 ;
"RTN","LRMINEW1",31,0)
 S LRAN=0 F  S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1  K ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)
"RTN","LRMINEW1",32,0)
 S LRAN=0 F  S LRAN=+$O(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)) Q:LRAN<1  I +^(LRAN)=LRDXZ!(LRDXZ=0) D STUFF
"RTN","LRMINEW1",33,0)
 W !,"ALL DONE"
"RTN","LRMINEW1",34,0)
 ;
"RTN","LRMINEW1",35,0)
 Q
"RTN","LRMINEW1",36,0)
 ;
"RTN","LRMINEW1",37,0)
 ;
"RTN","LRMINEW1",38,0)
STUFF ;
"RTN","LRMINEW1",39,0)
 Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))  Q:'$D(^(3))
"RTN","LRMINEW1",40,0)
 ;
"RTN","LRMINEW1",41,0)
 S Y=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRDFN=+Y,LRLLOC=$P(Y,U,7),LRODT=$S($P(Y,U,4):$P(Y,U,4),1:$P(Y,U,3)),LRSN=$P(Y,U,5)
"RTN","LRMINEW1",42,0)
 S LRIDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",5)
"RTN","LRMINEW1",43,0)
 I LRIDT="" S LRIDT=9999999-^LRO(68,LRAA,1,LRAD,1,LRAN,3)
"RTN","LRMINEW1",44,0)
 ;
"RTN","LRMINEW1",45,0)
 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
"RTN","LRMINEW1",46,0)
 D PT^LRX
"RTN","LRMINEW1",47,0)
 ;
"RTN","LRMINEW1",48,0)
 S DT=$$DT^XLFDT
"RTN","LRMINEW1",49,0)
 S $P(^LR(LRDFN,"MI",LRIDT,LRSB),U)=$$NOW^XLFDT,$P(^(LRSB),U,$S(LRSB=11:5,1:3))=DUZ
"RTN","LRMINEW1",50,0)
 ;
"RTN","LRMINEW1",51,0)
 I LRDPF=2 D UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
"RTN","LRMINEW1",52,0)
 I $G(LRSS)="" S LRSS="MI"
"RTN","LRMINEW1",53,0)
 D SETRL^LRVERA(LRDFN,LRSS,LRIDT,DUZ(2))
"RTN","LRMINEW1",54,0)
 I LRDPF=67 D SETTMP^LRVRMI5
"RTN","LRMINEW1",55,0)
 ;
"RTN","LRMINEW1",56,0)
 S LRCDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^")
"RTN","LRMINEW1",57,0)
 S Y=DT D VT^LRMIUT1
"RTN","LRMINEW1",58,0)
 K ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)
"RTN","LRMINEW1",59,0)
 D:LRMIQUE TSKM^LRMIUT
"RTN","LRMINEW1",60,0)
 Q
"RTN","LRMINEW1",61,0)
 ;
"RTN","LRMINEW1",62,0)
 ;
"RTN","LRMINEW1",63,0)
CHECK ;from LRMINEW
"RTN","LRMINEW1",64,0)
 D LRAN^LRMIUT
"RTN","LRMINEW1",65,0)
 S LRAN=0
"RTN","LRMINEW1",66,0)
 F  S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1  S LROK=1 D CHECK1 I 'LROK K LRAN(LRAN)
"RTN","LRMINEW1",67,0)
 Q
"RTN","LRMINEW1",68,0)
 ;
"RTN","LRMINEW1",69,0)
 ;
"RTN","LRMINEW1",70,0)
CHECK1 ;
"RTN","LRMINEW1",71,0)
 I '$D(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)) W !,LRAN," is not defined." S LROK=0 Q
"RTN","LRMINEW1",72,0)
 I LRDXZ'=0,+^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)'=LRDXZ W !,LRAN," is not your accession." S LROK=0
"RTN","LRMINEW1",73,0)
 Q
"RTN","LRMIPLOG")
0^5^B3619644
"RTN","LRMIPLOG",1,0)
LRMIPLOG ;SLC/CJS/BA - PRINT BY LOG NUMBER ;11/23/12  14:13;
"RTN","LRMIPLOG",2,0)
 ;;5.2;LAB SERVICE;**427**;Sep 27, 1994;Build 33
"RTN","LRMIPLOG",3,0)
 ;from option LRMIPLOG
"RTN","LRMIPLOG",4,0)
BEGIN D ^LRPARAM D LOG
"RTN","LRMIPLOG",5,0)
END K D,DFN,DIC,DOB,I,J,K,LRAA,LRACC,LRAD,LRAN,LRCMNT,LRDAT,LRDFN,LRDPF,LREND,LRIDT,LRLLT,LRONESPC,LRONETST,LRPG,PNM,POP,R,SSN,X,X1,Y
"RTN","LRMIPLOG",6,0)
 Q
"RTN","LRMIPLOG",7,0)
LOG D LRAA^LRMIUT Q:LRAA<1  S LREND=0 S LRDAT=LRDT0,(LRADX,LRONETST,LRONESPC)=""
"RTN","LRMIPLOG",8,0)
 F I=0:0 S LRAD=$E(DT,2,3),%DT="",%DT("A")="Accession Date: ",%DT("B")=LRAD D DATE^LRWU Q:LREND!(Y'<2800000)
"RTN","LRMIPLOG",9,0)
 Q:LREND
"RTN","LRMIPLOG",10,0)
 S LRAD=$S($P(^LRO(68,LRAA,0),U,3)="Y":$E(Y,1,3)_"0000",1:Y)
"RTN","LRMIPLOG",11,0)
 W !!,"Enter Accession Numbers"
"RTN","LRMIPLOG",12,0)
 D LRAN^LRMIUT Q:'$O(LRAN(0))
"RTN","LRMIPLOG",13,0)
 S %ZIS("B")="",%ZIS="MQ" S ZTRTN="DQ^LRMIPLOG" D IO^LRWU
"RTN","LRMIPLOG",14,0)
 Q
"RTN","LRMIPLOG",15,0)
DQ ;dequeued
"RTN","LRMIPLOG",16,0)
 S:$D(ZTQUEUED) ZTREQ="@" U IO D DT^LRX
"RTN","LRMIPLOG",17,0)
 S LRAN=0 F I=0:0 S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1  D SENDUP Q:LREND
"RTN","LRMIPLOG",18,0)
 Q
"RTN","LRMIPLOG",19,0)
SENDUP ;
"RTN","LRMIPLOG",20,0)
 N LRMLTRPT ;multi report flag for RPT^LRMIPSZ1
"RTN","LRMIPLOG",21,0)
 S LRMLTRPT=1
"RTN","LRMIPLOG",22,0)
 Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3))  S LRIDT=9999999-^(3),LRDFN=+^(0),LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRLLT,U,6),LRCMNT=$S($D(^(99)):^(99),1:""),LRPG=0 D EN^LRMIPSZ1 Q:LREND
"RTN","LRMIPLOG",23,0)
 Q
"RTN","LRMIPSZ2")
0^30^B37459030
"RTN","LRMIPSZ2",1,0)
LRMIPSZ2 ;DALOI/STAFF - MICRO PATIENT REPORT - BACTERIA, SIC/SBC, MIC ;03/15/13  10:01
"RTN","LRMIPSZ2",2,0)
 ;;5.2;LAB SERVICE;**388,350,427**;Sep 27, 1994;Build 33
"RTN","LRMIPSZ2",3,0)
 ;
"RTN","LRMIPSZ2",4,0)
 ;
"RTN","LRMIPSZ2",5,0)
 Q
"RTN","LRMIPSZ2",6,0)
 ;
"RTN","LRMIPSZ2",7,0)
ANTI ;
"RTN","LRMIPSZ2",8,0)
 ; from LRMIPSZ1
"RTN","LRMIPSZ2",9,0)
 N B,I
"RTN","LRMIPSZ2",10,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,14,0)) D
"RTN","LRMIPSZ2",11,0)
 . W !!,?28,"Antibiotic Level(s):"
"RTN","LRMIPSZ2",12,0)
 . W !,"ANTIBIOTIC",?20,"CONC RANGE (ug/ml)",?42,"DRAW TIME"
"RTN","LRMIPSZ2",13,0)
 . S B=0
"RTN","LRMIPSZ2",14,0)
 . F  S B=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,14,B)) Q:B<1  D
"RTN","LRMIPSZ2",15,0)
 . . W !,$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,14,B,0),U),?20,$P(^(0),U,3),?42,$$EXTERNAL^DILFD(63.42,1,"",$P(^(0),U,2))
"RTN","LRMIPSZ2",16,0)
 Q
"RTN","LRMIPSZ2",17,0)
 ;
"RTN","LRMIPSZ2",18,0)
 ;
"RTN","LRMIPSZ2",19,0)
BACT ;
"RTN","LRMIPSZ2",20,0)
 ; from LRMIPSZ1
"RTN","LRMIPSZ2",21,0)
 I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1),U)="",'$G(LRLABKY) Q:'$D(LRWRDVEW)  Q:LRSB'=1
"RTN","LRMIPSZ2",22,0)
 D BUG
"RTN","LRMIPSZ2",23,0)
 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2)) D  Q:LRABORT  ;
"RTN","LRMIPSZ2",24,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ2",25,0)
 . D GRAM
"RTN","LRMIPSZ2",26,0)
 . D NP
"RTN","LRMIPSZ2",27,0)
 Q:LRABORT
"RTN","LRMIPSZ2",28,0)
 ;
"RTN","LRMIPSZ2",29,0)
 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,25)) D  Q:LRABORT  ;
"RTN","LRMIPSZ2",30,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ2",31,0)
 . D BSMEAR
"RTN","LRMIPSZ2",32,0)
 . D NP
"RTN","LRMIPSZ2",33,0)
 ;
"RTN","LRMIPSZ2",34,0)
 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)) D  Q:LRABORT  ;
"RTN","LRMIPSZ2",35,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ2",36,0)
 . D BRMK Q:LREND
"RTN","LRMIPSZ2",37,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ2",38,0)
 . D BACT^LRMIPSZ5
"RTN","LRMIPSZ2",39,0)
 . D NP
"RTN","LRMIPSZ2",40,0)
 ;
"RTN","LRMIPSZ2",41,0)
 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4)) D  Q:LRABORT  ;
"RTN","LRMIPSZ2",42,0)
 . N B,I
"RTN","LRMIPSZ2",43,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ2",44,0)
 . I LRHC W ! D NP Q:LRABORT
"RTN","LRMIPSZ2",45,0)
 . W !,"Bacteriology Remark(s):"
"RTN","LRMIPSZ2",46,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ2",47,0)
 . S B=0
"RTN","LRMIPSZ2",48,0)
 . F I=0:0 S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,B)) Q:B<1  W !,?3,^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,B,0) D NP Q:LRABORT
"RTN","LRMIPSZ2",49,0)
 ;
"RTN","LRMIPSZ2",50,0)
 Q
"RTN","LRMIPSZ2",51,0)
 ;
"RTN","LRMIPSZ2",52,0)
 ;
"RTN","LRMIPSZ2",53,0)
BUG ;
"RTN","LRMIPSZ2",54,0)
 N LRNS,LRTUS,LRUS,X
"RTN","LRMIPSZ2",55,0)
 ;
"RTN","LRMIPSZ2",56,0)
 S X=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1),LRTUS=$P(X,U,2),DZ=$P(X,U,3),LRUS=$P(X,U,6),LRNS=$P(X,U,5),Y=$P(X,U)
"RTN","LRMIPSZ2",57,0)
 ;
"RTN","LRMIPSZ2",58,0)
 D D^LRU
"RTN","LRMIPSZ2",59,0)
 D NP Q:LRABORT
"RTN","LRMIPSZ2",60,0)
 W:LRHC !
"RTN","LRMIPSZ2",61,0)
 D NP Q:LRABORT
"RTN","LRMIPSZ2",62,0)
 W !,"* BACTERIOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => "_Y_"   TECH CODE: "_DZ
"RTN","LRMIPSZ2",63,0)
 D NP Q:LRABORT
"RTN","LRMIPSZ2",64,0)
 S LRPRE=19
"RTN","LRMIPSZ2",65,0)
 D PRE^LRMIPSU
"RTN","LRMIPSZ2",66,0)
 I LRUS'="" D NP Q:LRABORT  W !,"URINE SCREEN: "_$S(LRUS="N":"Negative",LRUS="P":"Positive",1:LRUS) D NP Q:LRABORT  W:LRHC ! D NP Q:LRABORT
"RTN","LRMIPSZ2",67,0)
 I LRNS'="" D NP Q:LRABORT  W !,"SPUTUM SCREEN:  ",LRNS D NP Q:LRABORT  W:LRHC ! D NP Q:LRABORT
"RTN","LRMIPSZ2",68,0)
 Q
"RTN","LRMIPSZ2",69,0)
 ;
"RTN","LRMIPSZ2",70,0)
 ;
"RTN","LRMIPSZ2",71,0)
GRAM ;
"RTN","LRMIPSZ2",72,0)
 N CNT
"RTN","LRMIPSZ2",73,0)
 ;
"RTN","LRMIPSZ2",74,0)
 D NP Q:LRABORT
"RTN","LRMIPSZ2",75,0)
 W !,"GRAM STAIN:"
"RTN","LRMIPSZ2",76,0)
 S (CNT,LRGRM)=0
"RTN","LRMIPSZ2",77,0)
 F  S LRGRM=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,LRGRM)) Q:LRGRM<1  S CNT=CNT+1 W:CNT>1 ! W ?12,^(LRGRM,0) D NP Q:LRABORT
"RTN","LRMIPSZ2",78,0)
 I LRHC W !
"RTN","LRMIPSZ2",79,0)
 D NP
"RTN","LRMIPSZ2",80,0)
 Q
"RTN","LRMIPSZ2",81,0)
 ;
"RTN","LRMIPSZ2",82,0)
 ;
"RTN","LRMIPSZ2",83,0)
BSMEAR ;
"RTN","LRMIPSZ2",84,0)
 W !,"BACTERIOLOGY SMEAR/PREP:",!
"RTN","LRMIPSZ2",85,0)
 S LRMYC=0
"RTN","LRMIPSZ2",86,0)
 F  S LRMYC=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,25,LRMYC)) Q:LRMYC<1  W ?5,^(LRMYC,0),!
"RTN","LRMIPSZ2",87,0)
 Q
"RTN","LRMIPSZ2",88,0)
 ;
"RTN","LRMIPSZ2",89,0)
 ;
"RTN","LRMIPSZ2",90,0)
BRMK ;
"RTN","LRMIPSZ2",91,0)
 ; also called from T51^LRMIV1
"RTN","LRMIPSZ2",92,0)
 N LRBLDTMP
"RTN","LRMIPSZ2",93,0)
 S LRBLDTMP=0
"RTN","LRMIPSZ2",94,0)
 I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)) D  ;
"RTN","LRMIPSZ2",95,0)
 . S LRBLDTMP=1
"RTN","LRMIPSZ2",96,0)
 . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)=^LR(LRDFN,"MI",LRIDT,3)
"RTN","LRMIPSZ2",97,0)
 ;
"RTN","LRMIPSZ2",98,0)
 S (LRBUG,LR2ORMOR)=0
"RTN","LRMIPSZ2",99,0)
 F LRAX=1,2 S LRBUG=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1  S:LRAX=2 LR2ORMOR=1
"RTN","LRMIPSZ2",100,0)
 I LRAX'=1 S (LRBUG,LRTSTS)=0 F LRAX=1:1 S LRBUG=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1  D LST
"RTN","LRMIPSZ2",101,0)
 ; delete ^TMP if built just for this entrypoint
"RTN","LRMIPSZ2",102,0)
 I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3)
"RTN","LRMIPSZ2",103,0)
 Q
"RTN","LRMIPSZ2",104,0)
 ;
"RTN","LRMIPSZ2",105,0)
 ;
"RTN","LRMIPSZ2",106,0)
LST ;
"RTN","LRMIPSZ2",107,0)
 ;
"RTN","LRMIPSZ2",108,0)
 N LRX
"RTN","LRMIPSZ2",109,0)
 S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,0)
"RTN","LRMIPSZ2",110,0)
 S (LRBUG(LRAX),LRORG)=$P(LRX,U),LRQU=$P(LRX,U,2),LRSSD=$P(LRX,U,3,8),LRORG=$P(^LAB(61.2,LRORG,0),U)
"RTN","LRMIPSZ2",111,0)
 ;
"RTN","LRMIPSZ2",112,0)
 I LRSSD'?."^" S LRSIC1=$P(LRSSD,U),LRSBC1=$P(LRSSD,U,2),LRDRTM1=$P(LRSSD,U,3),LRSIC2=$P(LRSSD,U,4),LRSBC2=$P(LRSSD,U,5),LRDRTM2=$P(LRSSD,U,6),LRSSD=1
"RTN","LRMIPSZ2",113,0)
 D NP Q:LRABORT
"RTN","LRMIPSZ2",114,0)
 W:LRHC !
"RTN","LRMIPSZ2",115,0)
 I LRAX=1 W !,"CULTURE RESULTS:"
"RTN","LRMIPSZ2",116,0)
 E  W !
"RTN","LRMIPSZ2",117,0)
 W ?17,$S(LR2ORMOR:$J(LRBUG,2)_". ",1:" "),LRORG
"RTN","LRMIPSZ2",118,0)
 ;
"RTN","LRMIPSZ2",119,0)
 ; Display quantity/colony count
"RTN","LRMIPSZ2",120,0)
 I LRQU'="" D
"RTN","LRMIPSZ2",121,0)
 . S LRX=" - Quantity: "_LRQU
"RTN","LRMIPSZ2",122,0)
 . I (IOM-$X-1)<$L(LRX) W !,?21
"RTN","LRMIPSZ2",123,0)
 . W LRX
"RTN","LRMIPSZ2",124,0)
 ;
"RTN","LRMIPSZ2",125,0)
 I LRSSD D FH^LRMIPSU Q:LREND  D SSD W:LRHC !
"RTN","LRMIPSZ2",126,0)
 S:$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,2)) LRTSTS=LRTSTS+1
"RTN","LRMIPSZ2",127,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,3,0)) D MIC
"RTN","LRMIPSZ2",128,0)
 D CMNT
"RTN","LRMIPSZ2",129,0)
 Q
"RTN","LRMIPSZ2",130,0)
 ;
"RTN","LRMIPSZ2",131,0)
 ;
"RTN","LRMIPSZ2",132,0)
SSD ;
"RTN","LRMIPSZ2",133,0)
 D NP Q:LRABORT
"RTN","LRMIPSZ2",134,0)
 W !
"RTN","LRMIPSZ2",135,0)
 ;
"RTN","LRMIPSZ2",136,0)
 D NP Q:LRABORT
"RTN","LRMIPSZ2",137,0)
 S LRDRTM1=$S(LRDRTM1="P":"PEAK",LRDRTM1="T":"TROUGH",1:LRDRTM1),LRDRTM2=$S(LRDRTM2="P":"PEAK",LRDRTM2="T":"TROUGH",1:LRDRTM2)
"RTN","LRMIPSZ2",138,0)
 ;
"RTN","LRMIPSZ2",139,0)
 I LRSIC1'="" D
"RTN","LRMIPSZ2",140,0)
 . W !,?20,"SIT " W:LRDRTM1'="" "(",LRDRTM1,")" W ": ",LRSIC1
"RTN","LRMIPSZ2",141,0)
 . D NP
"RTN","LRMIPSZ2",142,0)
 Q:LRABORT
"RTN","LRMIPSZ2",143,0)
 ;
"RTN","LRMIPSZ2",144,0)
 I LRSBC1'="" D
"RTN","LRMIPSZ2",145,0)
 . W !,?20,"SBT " W:LRDRTM1'="" "(",LRDRTM1,")" W ": ",LRSBC1
"RTN","LRMIPSZ2",146,0)
 . D NP
"RTN","LRMIPSZ2",147,0)
 Q:LRABORT
"RTN","LRMIPSZ2",148,0)
 ;
"RTN","LRMIPSZ2",149,0)
 I LRSIC2'="" D
"RTN","LRMIPSZ2",150,0)
 . W !,?20,"SIT " W:LRDRTM2'="" "(",LRDRTM2,")" W ": ",LRSIC2
"RTN","LRMIPSZ2",151,0)
 . D NP
"RTN","LRMIPSZ2",152,0)
 Q:LRABORT
"RTN","LRMIPSZ2",153,0)
 ;
"RTN","LRMIPSZ2",154,0)
 I LRSBC2'="" D
"RTN","LRMIPSZ2",155,0)
 . W !,?20,"SBT " W:LRDRTM2'="" "(",LRDRTM2,")" W ": ",LRSBC2
"RTN","LRMIPSZ2",156,0)
 . D NP
"RTN","LRMIPSZ2",157,0)
 ;
"RTN","LRMIPSZ2",158,0)
 Q
"RTN","LRMIPSZ2",159,0)
 ;
"RTN","LRMIPSZ2",160,0)
 ;
"RTN","LRMIPSZ2",161,0)
MIC ;
"RTN","LRMIPSZ2",162,0)
 ;
"RTN","LRMIPSZ2",163,0)
 N B
"RTN","LRMIPSZ2",164,0)
 W !,?21,"Antibiotic"
"RTN","LRMIPSZ2",165,0)
 ;
"RTN","LRMIPSZ2",166,0)
 ; If data in 2/3rd pieces then print header
"RTN","LRMIPSZ2",167,0)
 S B=0
"RTN","LRMIPSZ2",168,0)
 F  S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1  I $P(^(B,0),U,2,3)'="" W ?38,"MIC (ug/ml)",?53,"MBC (ug/ml)" Q
"RTN","LRMIPSZ2",169,0)
 ;
"RTN","LRMIPSZ2",170,0)
 ; Print results
"RTN","LRMIPSZ2",171,0)
 S B=0
"RTN","LRMIPSZ2",172,0)
 F  S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1  W !,?21,$P(^(B,0),U),?38,$J($P(^(0),U,2),7),?53,$J($P(^(0),U,3),7)
"RTN","LRMIPSZ2",173,0)
 Q
"RTN","LRMIPSZ2",174,0)
 ;
"RTN","LRMIPSZ2",175,0)
 ;
"RTN","LRMIPSZ2",176,0)
CMNT ;
"RTN","LRMIPSZ2",177,0)
 N A,LRX,X,DIWL,DIWR,DIWF,LRIDX
"RTN","LRMIPSZ2",178,0)
 ;
"RTN","LRMIPSZ2",179,0)
 S LRPC=0,DIWL=31,DIWR=IOM,DIWF="|"
"RTN","LRMIPSZ2",180,0)
 F A=0:1 S LRPC=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC)) Q:LRPC<1  D  Q:LRABORT
"RTN","LRMIPSZ2",181,0)
 . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC,0),X=LRX
"RTN","LRMIPSZ2",182,0)
 . K ^UTILITY($J,"W")
"RTN","LRMIPSZ2",183,0)
 . D ^DIWP
"RTN","LRMIPSZ2",184,0)
 . I A=0,$D(^UTILITY($J,"W",31,1,0)) D
"RTN","LRMIPSZ2",185,0)
 . . W !,?21,"Comment: "_^UTILITY($J,"W",31,1,0)
"RTN","LRMIPSZ2",186,0)
 . . K ^UTILITY($J,"W",31,1,0)
"RTN","LRMIPSZ2",187,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ2",188,0)
 . S LRIDX=0
"RTN","LRMIPSZ2",189,0)
 . F  S LRIDX=$O(^UTILITY($J,"W",31,LRIDX)) Q:'LRIDX  D
"RTN","LRMIPSZ2",190,0)
 . . Q:'$D(^UTILITY($J,"W",31,LRIDX,0))
"RTN","LRMIPSZ2",191,0)
 . . W !,?21,"         "_^UTILITY($J,"W",31,LRIDX,0)
"RTN","LRMIPSZ2",192,0)
 . . D NP
"RTN","LRMIPSZ2",193,0)
 K ^UTILITY($J,"W")
"RTN","LRMIPSZ2",194,0)
 Q
"RTN","LRMIPSZ2",195,0)
 ;
"RTN","LRMIPSZ2",196,0)
 ;
"RTN","LRMIPSZ2",197,0)
NP ;
"RTN","LRMIPSZ2",198,0)
 ; Convenience method
"RTN","LRMIPSZ2",199,0)
 D NP^LRMIPSZ1
"RTN","LRMIPSZ2",200,0)
 Q
"RTN","LRMIPSZ3")
0^17^B29744803
"RTN","LRMIPSZ3",1,0)
LRMIPSZ3 ;DALOI/STAFF - MICRO PATIENT REPORT - STERILITY, PARASITES, VIRUS ;02/21/13  14:43
"RTN","LRMIPSZ3",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRMIPSZ3",3,0)
 ;
"RTN","LRMIPSZ3",4,0)
 ; Reference for DD global supported by ICR #999
"RTN","LRMIPSZ3",5,0)
 Q
"RTN","LRMIPSZ3",6,0)
 ;
"RTN","LRMIPSZ3",7,0)
 ;
"RTN","LRMIPSZ3",8,0)
STER ;
"RTN","LRMIPSZ3",9,0)
 ; from LRMIPSZ1
"RTN","LRMIPSZ3",10,0)
 ; also called from RPT^LROR4
"RTN","LRMIPSZ3",11,0)
 N I,LRBLDTMP,LRERR,LRFLAG,LRX,X
"RTN","LRMIPSZ3",12,0)
 S LRBLDTMP=0
"RTN","LRMIPSZ3",13,0)
 I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D
"RTN","LRMIPSZ3",14,0)
 . S LRBLDTMP=1
"RTN","LRMIPSZ3",15,0)
 . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
"RTN","LRMIPSZ3",16,0)
 . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)
"RTN","LRMIPSZ3",17,0)
 ;
"RTN","LRMIPSZ3",18,0)
 I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1),U,7)'="" D  Q:LRABORT
"RTN","LRMIPSZ3",19,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ3",20,0)
 . S LRX=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,1),U,7)
"RTN","LRMIPSZ3",21,0)
 . S LRX(0)=$$EXTERNAL^DILFD(63.05,11.51,"",LRX,"LRERR")
"RTN","LRMIPSZ3",22,0)
 . I $D(LRERR) S LRX(0)=LRX K LRERR
"RTN","LRMIPSZ3",23,0)
 . W !,"STERILITY CONTROL: ",LRX(0)
"RTN","LRMIPSZ3",24,0)
 ;
"RTN","LRMIPSZ3",25,0)
 S LRFLAG=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,31,0))
"RTN","LRMIPSZ3",26,0)
 I LRFLAG W !
"RTN","LRMIPSZ3",27,0)
 S I=0
"RTN","LRMIPSZ3",28,0)
 F  S I=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,31,I)) Q:I<1  D  Q:LRABORT
"RTN","LRMIPSZ3",29,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ3",30,0)
 . S LRX=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,31,I,0),"^")
"RTN","LRMIPSZ3",31,0)
 . S LRX(0)=$$EXTERNAL^DILFD(63.292,.01,"",LRX,"LRERR")
"RTN","LRMIPSZ3",32,0)
 . I $D(LRERR) S LRX(0)=LRX K LRERR
"RTN","LRMIPSZ3",33,0)
 . W !,"NUMBER: ",I,?20,"STERILITY RESULTS: ",LRX(0)
"RTN","LRMIPSZ3",34,0)
 I LRFLAG W !
"RTN","LRMIPSZ3",35,0)
 ;
"RTN","LRMIPSZ3",36,0)
 I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
"RTN","LRMIPSZ3",37,0)
 Q
"RTN","LRMIPSZ3",38,0)
 ;
"RTN","LRMIPSZ3",39,0)
 ;
"RTN","LRMIPSZ3",40,0)
PARA ;
"RTN","LRMIPSZ3",41,0)
 ; from LRMIPSZ1
"RTN","LRMIPSZ3",42,0)
 ; also called from RPT^LROR4
"RTN","LRMIPSZ3",43,0)
 N LRBLDTMP,LRQUIT
"RTN","LRMIPSZ3",44,0)
 S (LRBLDTMP,LRQUIT)=0
"RTN","LRMIPSZ3",45,0)
 I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D  ;
"RTN","LRMIPSZ3",46,0)
 . S LRBLDTMP=1
"RTN","LRMIPSZ3",47,0)
 . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
"RTN","LRMIPSZ3",48,0)
 . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)
"RTN","LRMIPSZ3",49,0)
 ;
"RTN","LRMIPSZ3",50,0)
 I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,5),U)="",'$G(LRLABKY) S:'$D(LRWRDVEW) LRQUIT=1 S:LRSB'=5 LRQUIT=1
"RTN","LRMIPSZ3",51,0)
 ;
"RTN","LRMIPSZ3",52,0)
 I LRQUIT D  Q
"RTN","LRMIPSZ3",53,0)
 . I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
"RTN","LRMIPSZ3",54,0)
 ;
"RTN","LRMIPSZ3",55,0)
 S LRTUS=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,5),U,2)
"RTN","LRMIPSZ3",56,0)
 S DZ=$P(^(5),U,3),Y=$P(^(5),U)
"RTN","LRMIPSZ3",57,0)
 D D^LRU
"RTN","LRMIPSZ3",58,0)
 I LRHC W ! D NP Q:LRABORT
"RTN","LRMIPSZ3",59,0)
 W !,"* PARASITOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y,"   TECH CODE: ",DZ
"RTN","LRMIPSZ3",60,0)
 D NP Q:LRABORT
"RTN","LRMIPSZ3",61,0)
 S LRPRE=21 D PRE^LRMIPSU
"RTN","LRMIPSZ3",62,0)
 D NP Q:LRABORT
"RTN","LRMIPSZ3",63,0)
 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,24)) D  ;
"RTN","LRMIPSZ3",64,0)
 . I LRHC W ! D NP Q:LRABORT
"RTN","LRMIPSZ3",65,0)
 . W !,"PARASITOLOGY SMEAR/PREP:"
"RTN","LRMIPSZ3",66,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ3",67,0)
 . S LRMYC=0
"RTN","LRMIPSZ3",68,0)
 . F I=0:0 S LRMYC=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,24,LRMYC)) Q:LRMYC<1  W !?5,^(LRMYC,0) D NP Q:LRABORT
"RTN","LRMIPSZ3",69,0)
 ;
"RTN","LRMIPSZ3",70,0)
 S LRPAR=0
"RTN","LRMIPSZ3",71,0)
 F  S LRPAR=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,LRPAR)) Q:LRPAR<1  Q:LRABORT  W:LRHC ! D NP Q:LRABORT  Q:'$D(^(LRPAR,0))  W !,"Parasite: ",$E($P(^LAB(61.2,^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,LRPAR,0),0),U),1,25),?30," " D STG D NP Q:LRABORT
"RTN","LRMIPSZ3",72,0)
 ;
"RTN","LRMIPSZ3",73,0)
 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7)) D  ;
"RTN","LRMIPSZ3",74,0)
 . W:LRHC ! D NP Q:LRABORT
"RTN","LRMIPSZ3",75,0)
 . W !,"Parasitology Remark(s):"
"RTN","LRMIPSZ3",76,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ3",77,0)
 . S LRPAR=0
"RTN","LRMIPSZ3",78,0)
 . F  S LRPAR=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,LRPAR)) Q:LRPAR<1  Q:LRABORT  W !,?3,^(LRPAR,0) D NP Q:LRABORT  ;
"RTN","LRMIPSZ3",79,0)
 ;
"RTN","LRMIPSZ3",80,0)
 I LRBLDTMP D  ;
"RTN","LRMIPSZ3",81,0)
 . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
"RTN","LRMIPSZ3",82,0)
 ;
"RTN","LRMIPSZ3",83,0)
 Q
"RTN","LRMIPSZ3",84,0)
 ;
"RTN","LRMIPSZ3",85,0)
 ;
"RTN","LRMIPSZ3",86,0)
STG ;
"RTN","LRMIPSZ3",87,0)
 N B
"RTN","LRMIPSZ3",88,0)
 D NP Q:LRABORT
"RTN","LRMIPSZ3",89,0)
 S LRBUG(LRPAR)=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,LRPAR,0)
"RTN","LRMIPSZ3",90,0)
 S S1=6,LRTA=LRPAR
"RTN","LRMIPSZ3",91,0)
 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,S1,LRTA,1)) D  ;
"RTN","LRMIPSZ3",92,0)
 . S B=0
"RTN","LRMIPSZ3",93,0)
 . F  S B=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,S1,LRTA,1,B)) Q:B<1  Q:LRABORT  S Y=^(B,0),Y1=$P(Y,U,2) W !,"   Stage: " D SET D NP Q:LRABORT  W:$L(Y1) !,"   Quantity: ",Y1 D LIST1 D NP Q:LRABORT
"RTN","LRMIPSZ3",94,0)
 ;
"RTN","LRMIPSZ3",95,0)
 Q
"RTN","LRMIPSZ3",96,0)
 ;
"RTN","LRMIPSZ3",97,0)
 ;
"RTN","LRMIPSZ3",98,0)
SET ;
"RTN","LRMIPSZ3",99,0)
 ; File DD/999
"RTN","LRMIPSZ3",100,0)
 S LRSET=$P(^DD(63.35,.01,0),U,3),%=$P($P(";"_LRSET,";"_$P(Y,U)_":",2),";") W:%]"" %
"RTN","LRMIPSZ3",101,0)
 Q
"RTN","LRMIPSZ3",102,0)
 ;
"RTN","LRMIPSZ3",103,0)
 ;
"RTN","LRMIPSZ3",104,0)
LIST1 ;
"RTN","LRMIPSZ3",105,0)
 N C
"RTN","LRMIPSZ3",106,0)
 D NP Q:LRABORT
"RTN","LRMIPSZ3",107,0)
 W !,"   Comment: "
"RTN","LRMIPSZ3",108,0)
 S C=0
"RTN","LRMIPSZ3",109,0)
 F  S C=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,S1,LRTA,1,B,1,C)) Q:C<1  W ?13,^(C,0),! D NP Q:LRABORT
"RTN","LRMIPSZ3",110,0)
 Q
"RTN","LRMIPSZ3",111,0)
 ;
"RTN","LRMIPSZ3",112,0)
 ;
"RTN","LRMIPSZ3",113,0)
VIR ;
"RTN","LRMIPSZ3",114,0)
 ; from LRMIPSZ1
"RTN","LRMIPSZ3",115,0)
 ; also called from RPT^LROR4
"RTN","LRMIPSZ3",116,0)
 N LRBLDTMP,LRQUIT
"RTN","LRMIPSZ3",117,0)
 S (LRQUIT,LRBLDTMP)=0
"RTN","LRMIPSZ3",118,0)
 I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT)) D  ;
"RTN","LRMIPSZ3",119,0)
 . S LRBLDTMP=1
"RTN","LRMIPSZ3",120,0)
 . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)=^LR(LRDFN,"MI",LRIDT)
"RTN","LRMIPSZ3",121,0)
 . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,32)
"RTN","LRMIPSZ3",122,0)
 ;
"RTN","LRMIPSZ3",123,0)
 I $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,16),U)="",'$G(LRLABKY) S:'$D(LRWRDVEW) LRQUIT=1 S:LRSB'=16 LRQUIT=1
"RTN","LRMIPSZ3",124,0)
 ;
"RTN","LRMIPSZ3",125,0)
 I LRQUIT D  Q
"RTN","LRMIPSZ3",126,0)
 . I LRBLDTMP K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
"RTN","LRMIPSZ3",127,0)
 ;
"RTN","LRMIPSZ3",128,0)
 S LRTUS=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,16),U,2)
"RTN","LRMIPSZ3",129,0)
 S DZ=$P(^(16),U,3),Y=$P(^(16),U)
"RTN","LRMIPSZ3",130,0)
 D D^LRU
"RTN","LRMIPSZ3",131,0)
 I LRHC W ! D NP Q:LRABORT
"RTN","LRMIPSZ3",132,0)
 W !,"* VIROLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => ",Y,"   TECH CODE: ",DZ
"RTN","LRMIPSZ3",133,0)
 D NP Q:LRABORT
"RTN","LRMIPSZ3",134,0)
 S LRPRE=20
"RTN","LRMIPSZ3",135,0)
 D PRE^LRMIPSU
"RTN","LRMIPSZ3",136,0)
 S LRPAR=0
"RTN","LRMIPSZ3",137,0)
 F  S LRPAR=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,LRPAR)) Q:LRPAR<1  D  Q:LRABORT  ;
"RTN","LRMIPSZ3",138,0)
 . I LRHC W !
"RTN","LRMIPSZ3",139,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ3",140,0)
 . W !,"Virus: ",$P(^LAB(61.2,$P(^(LRPAR,0),U),0),U)
"RTN","LRMIPSZ3",141,0)
 . S LRBUG(LRPAR)=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,LRPAR,0)
"RTN","LRMIPSZ3",142,0)
 ;
"RTN","LRMIPSZ3",143,0)
 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18)) D  ;
"RTN","LRMIPSZ3",144,0)
 . W:LRHC !
"RTN","LRMIPSZ3",145,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ3",146,0)
 . W !,"Virology Remark(s):"
"RTN","LRMIPSZ3",147,0)
 . D NP Q:LRABORT
"RTN","LRMIPSZ3",148,0)
 . S LRPAR=0
"RTN","LRMIPSZ3",149,0)
 . F  S LRPAR=+$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,LRPAR)) Q:LRPAR<1  W !,?3,^(LRPAR,0) D NP Q:LRABORT  ;
"RTN","LRMIPSZ3",150,0)
 ;
"RTN","LRMIPSZ3",151,0)
 I LRBLDTMP D  ;
"RTN","LRMIPSZ3",152,0)
 . K ^TMP("LRMI",$J,LRDFN,"MI",LRIDT)
"RTN","LRMIPSZ3",153,0)
 Q
"RTN","LRMIPSZ3",154,0)
 ;
"RTN","LRMIPSZ3",155,0)
 ;
"RTN","LRMIPSZ3",156,0)
NP ;
"RTN","LRMIPSZ3",157,0)
 ; Convenience method
"RTN","LRMIPSZ3",158,0)
 D NP^LRMIPSZ1
"RTN","LRMIPSZ3",159,0)
 Q
"RTN","LRMISTF1")
0^27^B41353920
"RTN","LRMISTF1",1,0)
LRMISTF1 ;DALOI/STAFF - MASS DATA ENTRY INTO FILE 63.05 ;02/25/13  10:24
"RTN","LRMISTF1",2,0)
 ;;5.2;LAB SERVICE;**121,128,202,263,264,295,350,427**;Sep 27, 1994;Build 33
"RTN","LRMISTF1",3,0)
 ;
"RTN","LRMISTF1",4,0)
 ; from LRMISTF
"RTN","LRMISTF1",5,0)
 ;
"RTN","LRMISTF1",6,0)
ASK ;
"RTN","LRMISTF1",7,0)
 N LRAUTO,LRDUZ,LRIEN,LRPLREF
"RTN","LRMISTF1",8,0)
 ;
"RTN","LRMISTF1",9,0)
 F  D GET Q:LREND=99  D:'LREND ACC S:LREND LREND=0 D MORE Q:LREND  K LRAUTO
"RTN","LRMISTF1",10,0)
 Q
"RTN","LRMISTF1",11,0)
 ;
"RTN","LRMISTF1",12,0)
 ;
"RTN","LRMISTF1",13,0)
GET ;
"RTN","LRMISTF1",14,0)
 N DIR,DIRUT,DTOUT,DUOUT,LRSTUFF,X,Y
"RTN","LRMISTF1",15,0)
 ;
"RTN","LRMISTF1",16,0)
 S X1="",LREND=0
"RTN","LRMISTF1",17,0)
 I LRMODE<3 D
"RTN","LRMISTF1",18,0)
 . F  R !,"What do you want entered?: ",X1:DTIME Q:'$T!(X1[U)!(X1="")  D  I $L(X1),$E(X1)'="?" S LREND=0 Q
"RTN","LRMISTF1",19,0)
 . . I $S(X1[":":1,X1[";":1,1:0) S X1="?" D INFO Q
"RTN","LRMISTF1",20,0)
 . . S X=X1 S:X[";" X="?" D @$S($G(H9)=11.57:"PN^LRNUM",$G(H9)=24:"AFS^LRNUM",1:"^LRMIXPD") S:'$D(X) X1="?" Q:X1'="?"  D INFO
"RTN","LRMISTF1",21,0)
 I X1[U S LREND=99 Q
"RTN","LRMISTF1",22,0)
 ;
"RTN","LRMISTF1",23,0)
 S:LRMODE<3 LRSTUFF=X1
"RTN","LRMISTF1",24,0)
 W !,"I will ",$S(LRMODE=1:"automatically stuff ",1:"prompt "),LRMF W:$D(LRSTUFF) !,"with ",LRSTUFF
"RTN","LRMISTF1",25,0)
 F  W !,"   ...OK" S %=1 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"
"RTN","LRMISTF1",26,0)
 I %'=1 S LREND=1 Q
"RTN","LRMISTF1",27,0)
 ;
"RTN","LRMISTF1",28,0)
 I LRPF="P" S DR="S:$S($D(^LR(LRDFN,""MI"",LRIDT,"_LRSB_")):$P(^("_LRSB_"),U,2),1:"""")=""F"" Y="_$S(LRSB=1:11.55,LRSB=5:15.5,LRSB=8:19.5,LRSB=11:25.5,LRSB=16:35)_";"
"RTN","LRMISTF1",29,0)
 I LRPF="F" S DR=""
"RTN","LRMISTF1",30,0)
 S DR=DR_$S(LRSB=1:"11.5///"_LRPF_";11.55",LRSB=5:"15///"_LRPF_";15.5",LRSB=8:"19///"_LRPF_";19.5",LRSB=11:"23///"_LRPF_";25.5",1:"34///"_LRPF_";35")
"RTN","LRMISTF1",31,0)
 S DR=DR_"////"_DUZ_";"_H9_$S(LRMODE=1:"///"_LRSTUFF,LRMODE=2:"//"_LRSTUFF,1:"")
"RTN","LRMISTF1",32,0)
 ;
"RTN","LRMISTF1",33,0)
 K DIR
"RTN","LRMISTF1",34,0)
 S DIR(0)="YO",DIR("A")="Verify all work automatically",DIR("B")="Yes"
"RTN","LRMISTF1",35,0)
 D ^DIR
"RTN","LRMISTF1",36,0)
 I $D(DIRUT) S LREND=1 Q
"RTN","LRMISTF1",37,0)
 I Y=1 S DR=DR_";"_$S(LRSB=1:11,LRSB=5:14,LRSB=8:18,LRSB=11:22,1:33)_"///NOW",LRAUTO=""
"RTN","LRMISTF1",38,0)
 ;
"RTN","LRMISTF1",39,0)
 ;
"RTN","LRMISTF1",40,0)
 K DIR
"RTN","LRMISTF1",41,0)
 S DIR(0)="YO",DIR("A")="Designate the individual test as complete",DIR("B")="No"
"RTN","LRMISTF1",42,0)
 D ^DIR
"RTN","LRMISTF1",43,0)
 I $D(DIRUT) S LREND=1 Q
"RTN","LRMISTF1",44,0)
 S LRCO=+Y
"RTN","LRMISTF1",45,0)
 ;
"RTN","LRMISTF1",46,0)
 ;
"RTN","LRMISTF1",47,0)
 ; Ask for performing lab if automatically verifying.
"RTN","LRMISTF1",48,0)
 ; Setup array of fields to performing lab reference
"RTN","LRMISTF1",49,0)
 K LRDUZ,LRPLREF
"RTN","LRMISTF1",50,0)
 ;
"RTN","LRMISTF1",51,0)
 S LRPLREF(11.57)="1:6"
"RTN","LRMISTF1",52,0)
 S LRPLREF(11.58)="1;5"
"RTN","LRMISTF1",53,0)
 S LRPLREF(11.6)="2,0"
"RTN","LRMISTF1",54,0)
 S LRPLREF(13)="4,0"
"RTN","LRMISTF1",55,0)
 S LRPLREF(15.51)="24,0"
"RTN","LRMISTF1",56,0)
 S LRPLREF(17)="7,0"
"RTN","LRMISTF1",57,0)
 S LRPLREF(19.6)="15,0"
"RTN","LRMISTF1",58,0)
 S LRPLREF(21)="10,0"
"RTN","LRMISTF1",59,0)
 S LRPLREF(24)="11;3"
"RTN","LRMISTF1",60,0)
 S LRPLREF(27)="13,0"
"RTN","LRMISTF1",61,0)
 S LRPLREF(37)="18,0"
"RTN","LRMISTF1",62,0)
 ;
"RTN","LRMISTF1",63,0)
 I $D(LRAUTO) D
"RTN","LRMISTF1",64,0)
 . N DIR,DIRUT,DTOUT,DUOUT,LRDPL,X,Y
"RTN","LRMISTF1",65,0)
 . S LRDPL=$$GET^XPAR("USR","LR VER DEFAULT PERFORMING LAB",1,"Q")
"RTN","LRMISTF1",66,0)
 . I LRDPL<1 S LRDPL=DUZ(2)
"RTN","LRMISTF1",67,0)
 . ;
"RTN","LRMISTF1",68,0)
 . I '($$GET^XPAR("ALL","LR ASK PERFORMING LAB MICRO",1,"Q")) D  Q
"RTN","LRMISTF1",69,0)
 . . I LRDPL'=DUZ(2) S LRDUZ(2)=LRDPL
"RTN","LRMISTF1",70,0)
 . . S $P(LRPLREF(H9),"^")="0"
"RTN","LRMISTF1",71,0)
 . ;
"RTN","LRMISTF1",72,0)
 . S X=$$SELPL^LRVERA(LRDPL)
"RTN","LRMISTF1",73,0)
 . I X<1 S LREND=1 Q
"RTN","LRMISTF1",74,0)
 . I X'=DUZ(2) S LRDUZ(2)=X
"RTN","LRMISTF1",75,0)
 . S DIR(0)="S^1:Entire report;2:"_LRMF_" section of report"
"RTN","LRMISTF1",76,0)
 . S DIR("A")="Designate performing laboratory for"
"RTN","LRMISTF1",77,0)
 . S DIR("?")="Enter a code from the list or '^' to exit."
"RTN","LRMISTF1",78,0)
 . D ^DIR
"RTN","LRMISTF1",79,0)
 . I $D(DIRUT) S LREND=1 Q
"RTN","LRMISTF1",80,0)
 . I Y=1 S $P(LRPLREF(H9),"^")="0"
"RTN","LRMISTF1",81,0)
 Q
"RTN","LRMISTF1",82,0)
 ;
"RTN","LRMISTF1",83,0)
 ;
"RTN","LRMISTF1",84,0)
INFO ;
"RTN","LRMISTF1",85,0)
 W !,$$CJ^XLFSTR("What you enter will go through the input transform to be stored in the.",IOM)
"RTN","LRMISTF1",86,0)
 W !,$$CJ^XLFSTR("Result field of the test",IOM)
"RTN","LRMISTF1",87,0)
 W !,$$CJ^XLFSTR("The punctuations of ';' or ':'  are not allowed in Batch Data Entry.",IOM),!
"RTN","LRMISTF1",88,0)
 Q
"RTN","LRMISTF1",89,0)
 ;
"RTN","LRMISTF1",90,0)
 ;
"RTN","LRMISTF1",91,0)
ACC ;
"RTN","LRMISTF1",92,0)
 N DIC,DIR,DIRUT,DTOUT,DUOUT
"RTN","LRMISTF1",93,0)
 W !,"Enter the accessions you wish to edit." D LRAN^LRMIUT
"RTN","LRMISTF1",94,0)
 I +$O(LRAN(0))>0 W !,"Editing the following:" S (J,LRAN)=0 F  S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1  W !,LRAN S J=J+1 I J#(IOSL-2)=0 R !,"Press return to continue or '^' to escape ",X:DTIME I X[U S LREND=1 Q
"RTN","LRMISTF1",95,0)
 Q:LREND
"RTN","LRMISTF1",96,0)
 ;
"RTN","LRMISTF1",97,0)
 S DIR(0)="YO",DIR("A")="Everything OK",DIR("B")="NO"
"RTN","LRMISTF1",98,0)
 D ^DIR
"RTN","LRMISTF1",99,0)
 I Y<1 Q
"RTN","LRMISTF1",100,0)
 ;
"RTN","LRMISTF1",101,0)
 S LRAN=0
"RTN","LRMISTF1",102,0)
 F  S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1  D STUFF Q:LREND
"RTN","LRMISTF1",103,0)
 Q
"RTN","LRMISTF1",104,0)
 ;
"RTN","LRMISTF1",105,0)
 ;
"RTN","LRMISTF1",106,0)
STUFF ;
"RTN","LRMISTF1",107,0)
 N LREND
"RTN","LRMISTF1",108,0)
 ;
"RTN","LRMISTF1",109,0)
 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))!'$D(^(3)) W !,"Acc: ",LRAN," not set up." Q
"RTN","LRMISTF1",110,0)
 I $P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4) W !,"Acc: ",LRAN," has been previously verified by a microbiology supervisor." Q
"RTN","LRMISTF1",111,0)
 ;
"RTN","LRMISTF1",112,0)
 S LRNOP=1,J=0 F  S J=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,J)) Q:J<1  I LRTEST=+^(J,0) S LRNOP=$P(^(0),U,5) Q
"RTN","LRMISTF1",113,0)
 I LRNOP=1 W !,"Acc: ",LRAN," doesn't have the test required." Q
"RTN","LRMISTF1",114,0)
 I LRNOP>1 W !,"Acc: ",LRAN," has been completed for the selected test." Q
"RTN","LRMISTF1",115,0)
 ;
"RTN","LRMISTF1",116,0)
 I H9=11.57!(H9=11.58) S LROK=0 D @$S(H9=11.57:"UR",1:"SPUT") I 'LROK W !,"Acc: ",LRAN," doesn't have the specimen required." Q
"RTN","LRMISTF1",117,0)
 ;
"RTN","LRMISTF1",118,0)
 W !,"Acc: ",LRAN
"RTN","LRMISTF1",119,0)
 S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRLLOC=$P(^(0),U,7),LRODT=$S($P(^(0),U,4):$P(^(0),U,4),1:$P(^(0),U,3)),LRSN=$P(^(0),U,5)
"RTN","LRMISTF1",120,0)
 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
"RTN","LRMISTF1",121,0)
 D PT^LRX
"RTN","LRMISTF1",122,0)
 W ?15,PNM,?45,SSN,?65,LRWRD,!
"RTN","LRMISTF1",123,0)
 ;
"RTN","LRMISTF1",124,0)
 S LRCDT=+^LRO(68,LRAA,1,LRAD,1,LRAN,3),LRIDT=+$P(^(3),U,5),DIE="^LR("_LRDFN_",""MI"",",DA=LRIDT
"RTN","LRMISTF1",125,0)
 D ^DIE,UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
"RTN","LRMISTF1",126,0)
 I $D(Y) S LREND=1 Q
"RTN","LRMISTF1",127,0)
 ;
"RTN","LRMISTF1",128,0)
 I LRCO D
"RTN","LRMISTF1",129,0)
 . S X=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,5)
"RTN","LRMISTF1",130,0)
 . I X K ^LRO(68,LRAA,1,LRAD,1,"AD",$P(X,"."),LRAN),^LRO(68,LRAA,1,LRAD,1,"AC",X,LRAN)
"RTN","LRMISTF1",131,0)
 . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,4)=DUZ,$P(^(0),U,8)=$G(LRCDEF)
"RTN","LRMISTF1",132,0)
 . S Y=$$NOW^XLFDT
"RTN","LRMISTF1",133,0)
 . S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTEST,0),U,5)=Y
"RTN","LRMISTF1",134,0)
 . S ^LRO(68,LRAA,1,LRAD,1,"AD",$P(Y,"."),LRAN)="",^LRO(68,LRAA,1,LRAD,1,"AC",Y,LRAN)=""
"RTN","LRMISTF1",135,0)
 . N CORRECT S:$G(LRCORECT) CORRECT=1 D NEW^LR7OB1(LRODT,LRSN,"RE")
"RTN","LRMISTF1",136,0)
 ;
"RTN","LRMISTF1",137,0)
 I $D(LRAUTO) D PL,STF^LRMIUT,LEDI^LRVR0
"RTN","LRMISTF1",138,0)
 ;
"RTN","LRMISTF1",139,0)
 Q
"RTN","LRMISTF1",140,0)
 ;
"RTN","LRMISTF1",141,0)
 ;
"RTN","LRMISTF1",142,0)
MORE ;
"RTN","LRMISTF1",143,0)
 S LREND=1
"RTN","LRMISTF1",144,0)
 F  W !,"Do you wish to make a new entry for the ",LRMF," field" S %=2 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"
"RTN","LRMISTF1",145,0)
 I %=1 S LREND=0
"RTN","LRMISTF1",146,0)
 Q
"RTN","LRMISTF1",147,0)
 ;
"RTN","LRMISTF1",148,0)
 ;
"RTN","LRMISTF1",149,0)
UR ;
"RTN","LRMISTF1",150,0)
 S J=0
"RTN","LRMISTF1",151,0)
 F  S J=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,J)) Q:J<1  I LRURINE=+^(J,0) S LROK=1 Q
"RTN","LRMISTF1",152,0)
 Q
"RTN","LRMISTF1",153,0)
 ;
"RTN","LRMISTF1",154,0)
 ;
"RTN","LRMISTF1",155,0)
SPUT ;
"RTN","LRMISTF1",156,0)
 S J=0
"RTN","LRMISTF1",157,0)
 F  S J=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,J)) Q:J<1  I 360=+^(J,0) S LROK=1 Q
"RTN","LRMISTF1",158,0)
 Q
"RTN","LRMISTF1",159,0)
 ;
"RTN","LRMISTF1",160,0)
 ;
"RTN","LRMISTF1",161,0)
PL ; Store performing lab on automatic verification
"RTN","LRMISTF1",162,0)
 ;
"RTN","LRMISTF1",163,0)
 N LRPL,LRREF,LRX,LRY
"RTN","LRMISTF1",164,0)
 ;
"RTN","LRMISTF1",165,0)
 S LRY=$G(LRPLREF(H9))
"RTN","LRMISTF1",166,0)
 I LRY="" Q
"RTN","LRMISTF1",167,0)
 S LRREF=LRDFN_",MI,"_LRIDT_","_LRY
"RTN","LRMISTF1",168,0)
 S LRPL=$S($G(LRDUZ(2)):LRDUZ(2),1:DUZ(2))
"RTN","LRMISTF1",169,0)
 ;
"RTN","LRMISTF1",170,0)
 S LRX=$O(^LR(LRDFN,"PL","B",LRREF,0))
"RTN","LRMISTF1",171,0)
 I 'LRX D CNE^LRRPLU(LRDFN,LRREF,LRPL) Q
"RTN","LRMISTF1",172,0)
 I $P(^LR(LRDFN,"PL",LRX,0),"^",2)'=LRPL D UEE^LRRPLU(LRDFN,LRREF,LRPL)
"RTN","LRMISTF1",173,0)
 ;
"RTN","LRMISTF1",174,0)
 Q
"RTN","LRMIUT1")
0^25^B6714557
"RTN","LRMIUT1",1,0)
LRMIUT1 ;DALOI/STAFF - INPUT TRANSFORMS FOR MICRO ;02/21/13  10:28
"RTN","LRMIUT1",2,0)
 ;;5.2;LAB SERVICE;**100,121,323,350,427**;Sep 27, 1994;Build 33
"RTN","LRMIUT1",3,0)
 ;
"RTN","LRMIUT1",4,0)
RPT ; from input transform on RPT DATE APPROVED
"RTN","LRMIUT1",5,0)
 N %DT,Y
"RTN","LRMIUT1",6,0)
 I $G(DIUTIL)'="VERIFY FIELDS" D  ;
"RTN","LRMIUT1",7,0)
 . I '$D(^XUSEC("LRVERIFY",DUZ)) K X D EN^DDIOL("*** You do not have the proper access to approve these results ***","","!,$C(7)")
"RTN","LRMIUT1",8,0)
 Q:'$D(X)
"RTN","LRMIUT1",9,0)
 S %DT="EXR"
"RTN","LRMIUT1",10,0)
 I $G(DIUTIL)="VERIFY FIELDS" S %DT="EXT" ;old rptdt only has date
"RTN","LRMIUT1",11,0)
 D ^%DT S X=Y I Y<1 K X Q
"RTN","LRMIUT1",12,0)
 I $G(DIUTIL)="VERIFY FIELDS" Q
"RTN","LRMIUT1",13,0)
 N X,DA,DIERR,DIE,DIC,DR ;protect FM vars from subsequent calls
"RTN","LRMIUT1",14,0)
 D VT1
"RTN","LRMIUT1",15,0)
 Q
"RTN","LRMIUT1",16,0)
 ;
"RTN","LRMIUT1",17,0)
 ;
"RTN","LRMIUT1",18,0)
VT ; from LRMINEW1, LRMIVER1
"RTN","LRMIUT1",19,0)
 D VT1
"RTN","LRMIUT1",20,0)
 K ^TMP("LA7HDR",$J)
"RTN","LRMIUT1",21,0)
 Q
"RTN","LRMIUT1",22,0)
 ;
"RTN","LRMIUT1",23,0)
 ;
"RTN","LRMIUT1",24,0)
VT1 ; from above
"RTN","LRMIUT1",25,0)
 I $G(LRLLOC)'="",$G(PNM)'="",$G(LRDFN),$G(LRIDT) S LRVTP=$P(^LAB(64.5,1,0),U,10),LRVT=$G(LRVT) D APP
"RTN","LRMIUT1",26,0)
 ;
"RTN","LRMIUT1",27,0)
 ; Set reporting facility
"RTN","LRMIUT1",28,0)
 I $G(LRDFN),$G(LRIDT) D SETRL^LRVERA(LRDFN,"MI",LRIDT,DUZ(2))
"RTN","LRMIUT1",29,0)
 Q
"RTN","LRMIUT1",30,0)
 ;
"RTN","LRMIUT1",31,0)
 ;
"RTN","LRMIUT1",32,0)
APP ;
"RTN","LRMIUT1",33,0)
 N Q9,X,I
"RTN","LRMIUT1",34,0)
 S DT=$$DT^XLFDT
"RTN","LRMIUT1",35,0)
 S ^LRO(69,"AN",$E(LRLLOC,1,20),LRDFN,LRIDT)="",^LRO(69,LRCDT\1,1,"AL",$E(LRLLOC,1,20),$E(PNM,1,30),LRDFN)=""
"RTN","LRMIUT1",36,0)
 S ^LRO(69,DT,1,"AN",$E(LRLLOC,1,20),LRDFN,LRIDT)=""
"RTN","LRMIUT1",37,0)
 ;
"RTN","LRMIUT1",38,0)
 I LRVT["RE"!(LRVT["VT") S:LRVT=LRVTP ^LRO(69,DT,1,"AR",$E(LRLLOC,1,20),$E(PNM,1,30),LRDFN)="",^LRO(68,"MI",LRDFN,LRIDT,LRSB)=""
"RTN","LRMIUT1",39,0)
 ;
"RTN","LRMIUT1",40,0)
 I LRVT["VS",LRVT=LRVTP D
"RTN","LRMIUT1",41,0)
 . S ^LRO(69,DT,1,"AR",$E(LRLLOC,1,20),$E(PNM,1,30),LRDFN)=""
"RTN","LRMIUT1",42,0)
 . F LRSB=1,5,8,11,16 I $P($G(^LR(LRDFN,"MI",LRIDT,LRSB)),U,1) S ^LRO(68,"MI",LRDFN,LRIDT,LRSB)=""
"RTN","LRMIUT1",43,0)
 ;
"RTN","LRMIUT1",44,0)
 S Q9=+$P(^LR(LRDFN,"MI",LRIDT,0),U,7),^LRO(69,LRCDT\1,1,"AP",$S($D(^VA(200,Q9,0)):$E($P(^VA(200,Q9,0),U),1,20),1:"UNK"),$E(PNM,1,30),LRDFN)=""
"RTN","LRMIUT1",45,0)
 K ^LAC("LRKILL",LRDFN,"MI",LRIDT)
"RTN","LRMIUT1",46,0)
 ;
"RTN","LRMIUT1",47,0)
 I $D(^LRO(69,LRODT,1,LRSN,3)),'$P(^(3),U,2) S $P(^LRO(69,LRODT,1,LRSN,3),U,2)=$$NOW^XLFDT
"RTN","LRMIUT1",48,0)
 ;
"RTN","LRMIUT1",49,0)
 I $D(^LRO(69,LRODT,1,LRSN,3)) D
"RTN","LRMIUT1",50,0)
 . N X,Y,CORRECT
"RTN","LRMIUT1",51,0)
 . S:$G(LRCORECT) CORRECT=1
"RTN","LRMIUT1",52,0)
 . D NEW^LR7OB1(LRODT,LRSN,"RE")
"RTN","LRMIUT1",53,0)
 K LRVTP
"RTN","LRMIUT1",54,0)
 Q
"RTN","LRMIVER1")
0^14^B15654594
"RTN","LRMIVER1",1,0)
LRMIVER1 ;DALOI/STAFF - MICRO CHART COPY APPROVAL CONT. ;12/19/12  10:41
"RTN","LRMIVER1",2,0)
 ;;5.2;LAB SERVICE;**295,350,427**;Sep 27, 1994;Build 33
"RTN","LRMIVER1",3,0)
 ;
"RTN","LRMIVER1",4,0)
 ;from LRMIVER
"RTN","LRMIVER1",5,0)
 ;
"RTN","LRMIVER1",6,0)
APPROVE I '$O(^LRO(68,"AVS",LRAA,0)) W !,"No data." Q
"RTN","LRMIVER1",7,0)
 F I=0:0 W !!,"Do you wish to review the data as the (W)ards will see it, as the (L)ab",!,"will see it, or (N)ot review the data?  N// " R X:DTIME S:'$T X=U S:'$L(X) X="N" Q:X[U!("WLN"[X&($L(X)=1))  D INFO^LRMINEW
"RTN","LRMIVER1",8,0)
 Q:X[U  I X="N" D ACCEPT Q
"RTN","LRMIVER1",9,0)
 S:X="W" LRWRDVEW="" F I=0:0 W !,"Do you want to queue the data to print and approve it later" S %=1 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"
"RTN","LRMIVER1",10,0)
 Q:%<1  S ZTRTN="DQ^LRMIVER1" I %=1 S %ZIS="QM",%ZIS("B")="",IOP="Q"
"RTN","LRMIVER1",11,0)
 D IO^LRWU
"RTN","LRMIVER1",12,0)
 Q
"RTN","LRMIVER1",13,0)
 ;
"RTN","LRMIVER1",14,0)
DQ ;
"RTN","LRMIVER1",15,0)
 N LRMLTRPT ;multi report flag for RPT^LRMIPSZ1
"RTN","LRMIVER1",16,0)
 S LRMLTRPT=1
"RTN","LRMIVER1",17,0)
 S:$D(ZTQUEUED) ZTREQ="@" U IO
"RTN","LRMIVER1",18,0)
 S LREND=0,LRSB=0 K ^TMP($J) S LRAD=0 F I=0:0 S LRAD=+$O(^LRO(68,"AVS",LRAA,LRAD)) Q:LRAD<1  D SORT Q:LREND
"RTN","LRMIVER1",19,0)
 S LRONESPC="",LRONETST="" D PRINT
"RTN","LRMIVER1",20,0)
 Q
"RTN","LRMIVER1",21,0)
 ;
"RTN","LRMIVER1",22,0)
SORT S LRAN=0 F  S LRAN=+$O(^LRO(68,"AVS",LRAA,LRAD,LRAN)) Q:LRAN<1  D S1
"RTN","LRMIVER1",23,0)
 Q
"RTN","LRMIVER1",24,0)
 ;
"RTN","LRMIVER1",25,0)
S1 S LRDFN=+^LRO(68,"AVS",LRAA,LRAD,LRAN),LRIDT=$P(^(LRAN),U,2)
"RTN","LRMIVER1",26,0)
 I $D(^LR(LRDFN,"MI",LRIDT,0)) S LRVLOC=$S($L($P(^(0),U,8)):$P(^(0),U,8),1:0),^TMP($J,LRVLOC,LRDFN,LRIDT)=^(0)
"RTN","LRMIVER1",27,0)
 S ^TMP($J,LRVLOC,LRDFN,LRIDT,1)=LRAD
"RTN","LRMIVER1",28,0)
 Q
"RTN","LRMIVER1",29,0)
 ;
"RTN","LRMIVER1",30,0)
PRINT S LRVLOC="" F LRLCNT=0:0 S LRVLOC=$O(^TMP($J,LRVLOC)) Q:LRVLOC=""  S LRLTR=$E(LRVLOC,1,4) W @IOF D ^LRLTR:$E(IOST,1,2)'="C-",P1 Q:LREND
"RTN","LRMIVER1",31,0)
 Q
"RTN","LRMIVER1",32,0)
 ;
"RTN","LRMIVER1",33,0)
P1 S LRDFN=0 F  S LRDFN=+$O(^TMP($J,LRVLOC,LRDFN)) Q:LRDFN<1  D P2 Q:LREND
"RTN","LRMIVER1",34,0)
 Q
"RTN","LRMIVER1",35,0)
 ;
"RTN","LRMIVER1",36,0)
P2 S LRIDT=0 F  S LRIDT=+$O(^TMP($J,LRVLOC,LRDFN,LRIDT)) Q:LRIDT<1  D P3 Q:LREND
"RTN","LRMIVER1",37,0)
 Q
"RTN","LRMIVER1",38,0)
 ;
"RTN","LRMIVER1",39,0)
P3 S LRWLSAVE=LRAA,LRLLT=^TMP($J,LRVLOC,LRDFN,LRIDT),LRACC=$P(LRLLT,U,6),LRAD=$E(LRLLT)_$P(LRACC," ",2)_"0000",X=$P(LRACC," "),DIC=68,DIC(0)="M"
"RTN","LRMIVER1",40,0)
 D ^DIC S LRAA=+Y,LRAN=$P(LRACC," ",3),LRCMNT=$S($D(^LR(LRDFN,"MI",LRIDT,99)):^(99),1:""),LRPG=0 D EN^LRMIPSZ1 S LRAA=LRWLSAVE Q:LREND
"RTN","LRMIVER1",41,0)
 Q
"RTN","LRMIVER1",42,0)
 ;
"RTN","LRMIVER1",43,0)
ACCEPT W !!,"Indicate those you wish to exclude from verification." D LRAN^LRMIUT
"RTN","LRMIVER1",44,0)
 S LRAN=0 F  S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1  S LRAD=0 F  S LRAD=+$O(^LRO(68,"AVS",LRAA,LRAD)) Q:LRAD<1  K ^LRO(68,"AVS",LRAA,LRAD,LRAN)
"RTN","LRMIVER1",45,0)
 F  W !,"Ready to approve" S %=2 D YN^DICN Q:%  W !,"Answer 'Y'es or 'N'o"
"RTN","LRMIVER1",46,0)
 Q:%'=1  W !
"RTN","LRMIVER1",47,0)
 S LRAD=0 F  S LRAD=+$O(^LRO(68,"AVS",LRAA,LRAD)) Q:LRAD<1  D LRAD
"RTN","LRMIVER1",48,0)
 K LRWRDVEW,LRAD,LRAN,LRTK,Z
"RTN","LRMIVER1",49,0)
 Q
"RTN","LRMIVER1",50,0)
 ;
"RTN","LRMIVER1",51,0)
LRAD S LRAN=0 F  S LRAN=+$O(^LRO(68,"AVS",LRAA,LRAD,LRAN)) Q:LRAN<1  D STUFF
"RTN","LRMIVER1",52,0)
 Q
"RTN","LRMIVER1",53,0)
 ;
"RTN","LRMIVER1",54,0)
STUFF ;
"RTN","LRMIVER1",55,0)
 S LRDFN=+^LRO(68,"AVS",LRAA,LRAD,LRAN),LRIDT=$P(^(LRAN),U,2)
"RTN","LRMIVER1",56,0)
 D UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
"RTN","LRMIVER1",57,0)
 I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D
"RTN","LRMIVER1",58,0)
 . S LRODT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4),LRSN=$P(^(0),U,5),LRLLOC=$P(^(0),U,7)
"RTN","LRMIVER1",59,0)
 . S DFN=$P(^LR(LRDFN,0),U,3),LRDPF=$P(^(0),U,2),LRCDT=9999999-LRIDT
"RTN","LRMIVER1",60,0)
 . D PT^LRX S Y=DT D VT^LRMIUT1
"RTN","LRMIVER1",61,0)
 S ^LR(LRDFN,"MI",LRIDT,0)=$P(^LR(LRDFN,"MI",LRIDT,0),U,1,2)_U_LRNT_U_DUZ_U_$P(^(0),U,5,99)
"RTN","LRMIVER1",62,0)
 S LRSET=1,II=0
"RTN","LRMIVER1",63,0)
 F  S II=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,II)) Q:'II  I $P(^(II,0),U,5)="" S LRSET=0,LRTS=II
"RTN","LRMIVER1",64,0)
 ;F  S II=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,II)) Q:I<1  I '$L($P(^(II,0),U,5)) S LRSET=0,LRTS=II
"RTN","LRMIVER1",65,0)
 S:LRSET $P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)=LRNT W "."
"RTN","LRMIVER1",66,0)
 F II=1,5,8,11,16 I $D(^LR(LRDFN,"MI",LRIDT,II)),$P(^(II),U) D 
"RTN","LRMIVER1",67,0)
 . K ^LRO(68,LRAA,1,LRAD,"AC",II,LRAN)
"RTN","LRMIVER1",68,0)
 . S LRSB=II
"RTN","LRMIVER1",69,0)
 ;
"RTN","LRMIVER1",70,0)
 I $G(LRSS)="" S LRSS="MI"
"RTN","LRMIVER1",71,0)
 D SETRL^LRVERA(LRDFN,LRSS,LRIDT,DUZ(2))
"RTN","LRMIVER1",72,0)
 ;
"RTN","LRMIVER1",73,0)
 ; If this accession originated via a LEDI order then return results to the collecting site.
"RTN","LRMIVER1",74,0)
 D LEDI^LRVR0
"RTN","LRMIVER1",75,0)
 Q
"RTN","LRORDK")
0^46^B16287441
"RTN","LRORDK",1,0)
LRORDK ;SLC/FHS - CLEAN UP AFTER ACCESSIONING PROCESS ;8/7/89  13:58
"RTN","LRORDK",2,0)
 ;;5.2;LAB SERVICE;**61,100,121,153,201,427**;Sep 27, 1994;Build 33
"RTN","LRORDK",3,0)
EN ;
"RTN","LRORDK",4,0)
KILL K LRSD,LRXDFN,LRXDPF,LR696IEN,LABTEST,LRCYWKLD
"RTN","LRORDK",5,0)
 K %,A,D,DO,DA,DFN,DIC,DQ,DTOUT,DX,H8,J,K,L,LRAA,LRACC,LRAD,LRAN,LRCCOM,LRCDT,LRCSN,LRD,LRDFN,LRDPF,LREAL,LREDO,LREND,LREXP,LRIDT,LRIN,LRIX,LRLBLBP,LRLLOC,LRM,LRN,LRNT,LRORD,LROUTINE,LRPR,LRPRAC,LRRB,LRSN,LRSSP,LRSSX,LRST,LRSUM
"RTN","LRORDK",6,0)
 K I9,LRTEST,LRZT,LRORDTIM,LRSX,LRSXN,LRTX,LRTSTNM,LRUNQ,LRWLC,LRWP,LRWPD,LRYR,PNM,S,SSN,X,Y,Z,LRFIRST,LRSAME,LRSAMP,LRSPEC,LRORDR,LRECT,LRODT,LRURG,LRFLOG,LRCS,LROT,LROLLOC,LRTREA
"RTN","LRORDK",7,0)
 K LRBED,LRCSS,LRDTO,LRK,LRLWC,LRORDER,LRTP,LRTSTS,LRUR,LRUSI,LRUSNM,LRSLIP,I7,%H,%X,%Y,DIWL,DIWR,DPF,I1,I2,I5,LABEL,LRADDTST,LRCE,LRDAT,LRECOM,LRINFW,LRIOZERO,LRNCWL,LRNIDT,LRNOLABL,LROCN,LROID,LROLRDFN,LRORIFN,LROSN,LRPHSET,LRPREF
"RTN","LRORDK",8,0)
 K LRSPCDSC,LRSVSN,LRTJ,LRTOP,LRTS,LRTXD,LRTXP,LRWL0,LRWPC,LRXL,S5,LRACD,LRACN,LRACN0,LRDOC,LRLL,LROD0,LROD1,LROD3,LROS,LROSD,LRROD,LRTT,T,X,X1,X2,X3,X4,Z,LRIDIV,LRCOM,LRNATURE,LRTCOM
"RTN","LRORDK",9,0)
 K LRIO,LRJ,LROOS,LRSS,LRTN,LRTIME,LRIO,LRURGG,LRLWCURG,LRCAPLOC,LRDAX,LRDMAX,LRDTST,LRTMAX,LRSAMPX,TT,LRMAX1,LROUT,LRSAVE,LRMAX2,LRMAXX,LRTY,LRSPN,DR,DIR,VA("PID"),VA("BID")
"RTN","LRORDK",10,0)
 D KVAR^VADPT
"RTN","LRORDK",11,0)
 K LRDPTDFN,LRI,LRIEN,LRNLT,LRODTSV,LRORU3,LRPAT,LRPCEVSO
"RTN","LRORDK",12,0)
 K LRREFBAR,LRRSITE,LRRUID,LRSNSV,LRTREAT,LRTSORU,LRUID,LRWRD
"RTN","LRORDK",13,0)
 K NOW,SEX,LRTNSV,LRORDRR,AGE,LRRSTAT,DUOUT,LRRIEN,DIRUT,DOB,C,LRVV
"RTN","LRORDK",14,0)
 K LRAFJDFN,LRDPTDFN,D0,ANS,LRY,D1,X,DI
"RTN","LRORDK",15,0)
 K ^TMP("LRSTIK",$J)
"RTN","LRORDK",16,0)
 D ^%ZISC
"RTN","LRORDK",17,0)
 Q
"RTN","LRORDK",18,0)
LROEND ;KILL LROE ROUTINE VARIABLES
"RTN","LRORDK",19,0)
 K %,A,AGE,DFN,DIC,DL,DOB,DR,DX,H8,J,K,LRAA,LRACC,LRAD,LRAN,LRCCOM,LRCDT,LRCHK,LRCOM,LRCS,LRCSN,LRCSP,LRCSX,LRD,LRDAX,LRDFN,LRDPF,LREAL,LREND,LREXP,LRIDT,LRIN,LRIX,LRLBLBP,LRLLOC,LRLWC,LRMAX,LRMOR,LRNN,LRNT,LRODT,LROLLOC,LRTREA,LRSPCDSC
"RTN","LRORDK",20,0)
 K LRORD,LRPR,LRPRAC,LRRB,LRSAMP,LRSNO,LRSPEC,LRSSP,LRST,LRSTATUS,LRTEST,LRTIM,LRTM7,LRTN,LRTS,LRTSTN,LRTY,LRUN,LRUNQ,LRURG,LRWL0,LRWLC,LRWRD,LRXS,LRXST,LRYR,M9,PNM,S,SEX,SSN,T,X,X1,X3,Y,Z,VA("BID"),VA("PID"),LRTCOM
"RTN","LRORDK",21,0)
 K %H,%X,%Y,DICS,DO,DPF,DSC,G1,G2,G4,I1,I2,I7,J1,LABEL,LOC,LRACD,LRADDTST,LRAOD,LRCE,LRDC,LRECOM,LRECT,LREDO,LREXEC,LRFLOG,LRGVP,LRINFW,LRIOZERO,LRK,LRNIDT,LRNONE,LROLRDFN,LRORDR,LRORDTIM,LRORIFN,LRPER,LRPHSET,LRPLOC,LRPREF
"RTN","LRORDK",22,0)
 K LRQUICK,LRRND,LRSLIP,LRSSQ,LRSSX,LRSVSN,LRSX,LRSXN,LRTEC,LRTJ,LRTOP,LRTSN,LRTXD,LRTXP,LRVOL,LRWP,LRWPC,LRWPD,LRWRDS,LRXL,LRZX,Z1,Z2,LRSN1,LRSAME,ZTSK,DIR,LRLABLIO,LRNATURE
"RTN","LRORDK",23,0)
 K ^TMP("LRSTIK",$J)
"RTN","LRORDK",24,0)
 D KVAR^VADPT D ^%ZISC
"RTN","LRORDK",25,0)
 Q
"RTN","LRPHSET2")
0^13^B27649309
"RTN","LRPHSET2",1,0)
LRPHSET2 ;DALOI/STAFF - COLLECTION LIST TO ACCESSIONS CONT ;12/13/12  12:13
"RTN","LRPHSET2",2,0)
 ;;5.2;LAB SERVICE;**121,202,350,427**;Sep 27, 1994;Build 33
"RTN","LRPHSET2",3,0)
 ;
"RTN","LRPHSET2",4,0)
REUP ;FROM LRPHSET1 - ADD TO OR REBUILD TO COLLECTION LIST
"RTN","LRPHSET2",5,0)
 N LRORDTYP
"RTN","LRPHSET2",6,0)
 S $P(LRORDTYP,"^",2)=$$FIND1^DIC(64.061,"","OX","L","D","I $P(^(0),U,5)=""0065""")
"RTN","LRPHSET2",7,0)
 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
"RTN","LRPHSET2",8,0)
 S LRRB=0
"RTN","LRPHSET2",9,0)
 I LRDPF=2 S LRRB=$$GET1^DIQ(2,DFN_",",.101),LRRB=$S(LRRB'="":LRRB,1:0)
"RTN","LRPHSET2",10,0)
 ;
"RTN","LRPHSET2",11,0)
 S I=0
"RTN","LRPHSET2",12,0)
 F  S I=$O(^LRO(69,DT,1,LRSN,2,I)) Q:I<1  S X=^(I,0) I $P(X,U,3)'="" S LRAA($P(X,U,4))=$P(X,U,3)_"^"_$P(X,U,4)_"^"_$P(X,U,5)
"RTN","LRPHSET2",13,0)
 ;
"RTN","LRPHSET2",14,0)
 S LRK=0
"RTN","LRPHSET2",15,0)
 F  S LRK=$O(^LRO(69,DT,1,LRSN,2,LRK)) Q:LRK<1  S X=^(LRK,0) I $P(X,U,3)="",'$P(X,"^",11) D
"RTN","LRPHSET2",16,0)
 . S LRTS=+X,LRAA=$S($D(^LAB(60,LRTS,8,DUZ(2),0)):$P(^(0),U,2),1:"")
"RTN","LRPHSET2",17,0)
 . I LRAA'="",$D(LRAA(LRAA)),$P(^LAB(60,LRTS,0),U,7)'=1 D JAM
"RTN","LRPHSET2",18,0)
 ;
"RTN","LRPHSET2",19,0)
 S LRI=0
"RTN","LRPHSET2",20,0)
 F  S LRI=$O(^LRO(69,DT,1,LRSN,2,LRI)) Q:LRI<1  S X=^(LRI,0) I '$P(X,U,6),$P(X,U,3) D
"RTN","LRPHSET2",21,0)
 . S LRTSTN=+X,LRAD=$P(X,U,3),LRAA=$P(X,U,4),LRAN=$P(X,U,5)
"RTN","LRPHSET2",22,0)
 . I '$D(^LRO(69.1,"LRPH",LRTE,LRLLOC,LRRB,LRDFN,LRSN,LRAA,LRAN,+LRTSTN)) D REUP1
"RTN","LRPHSET2",23,0)
 I $D(REUP) S LRCOUNT=LRCOUNT+1,^LRO(69,DT,1,LRSN,3)=LRDTI
"RTN","LRPHSET2",24,0)
 I '$D(REUP) S $P(^LRO(69,DT,1,LRSN,1),U)=$P(^LRO(69,DT,1,LRSN,3),U)
"RTN","LRPHSET2",25,0)
 K LRAD,LRI,LRAN,LRAA,LRDPF,DFN,LRZ3,LRZB,LRZ1,LRTSTN,LRRB,LRURG,REUP,I,J,LRK,F,LRAODT,LRWRD
"RTN","LRPHSET2",26,0)
 Q
"RTN","LRPHSET2",27,0)
 ;
"RTN","LRPHSET2",28,0)
REUP1 L +^LRO(69.1,LRTE):90 I '$T G REUP1
"RTN","LRPHSET2",29,0)
 S LRZ3=$S($D(^LRO(69.1,LRTE,1,0)):$P(^(0),U,3),1:0)
"RTN","LRPHSET2",30,0)
 I '$D(^LRO(69.1,"LRPH",LRTE,LRLLOC,LRRB,LRDFN,LRSN,LRAA,LRAN)) S REUP=1
"RTN","LRPHSET2",31,0)
 ;
"RTN","LRPHSET2",32,0)
REUP2 S LRZ3=LRZ3+1
"RTN","LRPHSET2",33,0)
 G:$D(^LRO(69.1,LRTE,1,LRZ3)) REUP2
"RTN","LRPHSET2",34,0)
 S LRZO="^LRO(69.1,"_LRTE_",1,",LRZ1="69.11P",LRZB=+LRTSTN,LRIFN=LRZ3
"RTN","LRPHSET2",35,0)
 D Z^LRWU
"RTN","LRPHSET2",36,0)
 L -^LRO(69.1,LRTE)
"RTN","LRPHSET2",37,0)
 S ^LRO(69.1,LRTE,1,LRIFN,0)=+LRTSTN_"^"_LRLLOC_"^"_LRRB_"^"_LRDFN_"^"_LRSN_"^"_LRTJ_"^"_LRAD_"^"_LRAA_"^"_LRAN_"^"_LROLLOC,^LRO(69.1,"LRPH",LRTE,LRLLOC,LRRB,LRDFN,LRSN)=LRTJ_"^"_LRAD_"^"_LRIFN,^(LRSN,LRAA,LRAN,+LRTSTN)=+LRTSTN
"RTN","LRPHSET2",38,0)
 Q
"RTN","LRPHSET2",39,0)
 ;
"RTN","LRPHSET2",40,0)
JAM ;
"RTN","LRPHSET2",41,0)
 S LRAA=$P(LRAA(LRAA),U,2),LRAD=$P(LRAA(LRAA),U),LRAODT=LRAD,LRAN=$P(LRAA(LRAA),U,3),(LRURG,Y)=$P(X,U,2)
"RTN","LRPHSET2",42,0)
 D EN^LRTSTSET
"RTN","LRPHSET2",43,0)
 Q
"RTN","LRPHSET2",44,0)
 ;
"RTN","LRPHSET2",45,0)
S7 ;FROM LRPHSET1 - COMBINE OR MERGE TESTS ON ORDERS
"RTN","LRPHSET2",46,0)
 S T=0 F  S T=$O(T(LRSAMP,T)) Q:T<1  D S7A
"RTN","LRPHSET2",47,0)
 Q
"RTN","LRPHSET2",48,0)
S7A S LRPSN=0 F  S LRPSN=$O(T(LRSAMP,T,LRPSN)) Q:LRPSN<1  D @$S(LRSTEP=0:"S8",1:"S9")
"RTN","LRPHSET2",49,0)
 Q
"RTN","LRPHSET2",50,0)
S8 S J=T
"RTN","LRPHSET2",51,0)
 D COMBINE
"RTN","LRPHSET2",52,0)
 S J=0 F  S J=$O(T(LRSAMP,J)) Q:J<1  D SCAN60
"RTN","LRPHSET2",53,0)
 Q
"RTN","LRPHSET2",54,0)
S9 S J=0 F  S J=$O(T(LRSAMP,J)) Q:J<1  D MERG
"RTN","LRPHSET2",55,0)
 Q
"RTN","LRPHSET2",56,0)
SCAN60 S K=0 F  S K=$O(^LAB(60,T,2,K)) Q:K<1  I +^(K,0)=J S LRSN=0,LRSN=$O(T(LRSAMP,J,LRSN)) D @$S(LRPSN>LRSN:"MERG",1:"COMBINE")
"RTN","LRPHSET2",57,0)
 Q
"RTN","LRPHSET2",58,0)
COMBINE S LRSN=0 F  S LRSN=$O(T(LRSAMP,J,LRSN)) Q:LRSN<1  D:LRPSN>LRSN SWAP I LRSN'=LRPSN D CB2
"RTN","LRPHSET2",59,0)
 Q
"RTN","LRPHSET2",60,0)
CB2 I $P(^LRO(69,DT,1,LRSN,2,+T(LRSAMP,J,LRSN),0),U,6)'="",$D(^LRO(69,DT,1,LRSN,.1)),$D(^LRO(69,DT,1,+$O(^LRO(69,"C",+^(.1),DT,0)),1)),$P(^(1),U,4)'="" Q
"RTN","LRPHSET2",61,0)
 I $P(T(LRSAMP,T,LRPSN),U,2)'=$P(T(LRSAMP,J,LRSN),U,2) D URGENCY S $P(^LRO(69,DT,1,LRPSN,2,+T(LRSAMP,T,LRPSN),0),U,2)=LRURG
"RTN","LRPHSET2",62,0)
 S $P(^LRO(69,DT,1,LRPSN,2,+T(LRSAMP,T,LRPSN),0),"^",14)=DT_";"_LRSN_";"_+T(LRSAMP,J,LRSN)
"RTN","LRPHSET2",63,0)
 N X,XI,X1,I,TST
"RTN","LRPHSET2",64,0)
 S X1=^LRO(69,DT,1,LRPSN,.1),TST=^LRO(69,DT,1,LRSN,2,+T(LRSAMP,J,LRSN),0),$P(^(0),U,6)=X1,$P(^LRO(69,DT,1,LRSN,1),U,4)="M",XI=$P(^(1),U,7),XI=XI_X1_"/",$P(^(1),U,7)=XI
"RTN","LRPHSET2",65,0)
 D OERR(TST)
"RTN","LRPHSET2",66,0)
 K T(LRSAMP,J,LRSN)
"RTN","LRPHSET2",67,0)
 Q
"RTN","LRPHSET2",68,0)
 ;
"RTN","LRPHSET2",69,0)
MERG S LRSN=0 F  S LRSN=$O(T(LRSAMP,J,LRSN)) Q:LRSN<1  D:LRPSN>LRSN SWAP,SWAP1 I LRSN'=LRPSN D M1
"RTN","LRPHSET2",70,0)
 Q
"RTN","LRPHSET2",71,0)
 ;
"RTN","LRPHSET2",72,0)
M1 Q:$P(^LRO(69,DT,1,LRSN,2,+T(LRSAMP,J,LRSN),0),U,6)'=""
"RTN","LRPHSET2",73,0)
 S X=$P(^LRO(69,DT,1,LRPSN,2,0),"^",3)
"RTN","LRPHSET2",74,0)
LP S X=X+1
"RTN","LRPHSET2",75,0)
 I $D(^LRO(69,DT,1,LRPSN,2,X)) G LP
"RTN","LRPHSET2",76,0)
 S ^LRO(69,DT,1,LRPSN,2,X,0)=^LRO(69,DT,1,LRSN,2,+T(LRSAMP,J,LRSN),0),$P(^(0),"^",14)=DT_";"_LRSN_";"_+T(LRSAMP,J,LRSN),^LRO(69,DT,1,LRPSN,2,"B",J,X)="",$P(^LRO(69,DT,1,LRPSN,2,0),"^",3,4)=X_"^"_X
"RTN","LRPHSET2",77,0)
 N I,XI,X1,TST
"RTN","LRPHSET2",78,0)
 S X1=^LRO(69,DT,1,LRPSN,.1),$P(^LRO(69,DT,1,LRSN,2,+T(LRSAMP,J,LRSN),0),"^",6)=X1
"RTN","LRPHSET2",79,0)
 S TST=^LRO(69,DT,1,LRPSN,2,X,0),LRURG=$P(TST,"^",2),T(LRSAMP,J,LRPSN)=T(LRSAMP,J,LRSN),$P(T(LRSAMP,J,LRPSN),"^")=X
"RTN","LRPHSET2",80,0)
 S $P(^LRO(69,DT,1,LRSN,1),U,4)="M",XI=$P(^(1),U,7),XI=XI_X1_"/",$P(^LRO(69,DT,1,LRSN,1),U,7)=XI
"RTN","LRPHSET2",81,0)
 D OERR(TST)
"RTN","LRPHSET2",82,0)
 K T(LRSAMP,J,LRSN)
"RTN","LRPHSET2",83,0)
 Q
"RTN","LRPHSET2",84,0)
 ;
"RTN","LRPHSET2",85,0)
SWAP S LRSWAP=LRSN,LRSN=LRPSN,LRPSN=LRSWAP K LRSWAP
"RTN","LRPHSET2",86,0)
 Q
"RTN","LRPHSET2",87,0)
 ;
"RTN","LRPHSET2",88,0)
SWAP1 S LRSWAP=J,J=T,T=LRSWAP
"RTN","LRPHSET2",89,0)
 Q
"RTN","LRPHSET2",90,0)
 ;
"RTN","LRPHSET2",91,0)
URGENCY S LRURG1=$P(T(LRSAMP,T,LRPSN),U,2),LRURG2=$P(T(LRSAMP,J,LRSN),U,2),LRURG=$S(LRURG1<LRURG2:LRURG1,1:LRURG2)
"RTN","LRPHSET2",92,0)
 K LRURG1,LRURG2
"RTN","LRPHSET2",93,0)
 Q
"RTN","LRPHSET2",94,0)
 ;
"RTN","LRPHSET2",95,0)
OERR(TSTNODE) ;OE/RR - CPRS calls
"RTN","LRPHSET2",96,0)
 N X,TTT,LRNATURE,LRSJ ;OE/RR 3.0
"RTN","LRPHSET2",97,0)
 S LRSJ=J,X=$O(^ORD(100.03,"C","LRDUP",0)),LRNATURE=$$DC1^LROR6(X,"Combined with LB #"_X1)
"RTN","LRPHSET2",98,0)
 S TTT(+TSTNODE)="",DIE="^LRO(69,DT,1,LRSN,2,",DA=+T(LRSAMP,LRSJ,LRSN),DA(1)=LRSN,DA(2)=DT,DR="99.1///DUPLICATE TEST: "_$S($P($G(LRNATURE),"^",5)'="":$P(LRNATURE,"^",5),1:"")
"RTN","LRPHSET2",99,0)
 D ^DIE
"RTN","LRPHSET2",100,0)
 D NEW^LR7OB1(DT,LRSN,"OC",$G(LRNATURE),.TTT)
"RTN","LRPHSET2",101,0)
 S $P(^LRO(69,DT,1,LRSN,2,+T(LRSAMP,LRSJ,LRSN),0),"^",3,5)="^^",$P(^(0),"^",9,11)="CA^L^"_DUZ,J=LRSJ
"RTN","LRPHSET2",102,0)
 Q
"RTN","LRRMM")
0^19^B37494738
"RTN","LRRMM",1,0)
LRRMM ;DALOI/JMC/SED - Lab Reports via Network Mail ;01/29/13  10:26
"RTN","LRRMM",2,0)
 ;;5.2;LAB SERVICE;**164,427**;Sep 27, 1994;Build 33
"RTN","LRRMM",3,0)
 ;
"RTN","LRRMM",4,0)
 ;
"RTN","LRRMM",5,0)
LAB ;Requires Lab 5.0 and Mailman 7.0 (Spooling to XMBS GlobaL)
"RTN","LRRMM",6,0)
 ;Enter with LRRLROC=Interim Report Location (File 44 Abbreviation)
"RTN","LRRMM",7,0)
 ;    LRRVDT=Date to produce reports for (i.e. "T-1" would
"RTN","LRRMM",8,0)
 ;           produce reports for work verified yesterday)
"RTN","LRRMM",9,0)
 ;    LRRDEV=Name of the spool Device.
"RTN","LRRMM",10,0)
 ;           Default is "SPOOL80"  if not defined.
"RTN","LRRMM",11,0)
 ;   LRRSITE=Name Of Referring Lab (Should be domain file
"RTN","LRRMM",12,0)
 ;           entry i.e "MILWAUKEE.DOMAIN.EXT")
"RTN","LRRMM",13,0)
 ;   LRRNORP=1 If "NEGATIVE" Mail Messages are -NOT- Required.
"RTN","LRRMM",14,0)
 ;
"RTN","LRRMM",15,0)
 N LRRMMPG1
"RTN","LRRMM",16,0)
 ;
"RTN","LRRMM",17,0)
 S U="^" S:'$D(DTIME) DTIME=600
"RTN","LRRMM",18,0)
 S:'$D(LRRNORP) LRRNORP=0 S X=$S($D(LRRVDT):LRRVDT,1:"T-1"),%DT="" D ^%DT Q:Y<1  S LRRVDT=Y D DD^LRX S LRRDATE=Y D ^LRPARAM
"RTN","LRRMM",19,0)
 I '$D(^LRO(69,LRRVDT,1,"AN",LRRLROC))&(LRRNORP) Q
"RTN","LRRMM",20,0)
 S:$G(LRRDEV)="" LRRDEV="SPOOL80"
"RTN","LRRMM",21,0)
 D NOW^%DTC
"RTN","LRRMM",22,0)
 S LRRNAME="LAB REPORTS "_$P(LRRSITE,".",1)_" "_%,IO("DOC")=LRRNAME,IOP=LRRDEV_";"_IO("DOC") D ^%ZIS
"RTN","LRRMM",23,0)
 S (LRLAB,LREND,LRSTOP,LRFOOT)=0,(LRH,LRONESPC,LRONETST)="",LRCW=8,LRHF=1
"RTN","LRRMM",24,0)
 U IO I '$D(^LRO(69,LRRVDT,1,"AN",LRRLROC)) W !,"No reports to transmit today." G MAIL
"RTN","LRRMM",25,0)
 ;
"RTN","LRRMM",26,0)
 S LRRMMPG1=1 ; Flag for first-page. After first report is printed, set flag to 0.
"RTN","LRRMM",27,0)
 ;
"RTN","LRRMM",28,0)
 S LRDFN=0
"RTN","LRRMM",29,0)
 F  S LRDFN=$O(^LRO(69,LRRVDT,1,"AN",LRRLROC,LRDFN)) Q:LRDFN<1  D
"RTN","LRRMM",30,0)
 . ;
"RTN","LRRMM",31,0)
 . S LROC=LRRLROC
"RTN","LRRMM",32,0)
 . I LRFOOT D FOOT^LRRP1
"RTN","LRRMM",33,0)
 . S LRFOOT=0,LRHF=1
"RTN","LRRMM",34,0)
 . S LRDPF=$P(^LR(LRDFN,0),U,2)
"RTN","LRRMM",35,0)
 . S DFN=$P(^LR(LRDFN,0),U,3)
"RTN","LRRMM",36,0)
 . D PT^LRX
"RTN","LRRMM",37,0)
 . ;
"RTN","LRRMM",38,0)
 . S LRIDT=0
"RTN","LRRMM",39,0)
 . F  S LRIDT=$O(^LRO(69,LRRVDT,1,"AN",LRRLROC,LRDFN,LRIDT)) Q:LRIDT<1  D
"RTN","LRRMM",40,0)
 . . ;
"RTN","LRRMM",41,0)
 . . I $D(^LR(LRDFN,"CH",LRIDT)) D
"RTN","LRRMM",42,0)
 . . . D CH^LRRP2
"RTN","LRRMM",43,0)
 . . . S LRRMMPG1=0 ; set "first-page flag" to 0
"RTN","LRRMM",44,0)
 . . ;
"RTN","LRRMM",45,0)
 . . I $D(^LR(LRDFN,"MI",LRIDT)) D
"RTN","LRRMM",46,0)
 . . . ; print form-feed before printing Micro report
"RTN","LRRMM",47,0)
 . . . ; (did not use LRMLTRPT flag (used by RPT^LRMIPSZ1 to print form-feed) - as there it prints form-feed AFTER
"RTN","LRRMM",48,0)
 . . . ;  the report and Chem prints the form-feed BEFORE the report, and we need them to be consistent here)
"RTN","LRRMM",49,0)
 . . . I LRFOOT D FOOT^LRRP1 S LRFOOT=0 ; print footer of prev report before form-feed
"RTN","LRRMM",50,0)
 . . . I $G(IOF)'="",'LRRMMPG1 W @IOF
"RTN","LRRMM",51,0)
 . . . ;
"RTN","LRRMM",52,0)
 . . . D MI^LRRP2
"RTN","LRRMM",53,0)
 . . . S LRRMMPG1=0 ; set "first-page flag" to 0
"RTN","LRRMM",54,0)
 ;
"RTN","LRRMM",55,0)
 D MAIL
"RTN","LRRMM",56,0)
 ;
"RTN","LRRMM",57,0)
 Q
"RTN","LRRMM",58,0)
 ;
"RTN","LRRMM",59,0)
MAIL ; Send the message
"RTN","LRRMM",60,0)
 ;
"RTN","LRRMM",61,0)
 D:LRFOOT FOOT^LRRP1 W ! D ^%ZISC,KILL^XM
"RTN","LRRMM",62,0)
 S XMDF=1,XMDUZ=DUZ,X="G.LAB REPORT" D WHO^XMA21
"RTN","LRRMM",63,0)
 S X="G.LAB REPORT@"_LRRSITE D INST^XMA21
"RTN","LRRMM",64,0)
 S XMSUB=^DD("SITE")_" LAB REPORTS FOR "_$P(LRRSITE,".",1)_" ON "_LRRDATE
"RTN","LRRMM",65,0)
 D TSK^LRRMM
"RTN","LRRMM",66,0)
 Q
"RTN","LRRMM",67,0)
 ;
"RTN","LRRMM",68,0)
ONELOC ;Entry point to create lab reports for one location.
"RTN","LRRMM",69,0)
 D LAB,KILL Q
"RTN","LRRMM",70,0)
 ;
"RTN","LRRMM",71,0)
MANYLOC ;Entry point to create lab reports for several sites.
"RTN","LRRMM",72,0)
 ;Enter with LRRLST=List of File #44 Locations (abbreviations)
"RTN","LRRMM",73,0)
 ;Separated by ";" (i.e. LRRLST="XXX;YYY")
"RTN","LRRMM",74,0)
 ;LRRDLST=List of corresponding domain names to send reports
"RTN","LRRMM",75,0)
 ;         to (i.e. LRRDLST="AAA.DOMAIN.EXT;BBB.DOMAIN.EXT")
"RTN","LRRMM",76,0)
 F LRRZZ=1:1 S LRRLROC=$P(LRRLST,";",LRRZZ) Q:LRRLROC=""  S LRRSITE=$P(LRRDLST,";",LRRZZ) D LAB
"RTN","LRRMM",77,0)
 D KILL Q
"RTN","LRRMM",78,0)
 ;
"RTN","LRRMM",79,0)
ALLOC ;Entry point to send lab reports to all locations defined in
"RTN","LRRMM",80,0)
 ;file #64.6 (interim reports) that have a domain name entered.
"RTN","LRRMM",81,0)
 ;This requires a field "domain name" being added to #64.6 at
"RTN","LRRMM",82,0)
 ;subscript ^LAB(64.6,D0,0), this is a pointer to the domain file.
"RTN","LRRMM",83,0)
 S LRRZZ=0
"RTN","LRRMM",84,0)
 F  S LRRZZ=$O(^LAB(64.6,LRRZZ)) Q:'LRRZZ  D
"RTN","LRRMM",85,0)
 .S LRRZZ(0)=+$P($G(^LAB(64.6,LRRZZ,0)),U,7)
"RTN","LRRMM",86,0)
 .I LRRZZ(0) S LRRLROC=$P($G(^SC(+$P(^LAB(64.6,LRRZZ,0),"^"),0)),"^",2),LRRSITE=$P($G(^DIC(4.2,LRRZZ(0),0)),"^") I LRRLROC]"",LRRSITE]"" D LAB
"RTN","LRRMM",87,0)
 D KILL Q
"RTN","LRRMM",88,0)
 ;
"RTN","LRRMM",89,0)
KILL ;Cleanup before leaving.
"RTN","LRRMM",90,0)
 S:$D(ZTQUEUED) ZTREQ="@"
"RTN","LRRMM",91,0)
 K %,%DT,DFN,LRCW,LRDFN,LRDPF,LREND,LRFOOT,LRH,LRHF,LRIDT,LRLAB,LROC
"RTN","LRRMM",92,0)
 K LRONESPC,LRONETST,LRSTOP,IOP,X,XMDF,Y,ZZ,LRRDATE,LRRDLST
"RTN","LRRMM",93,0)
 K LRRLROC,LRRLST,LRRNAME,LRRNORP,LRRSITE,LRRVDT,LRRZZ,LRRDEV
"RTN","LRRMM",94,0)
 D V^LRU,^LRKILL,KILL^XM
"RTN","LRRMM",95,0)
 Q
"RTN","LRRMM",96,0)
TSK ;Entry point from taskman to load a spool file into message.
"RTN","LRRMM",97,0)
 ;Enter with XMSUB=header,XMY(SENDEE NAMES)=""
"RTN","LRRMM",98,0)
 ;LRRNAME=name of spool document file to load into message.
"RTN","LRRMM",99,0)
 K DIC S:'$D(DTIME) DTIME=300
"RTN","LRRMM",100,0)
 S U="^",X=LRRNAME,DIC=3.51,DIC(0)="MZ"
"RTN","LRRMM",101,0)
 D ^DIC Q:Y<1  S DA=+Y,ZISPL0=Y(0),ZISDA=DA K DIC
"RTN","LRRMM",102,0)
DQMAIL W:'$D(ZTQUEUED) !,"Moving it..."
"RTN","LRRMM",103,0)
 S XS=$P(ZISPL0,"^",10),XMY(DUZ)="",XMTEXT="^XMBS(3.519,"_XS_",2,"
"RTN","LRRMM",104,0)
 D:XS>0 ^XMD D DSDOC^ZISPL(ZISDA),DSD^ZISPL(XS) W:'$D(ZTQUEUED) !,"  Now a normal mail message.."
"RTN","LRRMM",105,0)
 I $G(XMZ) S XMDUZ=DUZ D NNEW^XMA ;Make message new for recipient.
"RTN","LRRMM",106,0)
 D KILL1 Q
"RTN","LRRMM",107,0)
 ;
"RTN","LRRMM",108,0)
PRINT ;Entry point from menu option to extract text of message and print it.
"RTN","LRRMM",109,0)
 D HOME^%ZIS K DIC
"RTN","LRRMM",110,0)
ASK ;Select the mailman basket.
"RTN","LRRMM",111,0)
 S DIC="^XMB(3.7,DUZ,2,",DIC(0)="AEMNQ",DIC("A")="Select Mail Basket: "
"RTN","LRRMM",112,0)
 S DIC("B")="IN"
"RTN","LRRMM",113,0)
 W ! D ^DIC G:Y<1 KILL1 S LRRMK=+Y,LRRMKN=$P(Y,"^",2)
"RTN","LRRMM",114,0)
 K ^TMP($J) S (LRRMC,LRRMZ1)=0
"RTN","LRRMM",115,0)
 F  S LRRMZ1=$O(^XMB(3.7,DUZ,2,LRRMK,1,LRRMZ1)) Q:LRRMZ1<1  D
"RTN","LRRMM",116,0)
 .S J=+^(LRRMZ1,0)
"RTN","LRRMM",117,0)
 .Q:$P($G(^XMB(3.9,J,0)),U,1)'["LAB REPORT"
"RTN","LRRMM",118,0)
 .S LRRMC=LRRMC+1,^TMP($J,"B",LRRMC)=J
"RTN","LRRMM",119,0)
 W "  ",$S(LRRMC=0:"No Lab",1:LRRMC)," Message",$S(LRRMC'=1:"s",1:"")," in basket." G:LRRMC=0 ASK
"RTN","LRRMM",120,0)
LIST ;Select the message.
"RTN","LRRMM",121,0)
 W @IOF,!,"Select from the following:" S (LRRMZ,LRROUT,I)=0
"RTN","LRRMM",122,0)
 F  S I=$O(^TMP($J,"B",I)) Q:'I  S LRRMZ=^TMP($J,"B",I) D  Q:LRROUT
"RTN","LRRMM",123,0)
 .I $Y>(IOSL-5) K DIR S DIR(0)="E" D ^DIR K DIR S LRROUT=Y-1 W @IOF Q:LRROUT
"RTN","LRRMM",124,0)
 .S LRRMR=$G(^XMB(3.9,LRRMZ,0)) Q:LRRMR=""  S LRRMSUB=$P(LRRMR,U,1)
"RTN","LRRMM",125,0)
 .I LRRMSUB["~U~" F  S LRRMSUB=$P(LRRMSUB,"~U~",1)_"^"_$P(LRRMSUB,"~U~",2,99) Q:LRRMSUB'["~U~"
"RTN","LRRMM",126,0)
 .W !,I," Subj: ",LRRMSUB,"  "
"RTN","LRRMM",127,0)
 .S Y=$P(LRRMR,U,3),X1=+$P($G(^XMB(3.9,LRRMZ,2,0)),"^",4)
"RTN","LRRMM",128,0)
 .I Y'?7N.E W Y
"RTN","LRRMM",129,0)
 .E  W $E(Y,4,5),"/",$E(Y,6,7),"/",$E(Y,2,3)," " S Y=$P(Y,".",2)_"0000" W "@ ",$E(Y,1,2),":",$E(Y,3,4)
"RTN","LRRMM",130,0)
 .W "  ",X1," Line",$S(X1>1:"s",1:"")
"RTN","LRRMM",131,0)
 Q:LRROUT
"RTN","LRRMM",132,0)
 K DIR S DIR(0)="NO^1:"_LRRMC_":0"
"RTN","LRRMM",133,0)
 S DIR("A")="Select Message to Extract",DIR("B")=1
"RTN","LRRMM",134,0)
 S DIR("?")="Enter the number of the message you want printed"
"RTN","LRRMM",135,0)
 D ^DIR K DIR G:$D(DIRUT) ASK S LRRMZ=$G(^TMP($J,"B",Y))
"RTN","LRRMM",136,0)
 S %IS="Q" D ^%ZIS I POP D HOME^%ZIS,KILL1 Q
"RTN","LRRMM",137,0)
 I $D(IO("Q")) S ZTDESC="Extract Text of Mail Message",ZTSAVE("LRRMZ")="",ZTRTN="WRITE^LRRMM" D ^%ZTLOAD W !,"REQUEST ",$S($D(ZTSK):"",1:"NOT "),"QUEUED" K IO("Q"),ZTSK D ^%ZISC G ASK
"RTN","LRRMM",138,0)
 D WRITE,KILL1 G ASK
"RTN","LRRMM",139,0)
 ;
"RTN","LRRMM",140,0)
WRITE ;Print the text of the message.
"RTN","LRRMM",141,0)
 U IO S LRRCN=.9999
"RTN","LRRMM",142,0)
 F  S LRRCN=$O(^XMB(3.9,LRRMZ,2,LRRCN)) Q:'LRRCN  S X=^(LRRCN,0) W:X="|TOP|" @IOF W:X'="|TOP|" X,!
"RTN","LRRMM",143,0)
 W @IOF D ^%ZISC,KILL1 S:$D(ZTQUEUED) ZTREQ="@" Q
"RTN","LRRMM",144,0)
 ;
"RTN","LRRMM",145,0)
KILL1 K ^TMP($J),LRRCN,LRRMC,LRRMK,LRRMKN,LRRMR,LRRMZ,LRRMZ1
"RTN","LRRMM",146,0)
 K LRRMSUB,LRROUT,%,%IS,DA,DIC,DIR,DIROUT,DIRUT,DUOUT,I,J
"RTN","LRRMM",147,0)
 K POP,X,X1,XMZ,XS,Y,ZISDA,ZISPL0
"RTN","LRRMM",148,0)
 Q
"RTN","LRRPL")
0^32^B139621090
"RTN","LRRPL",1,0)
LRRPL ;DALOI/JMC - Interim Report Performing Lab Utility ;03/12/13  09:46
"RTN","LRRPL",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRRPL",3,0)
 ;
"RTN","LRRPL",4,0)
 ;
"RTN","LRRPL",5,0)
RETLST(LRPL,LRDFN,LRSS,LRIDT,LROPT) ; Retreive list of Report sections and related performing labs.
"RTN","LRRPL",6,0)
 ; Call with LRPL = array listing section and related performing lab name/address/CLIA (by reference)
"RTN","LRRPL",7,0)
 ;          LRDFN = File #63 IEN
"RTN","LRRPL",8,0)
 ;           LRSS = File #63 subscript
"RTN","LRRPL",9,0)
 ;          LRIDT = File #63 inverse date/time of specimen
"RTN","LRRPL",10,0)
 ;          LROPT = 0 (addresses); 1 (no addresses); 2 (list/iens)
"RTN","LRRPL",11,0)
 ;           
"RTN","LRRPL",12,0)
 ; Returns   LRPL = array listing section and related performing lab name/address/CLIA
"RTN","LRRPL",13,0)
 ; 
"RTN","LRRPL",14,0)
 N LRPLIEN,LRQUIT,LRREC,LRX
"RTN","LRRPL",15,0)
 S (LRPL,LRQUIT)=0
"RTN","LRRPL",16,0)
 S (LRX,LRREC)=LRDFN_","_LRSS_","_LRIDT_","
"RTN","LRRPL",17,0)
 F  S LRX=$O(^LR(LRDFN,"PL","B",LRX)) Q:LRX=""  D  Q:LRQUIT
"RTN","LRRPL",18,0)
 . I $P(LRX,",",1,3)'=$P(LRREC,",",1,3) S LRQUIT=1 Q
"RTN","LRRPL",19,0)
 . S LRPLIEN=$O(^LR(LRDFN,"PL","B",LRX,0))
"RTN","LRRPL",20,0)
 . D RETSEC(.LRPL,LRDFN,LRPLIEN,LROPT)
"RTN","LRRPL",21,0)
 ; 
"RTN","LRRPL",22,0)
 Q
"RTN","LRRPL",23,0)
 ;
"RTN","LRRPL",24,0)
 ;
"RTN","LRRPL",25,0)
RETSEC(LRREC,LRDFN,LRPLIEN,LROPT) ; Retrieve Report section and related performing lab.
"RTN","LRRPL",26,0)
 ; Call with LRREC = array listing section and related performing lab name/address/CLIA (by reference)
"RTN","LRRPL",27,0)
 ;           LRDFN = File #63 IEN
"RTN","LRRPL",28,0)
 ;         LRPLIEN = Reference to entry in "PL" subscript
"RTN","LRRPL",29,0)
 ;           LROPT = 0 (addresses); 1 (no addresses); 2 (list/iens)
"RTN","LRRPL",30,0)
 ;
"RTN","LRRPL",31,0)
 ; Returns   LRREC = array listing section and related performing lab name/address/CLIA
"RTN","LRRPL",32,0)
 ;
"RTN","LRRPL",33,0)
 N CLIA,LR4,LRREF,LRX
"RTN","LRRPL",34,0)
 S LRX=^LR(LRDFN,"PL",LRPLIEN,0),LRREF=$P(LRX,"^"),LR4=$P(LRX,"^",2)
"RTN","LRRPL",35,0)
 ;
"RTN","LRRPL",36,0)
 ; Check reference to determine what component of report it's associated with.
"RTN","LRRPL",37,0)
 ;  and construct the performing laboratory statement.
"RTN","LRRPL",38,0)
 S LRREC=$O(LRREC(""),-1)
"RTN","LRRPL",39,0)
 I LRREC>1 S LRREC=LRREC+1,LRREC(LRREC)=" "
"RTN","LRRPL",40,0)
 S LRREC=LRREC+1,LRREC(LRREC)=""
"RTN","LRRPL",41,0)
 I $P(LRREF,",",2)?1(1"CH",1"MI") D @($P(LRREF,",",2)_"CHK")
"RTN","LRRPL",42,0)
 I $P(LRREF,",",2)?1(1"SP",1"CY",1"EM") D APCHK
"RTN","LRRPL",43,0)
 I $P(LRREF,",",2)="AU" D AUCHK
"RTN","LRRPL",44,0)
 ;
"RTN","LRRPL",45,0)
 I LROPT=2 S LRX=$O(LRREC(0,""),-1)+1,LRREC(0,LRX)=LRREF_"^"_LRPLIEN_"^"_LRREC(LRREC)
"RTN","LRRPL",46,0)
 ;
"RTN","LRRPL",47,0)
 S LRREC(LRREC)=LRREC(LRREC)_" Performed By: "
"RTN","LRRPL",48,0)
 S LRREC=LRREC+1,LRREC(LRREC)=$$NAME^XUAF4(LR4)
"RTN","LRRPL",49,0)
 ;
"RTN","LRRPL",50,0)
 S CLIA=$$ID^XUAF4("CLIA",LR4)
"RTN","LRRPL",51,0)
 I CLIA'="" D
"RTN","LRRPL",52,0)
 . I $L(LRREC(LRREC))<(IOM-20) S LRREC(LRREC)=LRREC(LRREC)_" [CLIA# "_CLIA_"]"
"RTN","LRRPL",53,0)
 . E  S LRREC=LRREC+1,LRREC(LRREC)="CLIA# "_CLIA
"RTN","LRRPL",54,0)
 ;
"RTN","LRRPL",55,0)
 I LROPT>1 Q
"RTN","LRRPL",56,0)
 S LRX=$$PADD^XUAF4(LR4),LRX(1)=$$WHAT^XUAF4(LR4,1.02)
"RTN","LRRPL",57,0)
 I LRX="" Q
"RTN","LRRPL",58,0)
 S LRREC=LRREC+1
"RTN","LRRPL",59,0)
 S LRREC(LRREC)=$P(LRX,U)_" "_$S(LRX(1)'="":LRX(1)_" ",1:"")_$P(LRX,U,2)_$S($P(LRX,U,3)'="":", ",1:"")_$P(LRX,U,3)_" "_$P(LRX,U,4)
"RTN","LRRPL",60,0)
 ;
"RTN","LRRPL",61,0)
 Q
"RTN","LRRPL",62,0)
 ;
"RTN","LRRPL",63,0)
 ;
"RTN","LRRPL",64,0)
CHCHK ; Check and resolve CH subscript
"RTN","LRRPL",65,0)
 ;
"RTN","LRRPL",66,0)
 Q
"RTN","LRRPL",67,0)
 ;
"RTN","LRRPL",68,0)
 ;
"RTN","LRRPL",69,0)
MICHK ; Check and resolve MI subscript
"RTN","LRRPL",70,0)
 ;
"RTN","LRRPL",71,0)
 ; If entire report flagged then check if only one section and report that section
"RTN","LRRPL",72,0)
 ;   otherwise report as "microbiology report" when multiple sections.
"RTN","LRRPL",73,0)
 I $P(LRREF,",",4)=0 D  Q
"RTN","LRRPL",74,0)
 . N LRSECT,X,Y
"RTN","LRRPL",75,0)
 . S LRREC(LRREC)="Microbiology Report",LRSECT=0
"RTN","LRRPL",76,0)
 . F X=1,5,8,11,16 D  Q:LRSECT=""
"RTN","LRRPL",77,0)
 . . I '$D(^LR(LRDFN,"MI",$P(LRREF,",",3),X)) Q
"RTN","LRRPL",78,0)
 . . I LRSECT=0 S LRSECT=X
"RTN","LRRPL",79,0)
 . . E  S LRSECT=""
"RTN","LRRPL",80,0)
 . I LRSECT<1 Q
"RTN","LRRPL",81,0)
 . S X="Bacteriology^^^^Parasitology^^^Mycology^^^Mycobacteriology^^^^^Virology"
"RTN","LRRPL",82,0)
 . S Y=$P(X,"^",LRSECT)
"RTN","LRRPL",83,0)
 . I Y'="" S LRREC(LRREC)=Y_" Report"
"RTN","LRRPL",84,0)
 ;
"RTN","LRRPL",85,0)
 I $P($P(LRREF,";"),",",4)=1 D  Q
"RTN","LRRPL",86,0)
 . I $P(LRREF,";",2)=5 S LRREC(LRREC)="Sputum Screen" Q
"RTN","LRRPL",87,0)
 . I $P(LRREF,";",2)=6 S LRREC(LRREC)="Urine Screen" Q
"RTN","LRRPL",88,0)
 . S LRREC(LRREC)="Bacteriology Report"
"RTN","LRRPL",89,0)
 ;
"RTN","LRRPL",90,0)
 I $P(LRREF,",",4)=2 D  Q
"RTN","LRRPL",91,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Gram Stain" Q
"RTN","LRRPL",92,0)
 . S LRREC(LRREC)="Gram Stain Comment #"_$$CMTSEQ(LRREF)
"RTN","LRRPL",93,0)
 ;
"RTN","LRRPL",94,0)
 I $P(LRREF,",",4)=3 D  Q
"RTN","LRRPL",95,0)
 . N LRORG
"RTN","LRRPL",96,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Organism Identification" Q
"RTN","LRRPL",97,0)
 . S LRORG=$$GETORG(LRREF)
"RTN","LRRPL",98,0)
 . I $P(LRREF,",",6)=1 D  Q
"RTN","LRRPL",99,0)
 . . I $P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" Comment #"_$$CMTSEQ(LRREF) Q
"RTN","LRRPL",100,0)
 . . S LRREC(LRREC)=LRORG_" Comment"
"RTN","LRRPL",101,0)
 . I ($P(LRREF,",",6)\1)=2 S LRREC(LRREC)=LRORG_" "_$$GETDRUG(3,$P(LRREF,",",6))_" Susceptibility" Q
"RTN","LRRPL",102,0)
 . I $P(LRREF,",",6)=3,$P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" "_$$GETDRUG2(LRREF)_" Susceptibility" Q
"RTN","LRRPL",103,0)
 . S LRREC(LRREC)=LRORG
"RTN","LRRPL",104,0)
 ;
"RTN","LRRPL",105,0)
 I $P(LRREF,",",4)=4 D  Q
"RTN","LRRPL",106,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Bact Report Remark" Q
"RTN","LRRPL",107,0)
 . S LRREC(LRREC)="Bact Report Remark #"_$$CMTSEQ(LRREF)
"RTN","LRRPL",108,0)
 ;
"RTN","LRRPL",109,0)
 I $P(LRREF,",",4)=5 S LRREC(LRREC)="Parasitology Report" Q
"RTN","LRRPL",110,0)
 ;
"RTN","LRRPL",111,0)
 I $P(LRREF,",",4)=6 D  Q
"RTN","LRRPL",112,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Parasite Identification" Q
"RTN","LRRPL",113,0)
 . S LRORG=$$GETORG(LRREF)
"RTN","LRRPL",114,0)
 . I $P(LRREF,",",8)=1 D  Q
"RTN","LRRPL",115,0)
 . . I $P(LRREF,",",9)>0 S LRREC(LRREC)=LRORG_" Stage Comment #"_$$CMTSEQ(LRREF) Q
"RTN","LRRPL",116,0)
 . . S LRREC(LRREC)=LRORG_" Stage Comment"
"RTN","LRRPL",117,0)
 . I $P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" Parasite Stage" Q
"RTN","LRRPL",118,0)
 . S LRREC(LRREC)=LRORG
"RTN","LRRPL",119,0)
 ;
"RTN","LRRPL",120,0)
 I $P(LRREF,",",4)=7 D  Q
"RTN","LRRPL",121,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Parasitology Report Remark" Q
"RTN","LRRPL",122,0)
 . S LRREC(LRREC)="Parasitology Report Remark #"_$P(LRREF,",",5)
"RTN","LRRPL",123,0)
 ;
"RTN","LRRPL",124,0)
 I $P(LRREF,",",4)=8 S LRREC(LRREC)="Mycology Report" Q
"RTN","LRRPL",125,0)
 ;
"RTN","LRRPL",126,0)
 I $P(LRREF,",",4)=9 D  Q
"RTN","LRRPL",127,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Fungal Identification" Q
"RTN","LRRPL",128,0)
 . S LRORG=$$GETORG(LRREF)
"RTN","LRRPL",129,0)
 . I $P(LRREF,",",6)=1 D  Q
"RTN","LRRPL",130,0)
 . . I $P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" Comment #"_$$CMTSEQ(LRREF) Q
"RTN","LRRPL",131,0)
 . . S LRREC(LRREC)=LRORG_" Comment"
"RTN","LRRPL",132,0)
 . S LRREC(LRREC)=LRORG
"RTN","LRRPL",133,0)
 ;
"RTN","LRRPL",134,0)
 I $P(LRREF,",",4)=10 D  Q
"RTN","LRRPL",135,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Mycology Report Remark" Q
"RTN","LRRPL",136,0)
 . S LRREC(LRREC)="Mycology Report Remark #"_$$CMTSEQ(LRREF) Q
"RTN","LRRPL",137,0)
 ;
"RTN","LRRPL",138,0)
 I $P($P(LRREF,";"),",",4)=11 D  Q
"RTN","LRRPL",139,0)
 . I $P(LRREF,";",2)=3 S LRREC(LRREC)="Acid Fast Stain" Q
"RTN","LRRPL",140,0)
 . S LRREC(LRREC)="Mycobacteriology Report"
"RTN","LRRPL",141,0)
 ;
"RTN","LRRPL",142,0)
 I $P(LRREF,",",4)=12 D
"RTN","LRRPL",143,0)
 . N LRORG
"RTN","LRRPL",144,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Mycobacterium Identification" Q
"RTN","LRRPL",145,0)
 . S LRORG=$$GETORG(LRREF)
"RTN","LRRPL",146,0)
 . I $P(LRREF,",",6)=1 D  Q
"RTN","LRRPL",147,0)
 . . I $P(LRREF,",",7)>0 S LRREC(LRREC)=LRORG_" Comment #"_$$CMTSEQ(LRREF) Q
"RTN","LRRPL",148,0)
 . . S LRREC(LRREC)=LRORG_" Comment"
"RTN","LRRPL",149,0)
 . I $P(LRREF,",",6)>1 S LRREC(LRREC)=LRORG_" "_$$GETDRUG(12,$P(LRREF,",",6))_" Susceptibility" Q
"RTN","LRRPL",150,0)
 . S LRREC(LRREC)=LRORG
"RTN","LRRPL",151,0)
 ;
"RTN","LRRPL",152,0)
 I $P(LRREF,",",4)=13 D  Q
"RTN","LRRPL",153,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Mycobacteriology Report Remark" Q
"RTN","LRRPL",154,0)
 . S LRREC(LRREC)="Mycobacteriology Report Remark #"_$$CMTSEQ(LRREF)
"RTN","LRRPL",155,0)
 ;
"RTN","LRRPL",156,0)
 I $P(LRREF,",",4)=14 D  Q
"RTN","LRRPL",157,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Antibiotic Serum Level" Q
"RTN","LRRPL",158,0)
 . S LRREC(LRREC)="Antibiotic Serum Level "_$$GETDRUG2(LRREF)
"RTN","LRRPL",159,0)
 ;
"RTN","LRRPL",160,0)
 I $P(LRREF,",",4)=15 D  Q
"RTN","LRRPL",161,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Mycology Smear/Prep" Q
"RTN","LRRPL",162,0)
 . S LRREC(LRREC)="Mycology smear/prep Remark #"_$$CMTSEQ(LRREF)
"RTN","LRRPL",163,0)
 ;
"RTN","LRRPL",164,0)
 I $P(LRREF,",",4)=16 S LRREC(LRREC)="Virology Report" Q
"RTN","LRRPL",165,0)
 ;
"RTN","LRRPL",166,0)
 I $P(LRREF,",",4)=17 D  Q
"RTN","LRRPL",167,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Virus Identification" Q
"RTN","LRRPL",168,0)
 . S LRORG=$$GETORG(LRREF)
"RTN","LRRPL",169,0)
 . S LRREC(LRREC)=LRORG
"RTN","LRRPL",170,0)
 ;
"RTN","LRRPL",171,0)
 I $P(LRREF,",",4)=18 D  Q
"RTN","LRRPL",172,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Virology Report Remark" Q
"RTN","LRRPL",173,0)
 . S LRREC(LRREC)="Virology Report Remark #"_$$CMTSEQ(LRREF)
"RTN","LRRPL",174,0)
 ;
"RTN","LRRPL",175,0)
 I $P(LRREF,",",4)>18,$P(LRREF,",",4)<31 D  Q
"RTN","LRRPL",176,0)
 . N LRI,LRX
"RTN","LRRPL",177,0)
 . S LRI=$P(LRREF,",",4)
"RTN","LRRPL",178,0)
 . I LRI>18,LRI<24 S LRX="Preliminary "_$S(LRI=19:"BACT",LRI=20:"VIROLOGY",LRI=21:"PARASITOLOGY",LRI=22:"MYCOLOGY",1:"TB")_" Comment"
"RTN","LRRPL",179,0)
 . I LRI>23,LRI<26 S LRX=$S(LRI=24:"PARASITOLOGY",1:"BACTERIOLOGY")_" SMEAR/PREP"
"RTN","LRRPL",180,0)
 . I LRI>25,LRI<31 S LRX=$S(LRI=26:"BACTERIOLOGY",LRI=27:"PARASITOLOGY",LRI=28:"MYCOLOGY",LRI=29:"TB",1:"VIROLOGY")_" TESTS"
"RTN","LRRPL",181,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)=LRX Q
"RTN","LRRPL",182,0)
 . S LRREC(LRREC)=LRX_" #"_$$CMTSEQ(LRREF)
"RTN","LRRPL",183,0)
 ;
"RTN","LRRPL",184,0)
 ; Sterility Results
"RTN","LRRPL",185,0)
 I $P(LRREF,",",4)=31 S LRREC(LRREC)="Sterility Results" Q
"RTN","LRRPL",186,0)
 ;
"RTN","LRRPL",187,0)
 ; Comment on specimen
"RTN","LRRPL",188,0)
 I $P(LRREF,",",4)=99 S LRREC(LRREC)="Comment On Specimen" Q
"RTN","LRRPL",189,0)
 ;
"RTN","LRRPL",190,0)
 Q
"RTN","LRRPL",191,0)
 ;
"RTN","LRRPL",192,0)
 ;
"RTN","LRRPL",193,0)
APCHK ; Check and resolve SP, CY and EM subscript
"RTN","LRRPL",194,0)
 ;
"RTN","LRRPL",195,0)
 N LRSS
"RTN","LRRPL",196,0)
 S LRSS=$P(LRREF,",",2)
"RTN","LRRPL",197,0)
 ;
"RTN","LRRPL",198,0)
 ; Type of report
"RTN","LRRPL",199,0)
 I $P(LRREF,",",4)=0 S LRREC(LRREC)=$S(LRSS="SP":"Surgical Pathology",LRSS="CY":"Cytology",LRSS="EM":"Electron Microscopy",1:"")_" Report" Q
"RTN","LRRPL",200,0)
 ;
"RTN","LRRPL",201,0)
 ; Frozen section
"RTN","LRRPL",202,0)
 I LRSS="SP",$P(LRREF,",",4)=1.3 S LRREC(LRREC)="Frozen Section" Q
"RTN","LRRPL",203,0)
 ;
"RTN","LRRPL",204,0)
 ; Info accompanying request
"RTN","LRRPL",205,0)
 I $P(LRREF,",",4)=.2 S LRREC(LRREC)="Brief Clinical History" Q
"RTN","LRRPL",206,0)
 I $P(LRREF,",",4)=.3 S LRREC(LRREC)="Preoperative Diagnosis" Q
"RTN","LRRPL",207,0)
 I $P(LRREF,",",4)=.4 S LRREC(LRREC)="Operative Findings" Q
"RTN","LRRPL",208,0)
 I $P(LRREF,",",4)=.5 S LRREC(LRREC)="Post-Operative Diagnosis" Q
"RTN","LRRPL",209,0)
 ;
"RTN","LRRPL",210,0)
 ; Descriptions
"RTN","LRRPL",211,0)
 I $P(LRREF,",",4)=1 S LRREC(LRREC)="Gross Description" Q
"RTN","LRRPL",212,0)
 I $P(LRREF,",",4)=1.1 S LRREC(LRREC)="Microscopic Description" Q
"RTN","LRRPL",213,0)
 ;
"RTN","LRRPL",214,0)
 ; Surgical Path Diagnois
"RTN","LRRPL",215,0)
 I $P(LRREF,",",4)=1.4 S LRREC(LRREC)="Surgical Path Diagnosis" Q
"RTN","LRRPL",216,0)
 ;
"RTN","LRRPL",217,0)
 ; Supplementary Reports
"RTN","LRRPL",218,0)
 I $P(LRREF,",",4)=1.2 D  Q
"RTN","LRRPL",219,0)
 . N LRI,LRX
"RTN","LRRPL",220,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Supplementary Report" Q
"RTN","LRRPL",221,0)
 . S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),0))
"RTN","LRRPL",222,0)
 . S LRX=$$FMTE^XLFDT(+LRI,"1MZ")
"RTN","LRRPL",223,0)
 . S LRREC(LRREC)="Supplementary Report for "_LRX
"RTN","LRRPL",224,0)
 ;
"RTN","LRRPL",225,0)
 ; Special Studies
"RTN","LRRPL",226,0)
 I $P(LRREF,",",4)=2 D  Q
"RTN","LRRPL",227,0)
 . N LRI,LRX,LRSST
"RTN","LRRPL",228,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Special Studies" Q
"RTN","LRRPL",229,0)
 . S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),0))
"RTN","LRRPL",230,0)
 . S LRX=$P(^LAB(61,+LRI,0),"^")
"RTN","LRRPL",231,0)
 . I $P(LRREF,",",7) D  Q
"RTN","LRRPL",232,0)
 . . S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),5,$P(LRREF,",",7),0))
"RTN","LRRPL",233,0)
 . . S LRSST=$$EXTERNAL^DILFD(63.819,.01,"",$P(LRI,"^"),"")
"RTN","LRRPL",234,0)
 . . S LRREC(LRREC)="Special Studies on "_LRX_" "_LRSST
"RTN","LRRPL",235,0)
 . S LRREC(LRREC)="Special Studies on "_LRX
"RTN","LRRPL",236,0)
 ;
"RTN","LRRPL",237,0)
 ; Delayed report comment
"RTN","LRRPL",238,0)
 I $P(LRREF,",",4)=97 D  Q
"RTN","LRRPL",239,0)
 . I $P(LRREF,",",5)>0 S LRREC(LRREC)="Delayed Report Comment #"_$$CMTSEQ(LRREF) Q
"RTN","LRRPL",240,0)
 . S LRREC(LRREC)="Delayed Report Comment"
"RTN","LRRPL",241,0)
 ;
"RTN","LRRPL",242,0)
 I $P(LRREF,",",4)=99 D  Q
"RTN","LRRPL",243,0)
 . I $P(LRREF,",",5)>0 S LRREC(LRREC)="Comment #"_$$CMTSEQ(LRREF) Q
"RTN","LRRPL",244,0)
 . S LRREC(LRREC)="Comment"
"RTN","LRRPL",245,0)
 Q
"RTN","LRRPL",246,0)
 ;
"RTN","LRRPL",247,0)
 ;
"RTN","LRRPL",248,0)
AUCHK ; Check and resolve AU subscript
"RTN","LRRPL",249,0)
 ;
"RTN","LRRPL",250,0)
 ; Type of report
"RTN","LRRPL",251,0)
 I $P(LRREF,",",4)="AU",$P(LRREF,",",5)=0 S LRREC(LRREC)="Autospy" Q
"RTN","LRRPL",252,0)
 ;
"RTN","LRRPL",253,0)
 I $P(LRREF,",",4)="AZC" D
"RTN","LRRPL",254,0)
 . I $P(LRREF,",",5)>0 S LRREC(LRREC)="Autopsy Comment #"_$$CMTSEQ(LRREF) Q
"RTN","LRRPL",255,0)
 . S LRREC(LRREC)="Autopsy Comment"
"RTN","LRRPL",256,0)
 ;
"RTN","LRRPL",257,0)
 ; Descriptions
"RTN","LRRPL",258,0)
 I $P(LRREF,",",4)=81 S LRREC(LRREC)="Clinical Diagnoses" Q
"RTN","LRRPL",259,0)
 I $P(LRREF,",",4)=82 S LRREC(LRREC)="Pathological Diagnoses" Q
"RTN","LRRPL",260,0)
 ;
"RTN","LRRPL",261,0)
 ; Special Studies
"RTN","LRRPL",262,0)
 I $P(LRREF,",",4)="AY" D  Q
"RTN","LRRPL",263,0)
 . N LRI,LRX,LRSST
"RTN","LRRPL",264,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Special Studies" Q
"RTN","LRRPL",265,0)
 . S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",4),$P(LRREF,",",5),0))
"RTN","LRRPL",266,0)
 . S LRX=$P(^LAB(61,+LRI,0),"^")
"RTN","LRRPL",267,0)
 . I $P(LRREF,",",5) D  Q
"RTN","LRRPL",268,0)
 . . S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",4),$P(LRREF,",",5),$P(LRREF,",",6),$P(LRREF,",",7),0))
"RTN","LRRPL",269,0)
 . . S LRSST=$$EXTERNAL^DILFD(63.26,.01,"",$P(LRI,"^"),"")
"RTN","LRRPL",270,0)
 . . S LRREC(LRREC)="Special Studies on "_LRX_" "_LRSST
"RTN","LRRPL",271,0)
 . S LRREC(LRREC)="Special Studies on "_LRX
"RTN","LRRPL",272,0)
 ;
"RTN","LRRPL",273,0)
 ; Supplementary Reports
"RTN","LRRPL",274,0)
 I $P(LRREF,",",4)=84 D  Q
"RTN","LRRPL",275,0)
 . N LRI,LRX
"RTN","LRRPL",276,0)
 . I $P(LRREF,",",5)=0 S LRREC(LRREC)="Supplementary Report" Q
"RTN","LRRPL",277,0)
 . S LRI=$G(^LR($P(LRREF,","),84,$P(LRREF,",",3),0))
"RTN","LRRPL",278,0)
 . S LRX=$$FMTE^XLFDT(+LRI,"1MZ")
"RTN","LRRPL",279,0)
 . S LRREC(LRREC)="Supplementary Report for "_LRX
"RTN","LRRPL",280,0)
 ;
"RTN","LRRPL",281,0)
 Q
"RTN","LRRPL",282,0)
 ;
"RTN","LRRPL",283,0)
 ;
"RTN","LRRPL",284,0)
GETORG(LRREF) ; Retrieve name of organism from file #61.2
"RTN","LRRPL",285,0)
 ; Call with LRREF = reference to entry in file #63
"RTN","LRRPL",286,0)
 ;
"RTN","LRRPL",287,0)
 N LRI,LRX
"RTN","LRRPL",288,0)
 S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),0))
"RTN","LRRPL",289,0)
 S LRX=$$TITLE^XLFSTR($P($G(^LAB(61.2,+LRI,0)),"^"))
"RTN","LRRPL",290,0)
 ;
"RTN","LRRPL",291,0)
 Q LRX
"RTN","LRRPL",292,0)
 ;
"RTN","LRRPL",293,0)
 ;
"RTN","LRRPL",294,0)
GETDRUG(LRSECT,LRJ) ; Retreive name of drug in file #62.06 from drug data name
"RTN","LRRPL",295,0)
 ; Call with LRSECT = drug section in MI subscript (3=bacteria/12-TB)
"RTN","LRRPL",296,0)
 ;              LRJ = drug node
"RTN","LRRPL",297,0)
 ;
"RTN","LRRPL",298,0)
 ;     Returns LRDN = name of drug
"RTN","LRRPL",299,0)
 ;
"RTN","LRRPL",300,0)
 N LRDN
"RTN","LRRPL",301,0)
 S LRDN=$O(^LAB(62.06,$S(LRSECT=3:"AD",1:"AD1"),LRJ,0))
"RTN","LRRPL",302,0)
 I LRDN S LRDN=$$TITLE^XLFSTR($P($G(^LAB(62.06,LRDN,0)),"^"))
"RTN","LRRPL",303,0)
 ;
"RTN","LRRPL",304,0)
 Q LRDN
"RTN","LRRPL",305,0)
 ;
"RTN","LRRPL",306,0)
 ;
"RTN","LRRPL",307,0)
GETDRUG2(LRREF) ; Retreive name of drug in file 63.32 (#200) ANTIBIOTIC or file 63.42A (#28) ANTIBIOTIC LEVEL
"RTN","LRRPL",308,0)
 ; Call with LRREF = reference to entry in file #63
"RTN","LRRPL",309,0)
 ;
"RTN","LRRPL",310,0)
 ;    Returns LRDN = name of drug
"RTN","LRRPL",311,0)
 ;
"RTN","LRRPL",312,0)
 N LRDN,LRI
"RTN","LRRPL",313,0)
 I $P(LRREF,",",7)="" S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),$P(LRREF,",",6)))
"RTN","LRRPL",314,0)
 E  S LRI=$G(^LR($P(LRREF,","),$P(LRREF,",",2),$P(LRREF,",",3),$P(LRREF,",",4),$P(LRREF,",",5),$P(LRREF,",",6),$P(LRREF,",",7),$P(LRREF,",",8)))
"RTN","LRRPL",315,0)
 S LRDN=$P(LRI,"^")
"RTN","LRRPL",316,0)
 ;
"RTN","LRRPL",317,0)
 Q LRDN
"RTN","LRRPL",318,0)
 ;
"RTN","LRRPL",319,0)
 ;
"RTN","LRRPL",320,0)
CMTSEQ(LRREF) ; Determine the sequence # for a comment line
"RTN","LRRPL",321,0)
 ; Deal with intervening comments being deleted during edits resulting in the comment IEN being
"RTN","LRRPL",322,0)
 ; different than the display sequence #.
"RTN","LRRPL",323,0)
 ;
"RTN","LRRPL",324,0)
 ; Call with LRREF = id reference of specific comment
"RTN","LRRPL",325,0)
 ;
"RTN","LRRPL",326,0)
 ; Returns     LRY = display sequence #
"RTN","LRRPL",327,0)
 ;
"RTN","LRRPL",328,0)
 N LRDFN,LRI,LRIDT,LRSECT,LRSS,LRX,LRY
"RTN","LRRPL",329,0)
 S (LRY,LRI)=0
"RTN","LRRPL",330,0)
 S LRDFN=$P(LRREF,",")
"RTN","LRRPL",331,0)
 I $P(LRREF,",",2)?1(1"CH",1"MI",1"SP",1"CY",1"EM") S LRSS=$P(LRREF,",",2),LRIDT=$P(LRREF,",",3),LRSECT=$P(LRREF,",",4)
"RTN","LRRPL",332,0)
 E  S LRSS="AU",LRSECT=$P(LRREF,",",2)
"RTN","LRRPL",333,0)
 ;
"RTN","LRRPL",334,0)
 I LRSS="MI" D MISEQ
"RTN","LRRPL",335,0)
 ;
"RTN","LRRPL",336,0)
 ; Check AP comments
"RTN","LRRPL",337,0)
 I LRSS?1(1"SP",1"CY",1"EM"),(LRSECT=97!(LRSECT=99)) D
"RTN","LRRPL",338,0)
 . F  S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI  S LRY=LRY+1 I LRI=$P(LRREF,"^",5) Q
"RTN","LRRPL",339,0)
 ;
"RTN","LRRPL",340,0)
 I LRSS="AU" D
"RTN","LRRPL",341,0)
 . F  S LRI=$O(^LR(LRDFN,LRSECT,LRI)) Q:'LRI  S LRY=LRY+1 I LRI=$P(LRREF,"^",4) Q
"RTN","LRRPL",342,0)
 ;
"RTN","LRRPL",343,0)
 Q LRY
"RTN","LRRPL",344,0)
 ;
"RTN","LRRPL",345,0)
 ;
"RTN","LRRPL",346,0)
MISEQ ; Check for comment seq on MI subscript
"RTN","LRRPL",347,0)
 ;
"RTN","LRRPL",348,0)
 ; Sections 2,4,7,10,13,14,15,18-30
"RTN","LRRPL",349,0)
 S LRX="^1^^1^^^1^^^1^^^1^1^1^^^1^1^1^1^1^1^1^1^1^1^1^1^1^"
"RTN","LRRPL",350,0)
 I $P(LRX,"^",LRSECT) D  Q
"RTN","LRRPL",351,0)
 . F  S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI  S LRY=LRY+1 I LRI=$P(LRREF,",",5) Q
"RTN","LRRPL",352,0)
 ;
"RTN","LRRPL",353,0)
 ; Sections 3,9,12
"RTN","LRRPL",354,0)
 S LRX="^^1^^^^^^1^^^1^"
"RTN","LRRPL",355,0)
 I $P(LRX,"^",LRSECT) D  Q
"RTN","LRRPL",356,0)
 . F  S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,$P(LRREF,",",5),1,LRI)) Q:'LRI  S LRY=LRY+1 I LRI=$P(LRREF,",",7) Q
"RTN","LRRPL",357,0)
 ;
"RTN","LRRPL",358,0)
 ; Section 6 - Parasite Stage Comment (multiple 3 levels down)
"RTN","LRRPL",359,0)
 I LRSECT=6 D  Q
"RTN","LRRPL",360,0)
 . F  S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,$P(LRREF,",",5),1,$P(LRREF,",",6),1,LRI)) Q:'LRI  S LRY=LRY+1 I LRI=$P(LRREF,",",9) Q
"RTN","LRRPL",361,0)
 ;
"RTN","LRRPL",362,0)
 Q
"RTN","LRRPLU")
0^33^B285265973
"RTN","LRRPLU",1,0)
LRRPLU ;DALOI/JMC - Lab Report Performing Lab Utility ;02/22/13  10:11
"RTN","LRRPLU",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRRPLU",3,0)
 ;
"RTN","LRRPLU",4,0)
 Q
"RTN","LRRPLU",5,0)
 ;
"RTN","LRRPLU",6,0)
 ;
"RTN","LRRPLU",7,0)
EDIT(LRDFN,LRSS,LRIDT) ; Add/edit performing lab for a section of a report
"RTN","LRRPLU",8,0)
 ; Call with LRDFN = File #63 IEN
"RTN","LRRPLU",9,0)
 ;            LRSS = File #63 subscript
"RTN","LRRPLU",10,0)
 ;           LRIDT = File #63 inverse date/time of specimen
"RTN","LRRPLU",11,0)
 ;
"RTN","LRRPLU",12,0)
 ;
"RTN","LRRPLU",13,0)
 N DIR,DIROUT,DIRUT,DUOUT,LRHLP,LRLST,LRPL,LRX,LRY,X,Y
"RTN","LRRPLU",14,0)
 ; Autospy does not have an inverse date/time
"RTN","LRRPLU",15,0)
 I LRSS="AU" S LRIDT=0
"RTN","LRRPLU",16,0)
 I LRSS="MI",'($$GET^XPAR("ALL","LR ASK PERFORMING LAB MICRO",1,"Q")) D NOASK^LRRPLUA Q
"RTN","LRRPLU",17,0)
 I LRSS?1(1"SP",1"CY",1"EM"),'($$GET^XPAR("ALL","LR ASK PERFORMING LAB AP",1,"Q")) D NOASK^LRRPLUA Q
"RTN","LRRPLU",18,0)
 F  D  Q:$D(DIRUT)
"RTN","LRRPLU",19,0)
 . K LRPL,LRLST
"RTN","LRRPLU",20,0)
 . D RETLST^LRRPL(.LRPL,LRDFN,LRSS,LRIDT,2)
"RTN","LRRPLU",21,0)
 . ;
"RTN","LRRPLU",22,0)
 . I $D(LRPL(0)) D
"RTN","LRRPLU",23,0)
 . . M LRLST=LRPL(0) K LRPL(0)
"RTN","LRRPLU",24,0)
 . . S LRPL(.5)="Current performing lab assignments:",LRPL(.6)=" "
"RTN","LRRPLU",25,0)
 . E  S LRPL(.5)="Current performing lab assignments: None Listed"
"RTN","LRRPLU",26,0)
 . D EN^DDIOL(.LRPL)
"RTN","LRRPLU",27,0)
 . ;
"RTN","LRRPLU",28,0)
 . K DIR,LRHLP
"RTN","LRRPLU",29,0)
 . S DIR(0)="SO^1:Entire report;2:Specific sections of report"
"RTN","LRRPLU",30,0)
 . I $D(LRLST) S DIR(0)=DIR(0)_";3:Delete performing laboratory"
"RTN","LRRPLU",31,0)
 . E  S DIR("B")=1
"RTN","LRRPLU",32,0)
 . S DIR("A")="Designate performing laboratory for"
"RTN","LRRPLU",33,0)
 . I $G(DIR("B"))'="" S DIR("?")="Enter a code from the list or '^' to exit."
"RTN","LRRPLU",34,0)
 . E  S DIR("?")="Enter a code from the list or <ENTER> to exit."
"RTN","LRRPLU",35,0)
 . M LRHLP=LRPL
"RTN","LRRPLU",36,0)
 . S X=$G(LRPL),LRHLP(X+1)=" ",LRHLP(X+2)=DIR("?")
"RTN","LRRPLU",37,0)
 . S DIR("??")="^D EN^DDIOL(.LRHLP)"
"RTN","LRRPLU",38,0)
 . D ^DIR
"RTN","LRRPLU",39,0)
 . I $D(DIRUT) Q
"RTN","LRRPLU",40,0)
 . I Y=1 D SET1(0) Q
"RTN","LRRPLU",41,0)
 . I Y=2 D SET2 Q
"RTN","LRRPLU",42,0)
 . I Y=3 D DEL Q
"RTN","LRRPLU",43,0)
 ;
"RTN","LRRPLU",44,0)
 Q
"RTN","LRRPLU",45,0)
 ;
"RTN","LRRPLU",46,0)
 ;
"RTN","LRRPLU",47,0)
SET1(LRSECT) ; Set performing lab for entire or major section of report.
"RTN","LRRPLU",48,0)
 ; Update if already set otherwise create a new record.
"RTN","LRRPLU",49,0)
 ; Call with LRSECT = section of report
"RTN","LRRPLU",50,0)
 ;
"RTN","LRRPLU",51,0)
 N DIR,DIROUT,DIRUT,DUOUT,LRDIE,LRDPL,LRFDA,LRFLAG,LRIEN,LRREF,LRPLAB
"RTN","LRRPLU",52,0)
 S LRFLAG=0
"RTN","LRRPLU",53,0)
 I LRSS?1(1"MI",1"SP",1"CY",1"EM") S LRFLAG=1
"RTN","LRRPLU",54,0)
 S LRDPL=$$GET^XPAR("USR","LR VER DEFAULT PERFORMING LAB",1,"Q")
"RTN","LRRPLU",55,0)
 I LRDPL<1 S LRDPL=DUZ(2)
"RTN","LRRPLU",56,0)
 S LRPLAB=$$SELPL^LRVERA(LRDPL,LRFLAG)
"RTN","LRRPLU",57,0)
 I LRPLAB<1 Q
"RTN","LRRPLU",58,0)
 S LRREF=LRDFN_","_LRSS_","_LRIDT_","_LRSECT
"RTN","LRRPLU",59,0)
 ;
"RTN","LRRPLU",60,0)
 ; Confirm that user wants to add/update record.
"RTN","LRRPLU",61,0)
 W !
"RTN","LRRPLU",62,0)
 S DIR(0)="YO",DIR("B")="NO"
"RTN","LRRPLU",63,0)
 S DIR("A")="Sure you want to "_$S($D(^LR(LRDFN,"PL","B",LRREF)):"update",1:"add")_" this record"
"RTN","LRRPLU",64,0)
 D ^DIR
"RTN","LRRPLU",65,0)
 I Y'=1 Q
"RTN","LRRPLU",66,0)
 ;
"RTN","LRRPLU",67,0)
 ; Update existing entry
"RTN","LRRPLU",68,0)
 I $D(^LR(LRDFN,"PL","B",LRREF)) D  Q
"RTN","LRRPLU",69,0)
 . D UEE(LRDFN,LRREF,LRPLAB)
"RTN","LRRPLU",70,0)
 . W !,"... assignment updated.",!
"RTN","LRRPLU",71,0)
 ;
"RTN","LRRPLU",72,0)
 ; Create new entry
"RTN","LRRPLU",73,0)
 D CNE(LRDFN,LRREF,LRPLAB)
"RTN","LRRPLU",74,0)
 W !,"... assignment created.",!
"RTN","LRRPLU",75,0)
 ;
"RTN","LRRPLU",76,0)
 Q
"RTN","LRRPLU",77,0)
 ;
"RTN","LRRPLU",78,0)
 ;
"RTN","LRRPLU",79,0)
SET2 ; Set performing lab for specific section of report
"RTN","LRRPLU",80,0)
 ;
"RTN","LRRPLU",81,0)
 N DIR,DIROUT,DIRUT,DUOUT,I,LRCNT,LRI,LRPLIEN,LRQUIT,LRREC,LRREF,LRROOT,LRSEC,LRSECT,LRX,LRY
"RTN","LRRPLU",82,0)
 ; Find the current existing sections of the report
"RTN","LRRPLU",83,0)
 S LRREF="",(LRI,LRQUIT,LRREC)=0
"RTN","LRRPLU",84,0)
 S (LRROOT,LRX)=LRDFN_","_LRSS_","_LRIDT_","
"RTN","LRRPLU",85,0)
 F  S LRX=$O(^LR(LRDFN,"PL","B",LRX)) Q:LRX=""  D  Q:LRQUIT
"RTN","LRRPLU",86,0)
 . I $P(LRROOT,",",1,3)'=$P(LRX,",",1,3) S LRQUIT=1 Q
"RTN","LRRPLU",87,0)
 . S LRPLIEN=$O(^LR(LRDFN,"PL","B",LRX,0))
"RTN","LRRPLU",88,0)
 . S LRI=$P(LRX,",",4,99),LRY="LRSEC("_LRDFN_",LRSS,"_LRIDT_",LRI)"
"RTN","LRRPLU",89,0)
 . S @LRY=LRX_"^"_LRPLIEN
"RTN","LRRPLU",90,0)
 ;
"RTN","LRRPLU",91,0)
 I LRSS="MI" D MICHK
"RTN","LRRPLU",92,0)
 I LRSS?1(1"SP",1"CY",1"EM") D APCHK
"RTN","LRRPLU",93,0)
 I LRSS="AU" D AUCHK
"RTN","LRRPLU",94,0)
 ;
"RTN","LRRPLU",95,0)
 W !
"RTN","LRRPLU",96,0)
 I $G(LRREC)<1 D  Q
"RTN","LRRPLU",97,0)
 . S DIR(0)="E",DIR("A",1)="NO sections to designate.",DIR("A")="Press any key to continue"
"RTN","LRRPLU",98,0)
 . D ^DIR
"RTN","LRRPLU",99,0)
 ;
"RTN","LRRPLU",100,0)
 S LRCNT=$O(LRREC(""),-1)
"RTN","LRRPLU",101,0)
 F I=1:1:LRCNT S DIR("A",I)=$J(I,11)_"   -   "_$P(LRREC(I),"^")
"RTN","LRRPLU",102,0)
 S DIR("A")="Select the section to designate (1-"_LRCNT_"): "
"RTN","LRRPLU",103,0)
 S DIR(0)="NOA^1:"_LRCNT_":0"
"RTN","LRRPLU",104,0)
 S DIR("??")="^D EN^DDIOL(.LRPL)"
"RTN","LRRPLU",105,0)
 D ^DIR
"RTN","LRRPLU",106,0)
 I $D(DIRUT) Q
"RTN","LRRPLU",107,0)
 ;
"RTN","LRRPLU",108,0)
 S LRSECT=$P(LRREC(Y),"^",2)
"RTN","LRRPLU",109,0)
 ;
"RTN","LRRPLU",110,0)
 I LRSS="MI" D
"RTN","LRRPLU",111,0)
 . S LRX="1^^^^1^^^1^^^1^^^^^1^^^^^^^^^^^^^^^1^"
"RTN","LRRPLU",112,0)
 . I $P(LRX,"^",LRSECT)!(LRSECT=99) D SET1(LRSECT) Q
"RTN","LRRPLU",113,0)
 . ;
"RTN","LRRPLU",114,0)
 . S LRX="^1^1^1^^1^1^^1^1^^1^1^1^1^^1^1^1^1^1^1^1^1^1^1^1^1^1^1^"
"RTN","LRRPLU",115,0)
 . I $P(LRX,"^",LRSECT) D
"RTN","LRRPLU",116,0)
 . . N LRY
"RTN","LRRPLU",117,0)
 . . D GETMULTI
"RTN","LRRPLU",118,0)
 . . W ! S LRX=$$SELMULTI(.LRY)
"RTN","LRRPLU",119,0)
 . . I LRX#1=.1 W ! K LRY D MIAB(.LRY,$P(LRX,",",5)) S LRX=$$SELMULTI(.LRY)
"RTN","LRRPLU",120,0)
 . . S LRREF=$P(LRX,"^",3)
"RTN","LRRPLU",121,0)
 . . I LRREF'="" D SETREF
"RTN","LRRPLU",122,0)
 ;
"RTN","LRRPLU",123,0)
 I LRSS?1(1"SP",1"CY",1"EM") D
"RTN","LRRPLU",124,0)
 . I LRSECT=1.2!(LRSECT=97)!(LRSECT=99) D  Q
"RTN","LRRPLU",125,0)
 . . N LRY
"RTN","LRRPLU",126,0)
 . . D GETMULTI
"RTN","LRRPLU",127,0)
 . . W ! S LRX=$$SELMULTI(.LRY),LRREF=$P(LRX,"^",3)
"RTN","LRRPLU",128,0)
 . . I LRREF'="" D SETREF
"RTN","LRRPLU",129,0)
 . I LRSECT=2 D  Q
"RTN","LRRPLU",130,0)
 . . N LRY
"RTN","LRRPLU",131,0)
 . . D GETMULTI
"RTN","LRRPLU",132,0)
 . . W ! S LRX=$$SELMULTI(.LRY)
"RTN","LRRPLU",133,0)
 . . I LRX#1=.1 W ! K LRY D APSS(.LRY,$P(LRX,",",5)) S LRX=$$SELMULTI(.LRY)
"RTN","LRRPLU",134,0)
 . . S LRREF=$P(LRX,"^",3)
"RTN","LRRPLU",135,0)
 . . I LRREF'="" D SETREF
"RTN","LRRPLU",136,0)
 . D SET1(LRSECT)
"RTN","LRRPLU",137,0)
 ;
"RTN","LRRPLU",138,0)
 I LRSS="AU" D
"RTN","LRRPLU",139,0)
 . I LRSECT=84!(LRSECT="AZC") D  Q
"RTN","LRRPLU",140,0)
 . . N LRY
"RTN","LRRPLU",141,0)
 . . D GETMULTI
"RTN","LRRPLU",142,0)
 . . W ! S LRX=$$SELMULTI(.LRY),LRREF=$P(LRX,"^",3)
"RTN","LRRPLU",143,0)
 . . I LRREF'="" D SETREF
"RTN","LRRPLU",144,0)
 . I LRSECT="AY" D  Q
"RTN","LRRPLU",145,0)
 . . N LRY
"RTN","LRRPLU",146,0)
 . . D GETMULTI
"RTN","LRRPLU",147,0)
 . . W ! S LRX=$$SELMULTI(.LRY)
"RTN","LRRPLU",148,0)
 . . I LRX#1=.1 W ! K LRY D APSS(.LRY,$P(LRX,",",3)) S LRX=$$SELMULTI(.LRY)
"RTN","LRRPLU",149,0)
 . . S LRREF=$P(LRX,"^",3)
"RTN","LRRPLU",150,0)
 . . I LRREF'="" D SETREF
"RTN","LRRPLU",151,0)
 . D SET1(LRSECT)
"RTN","LRRPLU",152,0)
 ;
"RTN","LRRPLU",153,0)
 Q
"RTN","LRRPLU",154,0)
 ;
"RTN","LRRPLU",155,0)
 ;
"RTN","LRRPLU",156,0)
SETREF ; Set reference to performing lab in file #63
"RTN","LRRPLU",157,0)
 ; Update if already set otherwise create a new record.
"RTN","LRRPLU",158,0)
 ;
"RTN","LRRPLU",159,0)
 ; Confirm that user wants to add/update record.
"RTN","LRRPLU",160,0)
 N DIR,DIROUT,DIRUT,DUOUT,LRDIE,LRDPL,LRFDA,LRFLAG,LRIEN,LRPLAB
"RTN","LRRPLU",161,0)
 ;
"RTN","LRRPLU",162,0)
 S LRFLAG=0
"RTN","LRRPLU",163,0)
 I LRSS?1(1"MI",1"SP",1"CY",1"EM",1"AU") S LRFLAG=1
"RTN","LRRPLU",164,0)
 S LRDPL=$$GET^XPAR("USR","LR VER DEFAULT PERFORMING LAB",1,"Q")
"RTN","LRRPLU",165,0)
 I LRDPL<1 S LRDPL=DUZ(2)
"RTN","LRRPLU",166,0)
 S LRPLAB=$$SELPL^LRVERA(LRDPL,LRFLAG)
"RTN","LRRPLU",167,0)
 I LRPLAB<1 Q
"RTN","LRRPLU",168,0)
 ;
"RTN","LRRPLU",169,0)
 W !
"RTN","LRRPLU",170,0)
 K DIR
"RTN","LRRPLU",171,0)
 S DIR(0)="YO",DIR("B")="NO"
"RTN","LRRPLU",172,0)
 S DIR("A")="Sure you want to "_$S($D(^LR(LRDFN,"PL","B",LRREF)):"update",1:"add")_" this record"
"RTN","LRRPLU",173,0)
 D ^DIR
"RTN","LRRPLU",174,0)
 I Y'=1 Q
"RTN","LRRPLU",175,0)
 ;
"RTN","LRRPLU",176,0)
 ; Update existing entry
"RTN","LRRPLU",177,0)
 I $D(^LR(LRDFN,"PL","B",LRREF)) D  Q
"RTN","LRRPLU",178,0)
 . D UEE(LRDFN,LRREF,LRPLAB)
"RTN","LRRPLU",179,0)
 . W !,"... assignment updated.",!
"RTN","LRRPLU",180,0)
 ;
"RTN","LRRPLU",181,0)
 ; Create new entry
"RTN","LRRPLU",182,0)
 D CNE(LRDFN,LRREF,LRPLAB)
"RTN","LRRPLU",183,0)
 W !,"... assignment created.",!
"RTN","LRRPLU",184,0)
 ;
"RTN","LRRPLU",185,0)
 Q
"RTN","LRRPLU",186,0)
 ;
"RTN","LRRPLU",187,0)
 ;
"RTN","LRRPLU",188,0)
DEL ; Delete existing performing laboratory designations.
"RTN","LRRPLU",189,0)
 ;
"RTN","LRRPLU",190,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LRCNT,LRFDA,LRIEN,X,Y
"RTN","LRRPLU",191,0)
 S LRCNT=$O(LRLST(""),-1)
"RTN","LRRPLU",192,0)
 ;
"RTN","LRRPLU",193,0)
 W !
"RTN","LRRPLU",194,0)
 I LRCNT=1 S Y=1
"RTN","LRRPLU",195,0)
 I LRCNT>1 D  Q:$D(DIRUT)
"RTN","LRRPLU",196,0)
 . S DIR("A")="Select the section to delete (1-"_LRCNT_"): "
"RTN","LRRPLU",197,0)
 . F I=1:1:LRCNT S DIR("A",I)=$J(I,11)_"   -   "_$P(LRLST(I),"^",3)
"RTN","LRRPLU",198,0)
 . S DIR(0)="NOA^1:"_LRCNT_":0"
"RTN","LRRPLU",199,0)
 . D ^DIR
"RTN","LRRPLU",200,0)
 ;
"RTN","LRRPLU",201,0)
 S LRIEN=$P(LRLST(Y),"^",2)
"RTN","LRRPLU",202,0)
 ;
"RTN","LRRPLU",203,0)
 ; Confirm that user wants to delete record.
"RTN","LRRPLU",204,0)
 K DIR
"RTN","LRRPLU",205,0)
 S DIR(0)="YO",DIR("B")="NO"
"RTN","LRRPLU",206,0)
 S DIR("A")="Sure you want to delete this performing lab assignment"
"RTN","LRRPLU",207,0)
 D ^DIR
"RTN","LRRPLU",208,0)
 I Y'=1 W !,"... deletion cancelled.",! Q
"RTN","LRRPLU",209,0)
 ;
"RTN","LRRPLU",210,0)
 ; Delete existing entry
"RTN","LRRPLU",211,0)
 D DEE(LRIEN_","_LRDFN_",")
"RTN","LRRPLU",212,0)
 ;
"RTN","LRRPLU",213,0)
 I '$D(^LR(LRDFN,"PL",LRIEN)) W !,"... assignment deleted.",!
"RTN","LRRPLU",214,0)
 E  W "... assignment NOT deleted.",!
"RTN","LRRPLU",215,0)
 ;
"RTN","LRRPLU",216,0)
 Q
"RTN","LRRPLU",217,0)
 ;
"RTN","LRRPLU",218,0)
 ;
"RTN","LRRPLU",219,0)
UEE(LRDFN,LRREF,LRPLAB) ; Update existing entry
"RTN","LRRPLU",220,0)
 ; Call with LRDFN = File #63 IEN
"RTN","LRRPLU",221,0)
 ;           LRREF = File #63 subscript reference
"RTN","LRRPLU",222,0)
 ;           LRPLAB = Performing lab as IEN in file #4
"RTN","LRRPLU",223,0)
 ;
"RTN","LRRPLU",224,0)
 N LRDIE,LRFDA,LRIEN
"RTN","LRRPLU",225,0)
 S LRIEN=$O(^LR(LRDFN,"PL","B",LRREF,0))
"RTN","LRRPLU",226,0)
 S LRFDA(1,63.00012,LRIEN_","_LRDFN_",",.02)=LRPLAB
"RTN","LRRPLU",227,0)
 D FILE^DIE("","LRFDA(1)","LRDIE(1)")
"RTN","LRRPLU",228,0)
 Q
"RTN","LRRPLU",229,0)
 ;
"RTN","LRRPLU",230,0)
 ;
"RTN","LRRPLU",231,0)
CNE(LRDFN,LRREF,LRPLAB) ; Create new entry
"RTN","LRRPLU",232,0)
 ; Call with LRDFN = File #63 IEN
"RTN","LRRPLU",233,0)
 ;           LRREF = File #63 subscript reference
"RTN","LRRPLU",234,0)
 ;           LRPLAB = Performing lab as IEN in file #4
"RTN","LRRPLU",235,0)
 ;
"RTN","LRRPLU",236,0)
 N LRDIE,LRFDA,LRIEN
"RTN","LRRPLU",237,0)
 S LRFDA(1,63.00012,"+1,"_LRDFN_",",.01)=LRREF
"RTN","LRRPLU",238,0)
 S LRFDA(1,63.00012,"+1,"_LRDFN_",",.02)=LRPLAB
"RTN","LRRPLU",239,0)
 D UPDATE^DIE("","LRFDA(1)","LRIEN","LRDIE(1)")
"RTN","LRRPLU",240,0)
 Q
"RTN","LRRPLU",241,0)
 ;
"RTN","LRRPLU",242,0)
 ;
"RTN","LRRPLU",243,0)
DEE(LRIENS) ; Delete existing entry
"RTN","LRRPLU",244,0)
 ; Call with LRRIENS = File #63 performing lab reference IENS
"RTN","LRRPLU",245,0)
 ;
"RTN","LRRPLU",246,0)
 N LRDIE,LRFDA
"RTN","LRRPLU",247,0)
 S LRFDA(1,63.00012,LRIENS,.01)="@"
"RTN","LRRPLU",248,0)
 D FILE^DIE("","LRFDA(1)","LRDIE(1)")
"RTN","LRRPLU",249,0)
 Q
"RTN","LRRPLU",250,0)
 ;
"RTN","LRRPLU",251,0)
 ;
"RTN","LRRPLU",252,0)
MICHK ; Check MI for sections to link to a performing lab
"RTN","LRRPLU",253,0)
 ;
"RTN","LRRPLU",254,0)
 N I,LRI
"RTN","LRRPLU",255,0)
 ;
"RTN","LRRPLU",256,0)
 ; Bacteriology section
"RTN","LRRPLU",257,0)
 S LRI=1
"RTN","LRRPLU",258,0)
 I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D
"RTN","LRRPLU",259,0)
 . D MICHK1
"RTN","LRRPLU",260,0)
 . N LRJ
"RTN","LRRPLU",261,0)
 . F LRJ=5,6 I $P(^LR(LRDFN,LRSS,LRIDT,LRI),"^",LRJ)'="" D
"RTN","LRRPLU",262,0)
 . . S LRREF=LRROOT_LRI_";"_LRJ,LRREC=LRREC+1 D MICHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI_";"_LRJ
"RTN","LRRPLU",263,0)
 . . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI_";"_LRJ))
"RTN","LRRPLU",264,0)
 ;
"RTN","LRRPLU",265,0)
 ; Gram stain/Organism/Susceptibility/Remark section
"RTN","LRRPLU",266,0)
 F LRI=2,3,4 I $O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) D
"RTN","LRRPLU",267,0)
 . D MICHK2
"RTN","LRRPLU",268,0)
 . I LRI=3 D BUGCHK
"RTN","LRRPLU",269,0)
 ;
"RTN","LRRPLU",270,0)
 ; Parasite section - check for parasite and stage info
"RTN","LRRPLU",271,0)
 S LRI=5
"RTN","LRRPLU",272,0)
 I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D MICHK1
"RTN","LRRPLU",273,0)
 ;
"RTN","LRRPLU",274,0)
 F LRI=6,7 I $O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) D
"RTN","LRRPLU",275,0)
 . D MICHK2
"RTN","LRRPLU",276,0)
 . I LRI=6 D BUGCHK
"RTN","LRRPLU",277,0)
 ;
"RTN","LRRPLU",278,0)
 ; Mycology section
"RTN","LRRPLU",279,0)
 S LRI=8
"RTN","LRRPLU",280,0)
 I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D MICHK1
"RTN","LRRPLU",281,0)
 ;
"RTN","LRRPLU",282,0)
 F LRI=9,10,15 I $O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) D
"RTN","LRRPLU",283,0)
 . D MICHK2
"RTN","LRRPLU",284,0)
 . I LRI=9 D BUGCHK
"RTN","LRRPLU",285,0)
 ;
"RTN","LRRPLU",286,0)
 ; Mycobacteria section - also check for AFB stain
"RTN","LRRPLU",287,0)
 S LRI=11
"RTN","LRRPLU",288,0)
 I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D
"RTN","LRRPLU",289,0)
 . D MICHK1
"RTN","LRRPLU",290,0)
 . I $P(^LR(LRDFN,LRSS,LRIDT,LRI),"^",3)'="" D
"RTN","LRRPLU",291,0)
 . . S LRREF=LRROOT_LRI_";3",LRREC=LRREC+1 D MICHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI_";3"
"RTN","LRRPLU",292,0)
 . . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI_";3"))
"RTN","LRRPLU",293,0)
 ;
"RTN","LRRPLU",294,0)
 ; TB/Organism/Susceptibilityr/Remark section
"RTN","LRRPLU",295,0)
 F LRI=12,13,14 I $O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) D
"RTN","LRRPLU",296,0)
 . D MICHK2
"RTN","LRRPLU",297,0)
 . I LRI=12 D BUGCHK
"RTN","LRRPLU",298,0)
 ;
"RTN","LRRPLU",299,0)
 ; Virology section
"RTN","LRRPLU",300,0)
 S LRI=16
"RTN","LRRPLU",301,0)
 I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D MICHK1
"RTN","LRRPLU",302,0)
 ;
"RTN","LRRPLU",303,0)
 F LRI=17,18 I $O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) D
"RTN","LRRPLU",304,0)
 . D MICHK2
"RTN","LRRPLU",305,0)
 . I LRI=17 D BUGCHK
"RTN","LRRPLU",306,0)
 ;
"RTN","LRRPLU",307,0)
 ; Various preliminary comment sections
"RTN","LRRPLU",308,0)
 F LRI=19:1:30 I $O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) D MICHK2
"RTN","LRRPLU",309,0)
 ;
"RTN","LRRPLU",310,0)
 ; Sterility Results
"RTN","LRRPLU",311,0)
 S LRI=31
"RTN","LRRPLU",312,0)
 I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D MICHK1
"RTN","LRRPLU",313,0)
 ;
"RTN","LRRPLU",314,0)
 ; Comment on Specimen
"RTN","LRRPLU",315,0)
 S LRI=99
"RTN","LRRPLU",316,0)
 I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D MICHK1
"RTN","LRRPLU",317,0)
 ;
"RTN","LRRPLU",318,0)
 Q
"RTN","LRRPLU",319,0)
 ;
"RTN","LRRPLU",320,0)
 ;
"RTN","LRRPLU",321,0)
MICHK1 ; Common MI checking logic
"RTN","LRRPLU",322,0)
 ;
"RTN","LRRPLU",323,0)
 S LRREF=LRROOT_LRI,LRREC=LRREC+1 D MICHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
"RTN","LRRPLU",324,0)
 S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI))
"RTN","LRRPLU",325,0)
 Q
"RTN","LRRPLU",326,0)
 ;
"RTN","LRRPLU",327,0)
 ;
"RTN","LRRPLU",328,0)
MICHK2 ; Common MI checking logic
"RTN","LRRPLU",329,0)
 ;
"RTN","LRRPLU",330,0)
 S LRREF=LRROOT_LRI_",0",LRREC=LRREC+1 D MICHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
"RTN","LRRPLU",331,0)
 S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI,0))
"RTN","LRRPLU",332,0)
 Q
"RTN","LRRPLU",333,0)
 ;
"RTN","LRRPLU",334,0)
 ;
"RTN","LRRPLU",335,0)
APCHK ; Check AP for sections to link to a performing lab
"RTN","LRRPLU",336,0)
 ;
"RTN","LRRPLU",337,0)
 N LRI
"RTN","LRRPLU",338,0)
 ;
"RTN","LRRPLU",339,0)
 F LRI=.2,.3,.4,.5,1,1.1,1.3,1.4 D
"RTN","LRRPLU",340,0)
 . I LRI=1.3,LRSS'="SP" Q
"RTN","LRRPLU",341,0)
 . I '$O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) Q
"RTN","LRRPLU",342,0)
 . S LRREF=LRROOT_LRI_",0",LRREC=LRREC+1 D APCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
"RTN","LRRPLU",343,0)
 . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI))
"RTN","LRRPLU",344,0)
 ;
"RTN","LRRPLU",345,0)
 ; Supplementary Report section (1.2)
"RTN","LRRPLU",346,0)
 S LRI=1.2
"RTN","LRRPLU",347,0)
 I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D
"RTN","LRRPLU",348,0)
 . S LRREF=LRROOT_LRI_",0",LRREC=LRREC+1 D APCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
"RTN","LRRPLU",349,0)
 . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI))
"RTN","LRRPLU",350,0)
 ;
"RTN","LRRPLU",351,0)
 ; Special studies (2)
"RTN","LRRPLU",352,0)
 S LRI=2
"RTN","LRRPLU",353,0)
 I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D
"RTN","LRRPLU",354,0)
 . N LRJ
"RTN","LRRPLU",355,0)
 . S LRJ=0
"RTN","LRRPLU",356,0)
 . F  S LRJ=$O(^LR(LRDFN,LRSS,LRIDT,LRI,LRJ)) Q:'LRJ  I $O(^LR(LRDFN,LRSS,LRIDT,LRI,LRJ,5,0)) D  Q
"RTN","LRRPLU",357,0)
 . . S LRREF=LRROOT_LRI_",0",LRREC=LRREC+1 D APCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
"RTN","LRRPLU",358,0)
 . . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI))
"RTN","LRRPLU",359,0)
 ;
"RTN","LRRPLU",360,0)
 ; Delayed Report Comment (97) / Comment on Specimen (99)
"RTN","LRRPLU",361,0)
 F LRI=97,99 I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D
"RTN","LRRPLU",362,0)
 . S LRREF=LRROOT_LRI,LRREC=LRREC+1 D APCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
"RTN","LRRPLU",363,0)
 . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI))
"RTN","LRRPLU",364,0)
 ;
"RTN","LRRPLU",365,0)
 Q
"RTN","LRRPLU",366,0)
 ;
"RTN","LRRPLU",367,0)
 ;
"RTN","LRRPLU",368,0)
AUCHK ; Check AU for sections to link to a performing lab
"RTN","LRRPLU",369,0)
 ;
"RTN","LRRPLU",370,0)
 N LRI
"RTN","LRRPLU",371,0)
 ;
"RTN","LRRPLU",372,0)
 ; Clinical Diagnoses (81) / Pathological Diagnoses (82)
"RTN","LRRPLU",373,0)
 F LRI=81,82 D
"RTN","LRRPLU",374,0)
 . I '$O(^LR(LRDFN,LRI,0)) Q
"RTN","LRRPLU",375,0)
 . S LRREF=LRROOT_LRI,LRREC=LRREC+1 D AUCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
"RTN","LRRPLU",376,0)
 . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRI))
"RTN","LRRPLU",377,0)
 ;
"RTN","LRRPLU",378,0)
 ; Supplementary Report section (84)
"RTN","LRRPLU",379,0)
 S LRI=84
"RTN","LRRPLU",380,0)
 I $D(^LR(LRDFN,LRI)) D
"RTN","LRRPLU",381,0)
 . S LRREF=LRROOT_LRI_",0",LRREC=LRREC+1 D AUCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
"RTN","LRRPLU",382,0)
 . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRI))
"RTN","LRRPLU",383,0)
 .
"RTN","LRRPLU",384,0)
 ; Special studies (AY)
"RTN","LRRPLU",385,0)
 S LRI="AY"
"RTN","LRRPLU",386,0)
 I $D(^LR(LRDFN,LRI)) D
"RTN","LRRPLU",387,0)
 . N LRJ
"RTN","LRRPLU",388,0)
 . S LRJ=0
"RTN","LRRPLU",389,0)
 . F  S LRJ=$O(^LR(LRDFN,LRI,LRJ)) Q:'LRJ  I $O(^LR(LRDFN,LRI,LRJ,5,0)) D  Q
"RTN","LRRPLU",390,0)
 . . S LRREF=LRROOT_LRI_",0",LRREC=LRREC+1 D AUCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
"RTN","LRRPLU",391,0)
 . . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,"AY"))
"RTN","LRRPLU",392,0)
 ;
"RTN","LRRPLU",393,0)
 ; Autospy comments (AZC)
"RTN","LRRPLU",394,0)
 S LRI="AZC"
"RTN","LRRPLU",395,0)
 I $D(^LR(LRDFN,LRI)) D
"RTN","LRRPLU",396,0)
 . S LRREF=LRROOT_LRI,LRREC=LRREC+1 D AUCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
"RTN","LRRPLU",397,0)
 . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,"AZC"))
"RTN","LRRPLU",398,0)
 ;
"RTN","LRRPLU",399,0)
 Q
"RTN","LRRPLU",400,0)
 ;
"RTN","LRRPLU",401,0)
 ;
"RTN","LRRPLU",402,0)
BUGCHK ; Check for organism/susceptibility
"RTN","LRRPLU",403,0)
 ; Only check for susceptibilities on bacteria (3) or TB (12).
"RTN","LRRPLU",404,0)
 ;
"RTN","LRRPLU",405,0)
 N LRJ,LRK
"RTN","LRRPLU",406,0)
 S LRJ=0
"RTN","LRRPLU",407,0)
 F  S LRJ=$O(^LR(LRDFN,LRSS,LRIDT,LRI,LRJ)) Q:'LRJ  D
"RTN","LRRPLU",408,0)
 . S LRREC(LRREC,LRJ)=$P(^LAB(61.2,+^(LRJ,0),0),"^")
"RTN","LRRPLU",409,0)
 . S LRREC(LRREC,LRJ,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI,LRJ))
"RTN","LRRPLU",410,0)
 . I LRI'=3,LRI'=12 Q
"RTN","LRRPLU",411,0)
 . S LRK=2
"RTN","LRRPLU",412,0)
 . F  S LRK=$O(^LR(LRDFN,LRSS,LRIDT,LRI,LRJ,LRK)) Q:'LRK!(LRK'<3)  D
"RTN","LRRPLU",413,0)
 . . S LRREC(LRREC,LRJ,LRK)=$$GETDRUG^LRRPL(LRI,LRK)
"RTN","LRRPLU",414,0)
 . . S LRREC(LRREC,LRJ,LRK,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI,LRJ,LRK))
"RTN","LRRPLU",415,0)
 Q
"RTN","LRRPLU",416,0)
 ;
"RTN","LRRPLU",417,0)
 ;
"RTN","LRRPLU",418,0)
SELMULTI(LRY) ; Handle multiple items type selection
"RTN","LRRPLU",419,0)
 ; Flag whole section or indivudual items with performing lab.
"RTN","LRRPLU",420,0)
 ; Present list of items and allow all or selected items to be designated
"RTN","LRRPLU",421,0)
 ;
"RTN","LRRPLU",422,0)
 ; Call with LRY = array of items to select/designate
"RTN","LRRPLU",423,0)
 ;   Returns LRX = item selected
"RTN","LRRPLU",424,0)
 ;
"RTN","LRRPLU",425,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LRCNT,LRDEC,LRX
"RTN","LRRPLU",426,0)
 ;
"RTN","LRRPLU",427,0)
 S (I,LRDEC)=0,LRCNT=$O(LRY(""),-1)
"RTN","LRRPLU",428,0)
 F  S I=$O(LRY(I)) Q:'I  S DIR("A",I+1)=$J($$LJ^XLFSTR(I,4),13)_" -   "_$P(LRY(I),"^") S:I#1=.1 LRDEC=1
"RTN","LRRPLU",429,0)
 S DIR("A")="Select the item to designate (1-"_LRCNT_"): "
"RTN","LRRPLU",430,0)
 S DIR(0)="NAO^1:"_LRCNT_":"_LRDEC,DIR("PRE")="I X'="""",'$D(DTOUT),'$D(LRY(X)) K X"
"RTN","LRRPLU",431,0)
 S DIR("??")="^D EN^DDIOL(.LRPL)"
"RTN","LRRPLU",432,0)
 D ^DIR
"RTN","LRRPLU",433,0)
 I $D(DIRUT) S LRX=-1
"RTN","LRRPLU",434,0)
 E  S LRX=Y_"^"_LRY(Y)
"RTN","LRRPLU",435,0)
 ;
"RTN","LRRPLU",436,0)
 Q LRX
"RTN","LRRPLU",437,0)
 ;
"RTN","LRRPLU",438,0)
 ;
"RTN","LRRPLU",439,0)
GETMULTI ; Build array of existing items in multiple
"RTN","LRRPLU",440,0)
 N LRI
"RTN","LRRPLU",441,0)
 K LRY
"RTN","LRRPLU",442,0)
 S LRI=0
"RTN","LRRPLU",443,0)
 ;
"RTN","LRRPLU",444,0)
 I LRSS="MI" D MIMULTI Q
"RTN","LRRPLU",445,0)
 I LRSS?1(1"SP",1"CY",1"EM",1"AU") D APMULTI Q
"RTN","LRRPLU",446,0)
 ;
"RTN","LRRPLU",447,0)
 Q
"RTN","LRRPLU",448,0)
 ;
"RTN","LRRPLU",449,0)
 ;
"RTN","LRRPLU",450,0)
MIMULTI ; Build array for MI subscript results.
"RTN","LRRPLU",451,0)
 ;
"RTN","LRRPLU",452,0)
 N LRX,X
"RTN","LRRPLU",453,0)
 S LRX="^1^^1^^^1^^^1^^^1^1^1^^^1^1^1^1^1^1^1^1^1^1^1^1^1"
"RTN","LRRPLU",454,0)
 I $P(LRX,"^",LRSECT) D  Q
"RTN","LRRPLU",455,0)
 . F  S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI  D
"RTN","LRRPLU",456,0)
 . . S X=^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI,0)
"RTN","LRRPLU",457,0)
 . . I LRSECT=14 S X=$P(X,"^")
"RTN","LRRPLU",458,0)
 . . S LRY(LRI)=X_"^"_LRROOT_LRSECT_","_LRI_",0"
"RTN","LRRPLU",459,0)
 . S LRI=$O(LRY(""),-1)+1
"RTN","LRRPLU",460,0)
 . S LRY(LRI)="ALL "_$S(LRSECT=14:"ANTIBIOTIC(for SERUM LEVEL)",1:"comments")_"^"_LRROOT_LRSECT_",0"
"RTN","LRRPLU",461,0)
 ;
"RTN","LRRPLU",462,0)
 S LRX="^^1^^^1^^^1^^^1^^^^^1^"
"RTN","LRRPLU",463,0)
 I $P(LRX,"^",LRSECT) D  Q
"RTN","LRRPLU",464,0)
 . F  S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI  D
"RTN","LRRPLU",465,0)
 . . S LRY(LRI)=$P(^LAB(61.2,+^(LRI,0),0),"^")_"^"_LRROOT_LRSECT_","_LRI_",0"
"RTN","LRRPLU",466,0)
 . . I LRSECT=3!(LRSECT=12) D
"RTN","LRRPLU",467,0)
 . . . N LRFLAG
"RTN","LRRPLU",468,0)
 . . . S X=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI,2)),LRFLAG=0
"RTN","LRRPLU",469,0)
 . . . I X\1=2 S LRFLAG=1
"RTN","LRRPLU",470,0)
 . . . I LRSECT=3,$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI,3,0)) S LRFLAG=1
"RTN","LRRPLU",471,0)
 . . . I LRFLAG<1 Q
"RTN","LRRPLU",472,0)
 . . . S LRY(LRI+.1)=$P(LRY(LRI),"^")_" Specific Susceptibilities"_"^"_LRROOT_LRSECT_","_LRI_","
"RTN","LRRPLU",473,0)
 . . . S $P(LRY(LRI),"^")=$P(LRY(LRI),"^")_" including All Susceptibilities"
"RTN","LRRPLU",474,0)
 . S LRI=$O(LRY(""),-1)+1\1,LRY(LRI)="ALL items^"_LRROOT_LRSECT_",0"
"RTN","LRRPLU",475,0)
 ;
"RTN","LRRPLU",476,0)
 Q
"RTN","LRRPLU",477,0)
 ;
"RTN","LRRPLU",478,0)
 ;
"RTN","LRRPLU",479,0)
MIAB(LRY,LRORG) ; Build array for MI susceptbility results.
"RTN","LRRPLU",480,0)
 ; Call with LRY = array to return selections
"RTN","LRRPLU",481,0)
 ;         LRORG = organism subscript
"RTN","LRRPLU",482,0)
 ;
"RTN","LRRPLU",483,0)
 N LRDN,LRI,LRJ
"RTN","LRRPLU",484,0)
 ;
"RTN","LRRPLU",485,0)
 S LRI=0,LRJ=2
"RTN","LRRPLU",486,0)
 F  S LRJ=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRORG,LRJ)) Q:'LRJ!(LRJ'<3)  D
"RTN","LRRPLU",487,0)
 . S LRDN=$$GETDRUG^LRRPL(LRSECT,LRJ)
"RTN","LRRPLU",488,0)
 . S LRI=LRI+1,LRY(LRI)=LRDN_"^"_LRROOT_LRSECT_","_LRORG_","_LRJ
"RTN","LRRPLU",489,0)
 ;
"RTN","LRRPLU",490,0)
 ; Collect free text antibiotics (#200)
"RTN","LRRPLU",491,0)
 I LRSECT=3,$D(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRORG,3,0)) D
"RTN","LRRPLU",492,0)
 . S LRJ=0
"RTN","LRRPLU",493,0)
 . F  S LRJ=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRORG,3,LRJ)) Q:'LRJ  D
"RTN","LRRPLU",494,0)
 . . S LRDN=$P(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRORG,3,LRJ,0),"^")
"RTN","LRRPLU",495,0)
 . . S LRI=LRI+1,LRY(LRI)=LRDN_"^"_LRROOT_LRSECT_","_LRORG_",3,"_LRJ_",0"
"RTN","LRRPLU",496,0)
 Q
"RTN","LRRPLU",497,0)
 ;
"RTN","LRRPLU",498,0)
 ;
"RTN","LRRPLU",499,0)
APMULTI ; Build array for AP subscript results.
"RTN","LRRPLU",500,0)
 ;
"RTN","LRRPLU",501,0)
 ; Autopsy comments (AZC)
"RTN","LRRPLU",502,0)
 I LRSS="AU",LRSECT="AZC" D  Q
"RTN","LRRPLU",503,0)
 . F  S LRI=$O(^LR(LRDFN,LRSECT,LRI)) Q:'LRI  S LRY(LRI)=^(LRI,0)_"^"_LRROOT_LRSECT_","_LRI_",0"
"RTN","LRRPLU",504,0)
 . S LRI=$O(LRY(""),-1)+1,LRY(LRI)="ALL comments^"_LRROOT_LRSECT_",0"
"RTN","LRRPLU",505,0)
 ;
"RTN","LRRPLU",506,0)
 ; Autopsy Supplementary reports (84)
"RTN","LRRPLU",507,0)
 I LRSS="AU",LRSECT=84 D  Q
"RTN","LRRPLU",508,0)
 . F  S LRI=$O(^LR(LRDFN,LRSECT,LRI)) Q:'LRI  S LRX=$$FMTE^XLFDT(+^(LRI,0),"1MZ"),LRY(LRI)=LRX_"^"_LRROOT_LRSECT_","_LRI_",0"
"RTN","LRRPLU",509,0)
 . S LRI=$O(LRY(""),-1)+1,LRY(LRI)="ALL Supplementary Reports^"_LRROOT_LRSECT_",0"
"RTN","LRRPLU",510,0)
 ;
"RTN","LRRPLU",511,0)
 ; Autopsy Special Studies (AY)
"RTN","LRRPLU",512,0)
 I LRSS="AU",LRSECT="AY" D  Q
"RTN","LRRPLU",513,0)
 . F  S LRI=$O(^LR(LRDFN,LRSECT,LRI)) Q:'LRI  D
"RTN","LRRPLU",514,0)
 . . S LRX=$P(^LAB(61,+^(LRI,0),0),"^"),LRY(LRI)=LRX_"^"_LRROOT_LRSECT_","_LRI_",0"
"RTN","LRRPLU",515,0)
 . . S LRY(LRI+.1)=$P(LRY(LRI),"^")_" Specific Special Studies"_"^"_LRROOT_LRSECT_","_LRI_","
"RTN","LRRPLU",516,0)
 . . S $P(LRY(LRI),"^")=$P(LRY(LRI),"^")_" including All Special Studies"
"RTN","LRRPLU",517,0)
 . S LRI=$O(LRY(""),-1)+1\1,LRY(LRI)="ALL Special Studies Reports^"_LRROOT_LRSECT_",0"
"RTN","LRRPLU",518,0)
 ;
"RTN","LRRPLU",519,0)
 ; Comment fields #97 and #99
"RTN","LRRPLU",520,0)
 I LRSECT=97!(LRSECT=99) D  Q
"RTN","LRRPLU",521,0)
 . F  S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI  S LRY(LRI)=^(LRI,0)_"^"_LRROOT_LRSECT_","_LRI_",0"
"RTN","LRRPLU",522,0)
 . S LRI=$O(LRY(""),-1)+1,LRY(LRI)="ALL comments^"_LRROOT_LRSECT_",0"
"RTN","LRRPLU",523,0)
 ;
"RTN","LRRPLU",524,0)
 ; Supplementary Reports
"RTN","LRRPLU",525,0)
 I LRSECT=1.2 D  Q
"RTN","LRRPLU",526,0)
 . F  S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI  S LRX=$$FMTE^XLFDT(+^(LRI,0),"1MZ"),LRY(LRI)=LRX_"^"_LRROOT_LRSECT_","_LRI_",0"
"RTN","LRRPLU",527,0)
 . S LRI=$O(LRY(""),-1)+1,LRY(LRI)="ALL Supplementary Reports^"_LRROOT_LRSECT_",0"
"RTN","LRRPLU",528,0)
 ;
"RTN","LRRPLU",529,0)
 ; Special Studies
"RTN","LRRPLU",530,0)
 I LRSECT=2 D  Q
"RTN","LRRPLU",531,0)
 . F  S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI  D
"RTN","LRRPLU",532,0)
 . . S LRX=$P(^LAB(61,+^(LRI,0),0),"^"),LRY(LRI)=LRX_"^"_LRROOT_LRSECT_","_LRI_",0"
"RTN","LRRPLU",533,0)
 . . S LRY(LRI+.1)=$P(LRY(LRI),"^")_" Specific Special Studies"_"^"_LRROOT_LRSECT_","_LRI_","
"RTN","LRRPLU",534,0)
 . . S $P(LRY(LRI),"^")=$P(LRY(LRI),"^")_" including All Special Studies"
"RTN","LRRPLU",535,0)
 . S LRI=$O(LRY(""),-1)+1\1,LRY(LRI)="ALL Special Studies Reports^"_LRROOT_LRSECT_",0"
"RTN","LRRPLU",536,0)
 ;
"RTN","LRRPLU",537,0)
 Q
"RTN","LRRPLU",538,0)
 ;
"RTN","LRRPLU",539,0)
 ;
"RTN","LRRPLU",540,0)
APSS(LRY,LRORGT) ; Build array for AP special studies.
"RTN","LRRPLU",541,0)
 ; Call with LRY = array to return selections
"RTN","LRRPLU",542,0)
 ;        LRORGT = organ/tissue ien
"RTN","LRRPLU",543,0)
 ;
"RTN","LRRPLU",544,0)
 N LRI,LRJ,LRS,LRSST,LRSUB
"RTN","LRRPLU",545,0)
 ;
"RTN","LRRPLU",546,0)
 S (LRI,LRJ)=0
"RTN","LRRPLU",547,0)
 ; Autopsy Special Studies (AY)
"RTN","LRRPLU",548,0)
 I LRSS="AU",LRSECT="AY" D  Q
"RTN","LRRPLU",549,0)
 . F  S LRJ=$O(^LR(LRDFN,LRSECT,LRORGT,5,LRJ)) Q:'LRJ  D
"RTN","LRRPLU",550,0)
 . . S LRS=^LR(LRDFN,LRSECT,LRORGT,5,LRJ,0),LRSST=$$EXTERNAL^DILFD(63.26,.01,"",$P(LRS,"^"),"")
"RTN","LRRPLU",551,0)
 . . S LRI=LRI+1,LRY(LRI)=LRSST_"^"_LRROOT_LRSECT_","_LRORGT_",5,"_LRJ
"RTN","LRRPLU",552,0)
 ;
"RTN","LRRPLU",553,0)
 S LRSUB=$S(LRSS="SP":63.819,LRSS="CY":63.919,1:63.219)
"RTN","LRRPLU",554,0)
 F  S LRJ=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRORGT,5,LRJ)) Q:'LRJ  D
"RTN","LRRPLU",555,0)
 . S LRS=^LR(LRDFN,LRSS,LRIDT,LRSECT,LRORGT,5,LRJ,0),LRSST=$$EXTERNAL^DILFD(LRSUB,.01,"",$P(LRS,"^"),"")
"RTN","LRRPLU",556,0)
 . S LRI=LRI+1,LRY(LRI)=LRSST_"^"_LRROOT_LRSECT_","_LRORGT_",5,"_LRJ
"RTN","LRRPLU",557,0)
 Q
"RTN","LRSCTF1")
0^15^B9071625
"RTN","LRSCTF1",1,0)
LRSCTF1 ;DALOI/JDB - SCT POPULATION/ERT ALERT ;01/16/13  10:02
"RTN","LRSCTF1",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRSCTF1",3,0)
 ;
"RTN","LRSCTF1",4,0)
 ; Reference to LABXCPT^HDISVAP1 supported by DBIA #5026
"RTN","LRSCTF1",5,0)
 Q
"RTN","LRSCTF1",6,0)
 ;
"RTN","LRSCTF1",7,0)
 ;
"RTN","LRSCTF1",8,0)
NOTIFY(LRTXT,LRFILE,LRFIEN,LRSCT,EXCDATA,LRDUPCHK) ;
"RTN","LRSCTF1",9,0)
 ;LABXCPT^HDISVAP1/5026
"RTN","LRSCTF1",10,0)
 ; Private helper method
"RTN","LRSCTF1",11,0)
 ; Handles ERT/Local notification for "Load Exception" errors.
"RTN","LRSCTF1",12,0)
 ; If an SCT load exception occurs and not in ^XTMP alert ERT.
"RTN","LRSCTF1",13,0)
 ; Inputs
"RTN","LRSCTF1",14,0)
 ;    LRTXT: Code text
"RTN","LRSCTF1",15,0)
 ;   LRFILE: Target file #
"RTN","LRSCTF1",16,0)
 ;   LRFIEN: Target file # IEN
"RTN","LRSCTF1",17,0)
 ;    LRSCT: SCT Code <opt>
"RTN","LRSCTF1",18,0)
 ;  EXCDATA:<byref>
"RTN","LRSCTF1",19,0)
 ; LRDUPCHK: Check for duplicate alert <opt>
"RTN","LRSCTF1",20,0)
 ; Outputs
"RTN","LRSCTF1",21,0)
 ;  String indicating success or error.
"RTN","LRSCTF1",22,0)
 ;     On success returns the new ^XTMP IEN
"RTN","LRSCTF1",23,0)
 ;     On failure returns "0^num^msg"
"RTN","LRSCTF1",24,0)
 ;         ie  "0^1^Term is null"
"RTN","LRSCTF1",25,0)
 ;  Returns transaction # in EXCDATA("TNUM")
"RTN","LRSCTF1",26,0)
 ;
"RTN","LRSCTF1",27,0)
 N DATA,LRIN,NOW,STR,STR2,NOTIFY,SITE
"RTN","LRSCTF1",28,0)
 N TNUM,TMPNM,TEXT,I,II,X,Y,LRHDI,LRHDIERR
"RTN","LRSCTF1",29,0)
 S LRTXT=$G(LRTXT)
"RTN","LRSCTF1",30,0)
 I $TR(LRTXT," ","")="" Q "0^1^Term is null"
"RTN","LRSCTF1",31,0)
 S LRFILE=$G(LRFILE),LRFIEN=$G(LRFIEN),LRSCT=$G(LRSCT),LRDUPCHK=$G(LRDUPCHK,1)
"RTN","LRSCTF1",32,0)
 S NOTIFY=1 ;status of this process
"RTN","LRSCTF1",33,0)
 S TMPNM="LRSCTF-STS"
"RTN","LRSCTF1",34,0)
 S NOW=$$NOW^XLFDT()
"RTN","LRSCTF1",35,0)
 S TEXT=$$TRIM^XLFSTR(LRTXT),TEXT=$$UP^XLFSTR(TEXT)
"RTN","LRSCTF1",36,0)
 S STR=$E(TEXT,1,200) ;some terms can be long and wont fit in a node
"RTN","LRSCTF1",37,0)
 ; check if this term has been sent already.
"RTN","LRSCTF1",38,0)
 K LRIN
"RTN","LRSCTF1",39,0)
 S LRIN("FILE")=LRFILE,LRIN("SCT")=LRSCT,LRIN("PREV","SCT")=$$GET1^DIQ(LRFILE,LRFIEN_",",20)
"RTN","LRSCTF1",40,0)
 S X=$$OK2LOG^LRERT(.LRTXT,.LRIN,TMPNM)
"RTN","LRSCTF1",41,0)
 I $G(LRDUPCHK),'X,$P(X,"^",2)'=2 Q "0^2^Notification already sent."
"RTN","LRSCTF1",42,0)
 K DATA,LRHDI,TEXT,STR
"RTN","LRSCTF1",43,0)
 ;
"RTN","LRSCTF1",44,0)
 S TNUM=$$TNUM^LRERT(LRFILE,LRFIEN,NOW,1)
"RTN","LRSCTF1",45,0)
 S EXCDATA("TNUM")=TNUM
"RTN","LRSCTF1",46,0)
 S LRHDI(1,1)=TNUM_"^"_NOW
"RTN","LRSCTF1",47,0)
 S X=$$BLDERTX^LRERT(LRFILE,LRFIEN,"|",.DATA,2,"S")
"RTN","LRSCTF1",48,0)
 S I=0
"RTN","LRSCTF1",49,0)
 F  S I=$O(DATA(I)) Q:'I  S LRHDI(1,1,"SA",I)=DATA(I)
"RTN","LRSCTF1",50,0)
 ; see patch HDI*1.0*7 for array details
"RTN","LRSCTF1",51,0)
 F I=7:1:11  I $G(EXCDATA("SA",I))'="" S LRHDI(1,1,"SA",I)=EXCDATA("SA",I)
"RTN","LRSCTF1",52,0)
 ;
"RTN","LRSCTF1",53,0)
 S LRHDI(1,1,"RD",5)=1
"RTN","LRSCTF1",54,0)
 F I=1:1:6  I $G(EXCDATA("RD",I))'="" S LRHDI(1,1,"RD",I)=EXCDATA("RD",I)
"RTN","LRSCTF1",55,0)
 ;
"RTN","LRSCTF1",56,0)
 S LRHDI(1,1,"TXT")=$G(EXCDATA("TXT"))
"RTN","LRSCTF1",57,0)
 ;
"RTN","LRSCTF1",58,0)
 D LABXCPT^HDISVAP1("LRHDI")
"RTN","LRSCTF1",59,0)
 ; check LRHDI("ERROR")
"RTN","LRSCTF1",60,0)
 K LRHDIERR
"RTN","LRSCTF1",61,0)
 M LRHDIERR("ERROR")=LRHDI("ERROR")
"RTN","LRSCTF1",62,0)
 K LRHDI
"RTN","LRSCTF1",63,0)
 ;
"RTN","LRSCTF1",64,0)
 ; Update ^XTMP
"RTN","LRSCTF1",65,0)
 K LRIN
"RTN","LRSCTF1",66,0)
 S LRIN("TNUM")=TNUM ;trans #
"RTN","LRSCTF1",67,0)
 S LRIN("TDT")=NOW ;trans date/time
"RTN","LRSCTF1",68,0)
 S LRIN("FILE")=LRFILE ; targ file
"RTN","LRSCTF1",69,0)
 S LRIN("FIEN")=LRFIEN ;targ file IEN
"RTN","LRSCTF1",70,0)
 S LRIN("SCT")=LRSCT ;SCT code
"RTN","LRSCTF1",71,0)
 S LRIN("STSEXC")=1 ;STS exception type
"RTN","LRSCTF1",72,0)
 S LRIN("HDIERR")=$S($D(LRHDIERR):1,1:0) ;STS error flag (0 or 1)
"RTN","LRSCTF1",73,0)
 S LRIN("PREV","SCT")=""
"RTN","LRSCTF1",74,0)
 S LRIN("PREV","TEXT")=""
"RTN","LRSCTF1",75,0)
 S X=$$LOGIT^LRERT(.LRTXT,.LRIN,TMPNM)
"RTN","LRSCTF1",76,0)
 I X S EXCDATA("IEN")=X
"RTN","LRSCTF1",77,0)
 I 'X D  ;
"RTN","LRSCTF1",78,0)
 . S Y=$P(X,"^",2)
"RTN","LRSCTF1",79,0)
 . S Y=Y+10 ;new error code group
"RTN","LRSCTF1",80,0)
 . S NOTIFY="0^"_Y_"^$$LOGIT failed: "_$P(X,"^",3)
"RTN","LRSCTF1",81,0)
 I $G(LRHDIERR("ERROR"))'="" S NOTIFY="0^5^LABXCPT failed: "_LRHDIERR("ERROR")
"RTN","LRSCTF1",82,0)
 Q NOTIFY
"RTN","LRSPRPTA")
0^38^B14810851
"RTN","LRSPRPTA",1,0)
LRSPRPTA ;DALOI/STAFF - CY/EM/SP PATIENT RPT (cont'd) ;03/21/13  15:29
"RTN","LRSPRPTA",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRSPRPTA",3,0)
 ;
"RTN","LRSPRPTA",4,0)
 ; Continuation of LRSPRPT.
"RTN","LRSPRPTA",5,0)
 ;
"RTN","LRSPRPTA",6,0)
EN ; from LRSPRPT
"RTN","LRSPRPTA",7,0)
 ; Suppress SNOMED codes except on Preliminary
"RTN","LRSPRPTA",8,0)
 S LR("SPSM")=$S($G(LRPRE):0,1:1)
"RTN","LRSPRPTA",9,0)
 S LR(.21)=+$G(^LRO(69.2,+$G(LRAA),.2))
"RTN","LRSPRPTA",10,0)
 K LRO Q:'$D(^LR(LRDFN,LRSS,LRI,0))
"RTN","LRSPRPTA",11,0)
 S LRQ=0
"RTN","LRSPRPTA",12,0)
 D ^LRUA
"RTN","LRSPRPTA",13,0)
 ;
"RTN","LRSPRPTA",14,0)
 D GETPCP^LRAPUTL(.LRPRAC,LRDFN,LRSS,LRI)
"RTN","LRSPRPTA",15,0)
 ;
"RTN","LRSPRPTA",16,0)
 D ^LRAPF Q:LR("Q")
"RTN","LRSPRPTA",17,0)
 S LR("F")=1 W !,"Submitted by: ",LRW(5),?44,"Date obtained: ",LRTK
"RTN","LRSPRPTA",18,0)
 D:LRA W^LRSPRPT
"RTN","LRSPRPTA",19,0)
 W !,"Specimen (Received ",LRTK(1),"):" S LRV=.1 D A^LRSPRPT Q:LR("Q")
"RTN","LRSPRPTA",20,0)
 I $P($G(^LR(LRDFN,LRSS,LRI,1.2,0)),"^",4) D
"RTN","LRSPRPTA",21,0)
 . W !?14,"*+* SUPPLEMENTARY REPORT HAS BEEN ADDED *+*"
"RTN","LRSPRPTA",22,0)
 . W !?19,"*+* REFER TO BOTTOM OF REPORT *+*",!
"RTN","LRSPRPTA",23,0)
 ;
"RTN","LRSPRPTA",24,0)
 ; DALOI/LMT - LR,427 - Removed comments from report to restore pre-LR,350 behavior
"RTN","LRSPRPTA",25,0)
 ;I $O(^LR(LRDFN,LRSS,LRI,99,0)) W !,"Comment:"
"RTN","LRSPRPTA",26,0)
 ;S LRB=0
"RTN","LRSPRPTA",27,0)
 ;F  S LRB=$O(^LR(LRDFN,LRSS,LRI,99,LRB)) Q:'LRB!(LR("Q"))  D
"RTN","LRSPRPTA",28,0)
 ;. W !,^LR(LRDFN,LRSS,LRI,99,LRB,0)
"RTN","LRSPRPTA",29,0)
 ;. I $G(LRSF515),$Y>(IOSL-11) D F^LRAPF,^LRAPF
"RTN","LRSPRPTA",30,0)
 ;
"RTN","LRSPRPTA",31,0)
 D:LRA W^LRSPRPT W !,"Brief Clinical History:" S LRV=.2 D F^LRSPRPT Q:LR("Q")
"RTN","LRSPRPTA",32,0)
 D:LRA W^LRSPRPT W !,"Preoperative Diagnosis:" S LRV=.3 D F^LRSPRPT Q:LR("Q")
"RTN","LRSPRPTA",33,0)
 D:LRA W^LRSPRPT W !,"Operative Findings:" S LRV=.4 D F^LRSPRPT Q:LR("Q")
"RTN","LRSPRPTA",34,0)
 D:LRA W^LRSPRPT W !,"Postoperative Diagnosis:" S LRV=.5 D F^LRSPRPT Q:LR("Q")
"RTN","LRSPRPTA",35,0)
 ;
"RTN","LRSPRPTA",36,0)
 ;
"RTN","LRSPRPTA",37,0)
 ; Retrieve surgeon/attending
"RTN","LRSPRPTA",38,0)
 D ATTEND^LRAPBR1(.LRMD)
"RTN","LRSPRPTA",39,0)
 I LRMD'="" W !?27,"Surgeon/physician: ",LRMD
"RTN","LRSPRPTA",40,0)
 I LRMD("SR-SURGEON")'="" w !,?28,LRMD("SR-SURGEON")
"RTN","LRSPRPTA",41,0)
 I LRMD("SR-ATTEND")'="" W !,?26,LRMD("SR-ATTEND")
"RTN","LRSPRPTA",42,0)
 ;I +$G(LRMD("ERR"))=601 W !,?26,$P(LRMD("ERR"),"^",2)
"RTN","LRSPRPTA",43,0)
 ;
"RTN","LRSPRPTA",44,0)
 I LRA W !,LR("%1")
"RTN","LRSPRPTA",45,0)
 ;
"RTN","LRSPRPTA",46,0)
 I $Y>(IOSL-14) D  Q:LR("Q")
"RTN","LRSPRPTA",47,0)
 . D F^LRAPF,^LRAPF
"RTN","LRSPRPTA",48,0)
 E  D P^LRAPF
"RTN","LRSPRPTA",49,0)
 ;I $Y>(IOSL-8) D F^LRAPF,^LRAPF Q:LR("Q")
"RTN","LRSPRPTA",50,0)
 D:LRA W^LRSPRPT
"RTN","LRSPRPTA",51,0)
 W:LRRC="" !?20,"+*+* REPORT INCOMPLETE *+*+",!
"RTN","LRSPRPTA",52,0)
 I $Y>(IOSL-11) D F^LRAPF,^LRAPF Q:LR("Q")
"RTN","LRSPRPTA",53,0)
 ;
"RTN","LRSPRPTA",54,0)
 W !
"RTN","LRSPRPTA",55,0)
 I LRRMD'="" W ?31,$S(LRSS="SP":"Pathology Resident: ",LRSS="CY":"Screened by: ",LRSS="EM":"Prepared by: ",1:" "),LRRMD
"RTN","LRSPRPTA",56,0)
 I $O(^LR(LRDFN,LRSS,LRI,1.3,0)) D  Q:LR("Q")
"RTN","LRSPRPTA",57,0)
 . I $Y>(IOSL-11) D F^LRAPF,^LRAPF Q:LR("Q")
"RTN","LRSPRPTA",58,0)
 . W !,LR(69.2,.13)
"RTN","LRSPRPTA",59,0)
 . I $P($G(^LR(LRDFN,LRSS,LRI,6,0)),U,4) S LR(0)=6 D ^LRSPRPTM
"RTN","LRSPRPTA",60,0)
 ;
"RTN","LRSPRPTA",61,0)
 S LRV=1.3 D F^LRSPRPT Q:LR("Q")
"RTN","LRSPRPTA",62,0)
 I $O(^LR(LRDFN,LRSS,LRI,1,0)) D  Q:LR("Q")
"RTN","LRSPRPTA",63,0)
 . I $Y>(IOSL-11) D F^LRAPF,^LRAPF Q:LR("Q")
"RTN","LRSPRPTA",64,0)
 . W !,LR(69.2,.03)
"RTN","LRSPRPTA",65,0)
 . I $P($G(^LR(LRDFN,LRSS,LRI,7,0)),U,4) S LR(0)=7 D ^LRSPRPTM
"RTN","LRSPRPTA",66,0)
 ;
"RTN","LRSPRPTA",67,0)
 S LRV=1 D F^LRSPRPT Q:LR("Q")
"RTN","LRSPRPTA",68,0)
 I $O(^LR(LRDFN,LRSS,LRI,1.1,0)) D  Q:LR("Q")
"RTN","LRSPRPTA",69,0)
 . I $Y>(IOSL-11) D F^LRAPF,^LRAPF Q:LR("Q")
"RTN","LRSPRPTA",70,0)
 . W !,LR(69.2,.04)
"RTN","LRSPRPTA",71,0)
 . I $P($G(^LR(LRDFN,LRSS,LRI,4,0)),"^",4) S LR(0)=4 D ^LRSPRPTM
"RTN","LRSPRPTA",72,0)
 ;
"RTN","LRSPRPTA",73,0)
 S LRV=1.1 D F^LRSPRPT Q:LR("Q")
"RTN","LRSPRPTA",74,0)
 I $O(^LR(LRDFN,LRSS,LRI,1.4,0)) D  Q:LR("Q")
"RTN","LRSPRPTA",75,0)
 . I $Y>(IOSL-11) D F^LRAPF,^LRAPF Q:LR("Q")
"RTN","LRSPRPTA",76,0)
 . W !,LR(69.2,.14)
"RTN","LRSPRPTA",77,0)
 . I $P($G(^LR(LRDFN,LRSS,LRI,5,0)),U,4) S LR(0)=5 D ^LRSPRPTM
"RTN","LRSPRPTA",78,0)
 ;
"RTN","LRSPRPTA",79,0)
 S LRV=1.4 D F^LRSPRPT Q:LR("Q")
"RTN","LRSPRPTA",80,0)
 ;
"RTN","LRSPRPTA",81,0)
 ; Supplementary Report
"RTN","LRSPRPTA",82,0)
 I $O(^LR(LRDFN,LRSS,LRI,1.2,0)) D:LR(.21) F^LRAPF,^LRAPF Q:LR("Q")  D
"RTN","LRSPRPTA",83,0)
 . D:$Y>(IOSL-13) F^LRAPF,^LRAPF Q:LR("Q")
"RTN","LRSPRPTA",84,0)
 . W !,"Supplementary Report:"
"RTN","LRSPRPTA",85,0)
 . S LRV=0 F  S LRV=$O(^LR(LRDFN,LRSS,LRI,1.2,LRV)) Q:'LRV!(LR("Q"))  D
"RTN","LRSPRPTA",86,0)
 . . S X=^LR(LRDFN,LRSS,LRI,1.2,LRV,0) D S^LRSPRPT
"RTN","LRSPRPTA",87,0)
 D ^LRSPRPT1 Q:LR("Q")
"RTN","LRSPRPTA",88,0)
 ;
"RTN","LRSPRPTA",89,0)
 ; Print performing laboratory if designated
"RTN","LRSPRPTA",90,0)
 D PPL
"RTN","LRSPRPTA",91,0)
 ;
"RTN","LRSPRPTA",92,0)
 ; Don't set the final flag and print the footer if prelim
"RTN","LRSPRPTA",93,0)
 Q:+$G(LRPRE)
"RTN","LRSPRPTA",94,0)
 S LRO=1 D F^LRAPF
"RTN","LRSPRPTA",95,0)
 Q
"RTN","LRSPRPTA",96,0)
 ;
"RTN","LRSPRPTA",97,0)
 ;
"RTN","LRSPRPTA",98,0)
PPL ; Print any performing laboratories
"RTN","LRSPRPTA",99,0)
 ;
"RTN","LRSPRPTA",100,0)
 N LRPL,LRJ,LRX
"RTN","LRSPRPTA",101,0)
 ;
"RTN","LRSPRPTA",102,0)
 D RETLST^LRRPL(.LRPL,LRDFN,LRSS,LRI,0)
"RTN","LRSPRPTA",103,0)
 I $G(LRPL)<1 Q
"RTN","LRSPRPTA",104,0)
 ;
"RTN","LRSPRPTA",105,0)
 ; Start new page if space on existing page too small to display a significant portion of labs
"RTN","LRSPRPTA",106,0)
 I $Y>(IOSL-15) D F^LRAPF,^LRAPF Q:LR("Q")
"RTN","LRSPRPTA",107,0)
 ;
"RTN","LRSPRPTA",108,0)
 W !!,$$REPEAT^XLFSTR("=",IOM)
"RTN","LRSPRPTA",109,0)
 W !,"Performing Laboratory:",!
"RTN","LRSPRPTA",110,0)
 S LRJ=0
"RTN","LRSPRPTA",111,0)
 F  S LRJ=$O(LRPL(LRJ)) Q:'LRJ  D  Q:LR("Q")
"RTN","LRSPRPTA",112,0)
 . I $Y>(IOSL-12) D F^LRAPF,^LRAPF Q:LR("Q")  W !,"Performing Laboratory (cont'd):",!
"RTN","LRSPRPTA",113,0)
 . W !,LRPL(LRJ)
"RTN","LRSPRPTA",114,0)
 ;
"RTN","LRSPRPTA",115,0)
 Q
"RTN","LRUDEL")
0^43^B24276751
"RTN","LRUDEL",1,0)
LRUDEL ;DALOI/REG/CYM - DELETE AN AP ACCESSION NUMBER ;08/14/13  16:45
"RTN","LRUDEL",2,0)
 ;;5.2;LAB SERVICE;**1,72,121,201,350,427**;Sep 27, 1994;Build 33
"RTN","LRUDEL",3,0)
 ;
"RTN","LRUDEL",4,0)
 D END,^LRAP G:'$D(Y) END D XR^LRU
"RTN","LRUDEL",5,0)
 W !?22,"Delete an Accession Number",!!
"RTN","LRUDEL",6,0)
 ;
"RTN","LRUDEL",7,0)
D S %DT("A")="Accession number date: ",%DT="AQE" D ^%DT K %DT Q:Y<1  S (Y,LRAD)=$E(Y,1,3)_"0000" D DATE S LRH(0)=Y
"RTN","LRUDEL",8,0)
 ;
"RTN","LRUDEL",9,0)
 I '$D(^LRO(68,LRAA,1,LRAD,0)) W $C(7),!!,"No accession numbers for ",LRH(0),! G D
"RTN","LRUDEL",10,0)
 S H(2)=$E(LRAD,1,3)
"RTN","LRUDEL",11,0)
N1 K LRNO
"RTN","LRUDEL",12,0)
 R !!,"Select Accession # : ",LRAN:DTIME Q:LRAN=""!(LRAN["^")
"RTN","LRUDEL",13,0)
 D REST
"RTN","LRUDEL",14,0)
 L -^LRO(69.2,LRAA)
"RTN","LRUDEL",15,0)
 I $G(LRDFN),$G(LRSS)'="" L -^LR(LRDFN,LRSS)
"RTN","LRUDEL",16,0)
 G N1
"RTN","LRUDEL",17,0)
 ;
"RTN","LRUDEL",18,0)
 ;
"RTN","LRUDEL",19,0)
REST ;
"RTN","LRUDEL",20,0)
 ;
"RTN","LRUDEL",21,0)
 N LRDIV
"RTN","LRUDEL",22,0)
 ;
"RTN","LRUDEL",23,0)
 I LRAN'?1N.N W $C(7),!!,"Enter NUMBERS only" Q
"RTN","LRUDEL",24,0)
 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W $C(7),!!,"Accession number ",LRAN," for ",LRH(0)," not in ACCESSION file",!! Q
"RTN","LRUDEL",25,0)
 ;
"RTN","LRUDEL",26,0)
 L +^LRO(68,LRAA,1,LRAD,1,LRAN):DILOCKTM
"RTN","LRUDEL",27,0)
 I '$T W !!?10,$C(7),"Someone else is editing this entry ",! Q
"RTN","LRUDEL",28,0)
 ;
"RTN","LRUDEL",29,0)
 L +^LRO(69.2,LRAA):DILOCKTM
"RTN","LRUDEL",30,0)
 I '$T W !!?10,$C(7),"Someone else is editing this entry ",! Q
"RTN","LRUDEL",31,0)
 ;
"RTN","LRUDEL",32,0)
 S LRND=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRDFN=+LRND
"RTN","LRUDEL",33,0)
 S LRDIV=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.4)),U,1)
"RTN","LRUDEL",34,0)
 I '$D(^LR(LRDFN,0)) D BAD Q
"RTN","LRUDEL",35,0)
 ;
"RTN","LRUDEL",36,0)
 S Y=^LR(LRDFN,0),LRPFN=$P(Y,U,2),LRFNAM=$P(^DIC(LRPFN,0),U),LRPF=^(0,"GL"),Y=$P(Y,U,3),LRP=@(LRPF_Y_",0)")
"RTN","LRUDEL",37,0)
 W !,$P(LRP,U)," ID: ",$P(LRP,U,9) S Y=$P(LRP,U,3) D DATE W:Y'[1700 " DOB: ",Y
"RTN","LRUDEL",38,0)
 W !!,"ACC # ",LRAN
"RTN","LRUDEL",39,0)
 ;
"RTN","LRUDEL",40,0)
 I LRSS="AU" D  Q
"RTN","LRUDEL",41,0)
 . S LRRC=$P($G(^LR(LRDFN,"AU")),U)
"RTN","LRUDEL",42,0)
 . S Y=$$GET1^DIQ(63,LRDFN_",",12) ;Date of Death
"RTN","LRUDEL",43,0)
 . D DEL^LRAUAW
"RTN","LRUDEL",44,0)
 ;
"RTN","LRUDEL",45,0)
 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) D
"RTN","LRUDEL",46,0)
 . S LRI=$O(^LR(LRXREF,H(2),LRABV,LRAN,LRDFN,0))
"RTN","LRUDEL",47,0)
 . I LRI S LRSD=$P($G(^LR(LRDFN,LRSS,LRI,0)),U,1)
"RTN","LRUDEL",48,0)
 ;
"RTN","LRUDEL",49,0)
 I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) D
"RTN","LRUDEL",50,0)
 . S X=^LRO(68,LRAA,1,LRAD,1,LRAN,3)
"RTN","LRUDEL",51,0)
 . S LRSD=+X
"RTN","LRUDEL",52,0)
 . S LRI=$P(X,"^",5)
"RTN","LRUDEL",53,0)
 . I 'LRI S LRI=$O(^LR(LRXREF,H(2),LRABV,LRAN,LRDFN,0))
"RTN","LRUDEL",54,0)
 ;
"RTN","LRUDEL",55,0)
 I '$G(LRI) D  Q  ;No data in #63 for this accession; only delete from #68
"RTN","LRUDEL",56,0)
 . W "  OK to DELETE "
"RTN","LRUDEL",57,0)
 . S %=2 D YN^LRU
"RTN","LRUDEL",58,0)
 . I %'=1 W $C(7),!?4,"NOT DELETED",!! Q
"RTN","LRUDEL",59,0)
 . K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,"AC",LRDIV,LRAD,LRAN)
"RTN","LRUDEL",60,0)
 . D T
"RTN","LRUDEL",61,0)
 . W !,LRAN," Deleted"
"RTN","LRUDEL",62,0)
  ;
"RTN","LRUDEL",63,0)
 S X=$G(^LR(LRDFN,LRSS,LRI,0))
"RTN","LRUDEL",64,0)
 S LRRC=$P(X,U,10)
"RTN","LRUDEL",65,0)
 I $P(X,"^",3)!($P(X,"^",11))!($P(X,"^",15)) W $C(7),!,"Report completed &/or released, deletion not allowed." Q
"RTN","LRUDEL",66,0)
 ;
"RTN","LRUDEL",67,0)
 L +^LR(LRDFN,LRSS,LRI):DILOCKTM
"RTN","LRUDEL",68,0)
 I '$T W !!?10,"Someone else is editing this entry ",!,$C(7) Q
"RTN","LRUDEL",69,0)
 ;
"RTN","LRUDEL",70,0)
 S Y=LRRC
"RTN","LRUDEL",71,0)
 D DATE
"RTN","LRUDEL",72,0)
 W "  DATE RECEIVED: ",Y,"  OK to DELETE "
"RTN","LRUDEL",73,0)
 S %=2 D YN^LRU
"RTN","LRUDEL",74,0)
 I %'=1 W $C(7),!?4,"NOT DELETED",!! Q
"RTN","LRUDEL",75,0)
 ;
"RTN","LRUDEL",76,0)
 D DEL69AN
"RTN","LRUDEL",77,0)
 ;
"RTN","LRUDEL",78,0)
 D ACC^LR7OB1(LRAA,LRAD,LRAN,"OC") ; Cancel order
"RTN","LRUDEL",79,0)
 ;
"RTN","LRUDEL",80,0)
 I $D(^LR(LRDFN,LRSS,LRI)) D
"RTN","LRUDEL",81,0)
 . K ^LR(LRDFN,LRSS,LRI)
"RTN","LRUDEL",82,0)
 . I $D(^LR(LRDFN,LRSS,0)) S X=^LR(LRDFN,LRSS,0),X(1)=$O(^(0)),X(2)=$P(X,"^",4)-1,^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_X(2)
"RTN","LRUDEL",83,0)
 ;
"RTN","LRUDEL",84,0)
 K:LRRC ^LR(LRXR,LRRC,LRDFN,LRI)
"RTN","LRUDEL",85,0)
 K ^LR(LRXREF,H(2),LRABV,LRAN,LRDFN,LRI)
"RTN","LRUDEL",86,0)
 D K
"RTN","LRUDEL",87,0)
 K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LRO(68,LRAA,1,"AC",LRDIV,LRAD,LRAN)
"RTN","LRUDEL",88,0)
 K:LRRC ^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)
"RTN","LRUDEL",89,0)
 ;
"RTN","LRUDEL",90,0)
 L +^LRO(68,LRAA,1,LRAD,1,0):DILOCKTM
"RTN","LRUDEL",91,0)
 I $T D
"RTN","LRUDEL",92,0)
 . S X=^LRO(68,LRAA,1,LRAD,1,0),X(1)=$O(^(0)),X(2)=$P(X,"^",4)-1
"RTN","LRUDEL",93,0)
 . S:X(2)<1 X(2)=0 S ^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_X(2)
"RTN","LRUDEL",94,0)
 . L -^LRO(68,LRAA,1,LRAD,1,0)
"RTN","LRUDEL",95,0)
 ;
"RTN","LRUDEL",96,0)
 D T
"RTN","LRUDEL",97,0)
 Q
"RTN","LRUDEL",98,0)
 ;
"RTN","LRUDEL",99,0)
 ;
"RTN","LRUDEL",100,0)
BAD W $C(7),!!,"Entry not in file",!!
"RTN","LRUDEL",101,0)
 Q
"RTN","LRUDEL",102,0)
 ;
"RTN","LRUDEL",103,0)
 ;
"RTN","LRUDEL",104,0)
T ;
"RTN","LRUDEL",105,0)
 N A
"RTN","LRUDEL",106,0)
 F A=1,2,3,4 I $D(^LRO(69.2,LRAA,A,LRAN)) D
"RTN","LRUDEL",107,0)
 . K ^LRO(69.2,LRAA,A,LRAN)
"RTN","LRUDEL",108,0)
 . S X(1)=$O(^LRO(69.2,LRAA,A,0))
"RTN","LRUDEL",109,0)
 . S:'X(1) X(1)=0
"RTN","LRUDEL",110,0)
 . I $D(^LRO(69.2,LRAA,A,0)) S X=^(0),^(0)=$P(X,"^",1,2)_"^"_X(1)_"^"_$S(X(1)=0:X(1),1:($P(X,"^",4)-1))
"RTN","LRUDEL",111,0)
 Q
"RTN","LRUDEL",112,0)
 ;
"RTN","LRUDEL",113,0)
 ;
"RTN","LRUDEL",114,0)
DATE ; Returns the date in eye-readable month format
"RTN","LRUDEL",115,0)
 S Y=$TR($$FMTE^XLFDT(Y,"M"),"@"," ")
"RTN","LRUDEL",116,0)
 Q
"RTN","LRUDEL",117,0)
 ;
"RTN","LRUDEL",118,0)
 ;
"RTN","LRUDEL",119,0)
K ; also from LRAPED
"RTN","LRUDEL",120,0)
 N A
"RTN","LRUDEL",121,0)
 S A=0
"RTN","LRUDEL",122,0)
 F  S A=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,A)) Q:'A  K ^LRO(68,"AA",LRAA_"|"_LRAD_"|"_LRAN_"|"_A)
"RTN","LRUDEL",123,0)
 Q
"RTN","LRUDEL",124,0)
 ;
"RTN","LRUDEL",125,0)
 ;
"RTN","LRUDEL",126,0)
DEL69AN ; Delete accession number out of file #69's reference
"RTN","LRUDEL",127,0)
 N LRODT,LRSN,LRI,DR,DIE,DA
"RTN","LRUDEL",128,0)
 S LRODT=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",4)
"RTN","LRUDEL",129,0)
 S LRSN=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",5)
"RTN","LRUDEL",130,0)
 ;
"RTN","LRUDEL",131,0)
 L +^LRO(69,LRODT,1,LRSN,2):DILOCKTM
"RTN","LRUDEL",132,0)
 I '$T W !!?10,$C(7),"Someone else is editing this entry ",! Q
"RTN","LRUDEL",133,0)
 ;
"RTN","LRUDEL",134,0)
 S DR="3///@;2///@;4///@;13///@;8///CA;9///L;10///^S X=DUZ"
"RTN","LRUDEL",135,0)
 S DIE="^LRO(69,"_LRODT_",1,"_LRSN_",2,",LRI=0
"RTN","LRUDEL",136,0)
 F  S LRI=$O(^LRO(69,LRODT,1,LRSN,2,LRI)) Q:'LRI  D
"RTN","LRUDEL",137,0)
 .Q:'$D(^LRO(69,LRODT,1,LRSN,2,LRI,0))
"RTN","LRUDEL",138,0)
 .Q:$P(^LRO(69,LRODT,1,LRSN,2,LRI,0),"^",5)'=LRAN
"RTN","LRUDEL",139,0)
 .Q:$P(^LRO(69,LRODT,1,LRSN,2,LRI,0),"^",4)'=LRAA
"RTN","LRUDEL",140,0)
 .Q:$P(^LRO(69,LRODT,1,LRSN,2,LRI,0),"^",3)'=LRAD
"RTN","LRUDEL",141,0)
 .S DA=LRI,DA(1)=LRSN,DA(2)=LRODT
"RTN","LRUDEL",142,0)
 .D ^DIE
"RTN","LRUDEL",143,0)
 L -^LRO(69,LRODT,1,LRSN,2)
"RTN","LRUDEL",144,0)
 Q
"RTN","LRUDEL",145,0)
 ;
"RTN","LRUDEL",146,0)
 ;
"RTN","LRUDEL",147,0)
END D V^LRU
"RTN","LRUDEL",148,0)
 Q
"RTN","LRVR0")
0^40^B127185317
"RTN","LRVR0",1,0)
LRVR0 ;DALOI/STAFF - LEDI MI/AP Data Verification ;08/12/13  11:08
"RTN","LRVR0",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRVR0",3,0)
 ;
"RTN","LRVR0",4,0)
 ; LEDI MI/AP Auto-instrument verification
"RTN","LRVR0",5,0)
 ; Called from LRVR
"RTN","LRVR0",6,0)
 Q
"RTN","LRVR0",7,0)
 ;
"RTN","LRVR0",8,0)
 ;
"RTN","LRVR0",9,0)
EN ;
"RTN","LRVR0",10,0)
 N EAMODE,LA7X,LRANYAA,LRAO,LRBG0,LRCFL,LRCMNT,LRDINST,LREND,LRFIFO,LRFLAG,LRINTYPE,LRLEDI,LRLLT,LRMIDEF,LRMIOTH
"RTN","LRVR0",11,0)
 N LRNOP,LRONESPC,LRONETST,LRPG,LRPTP,LRSAME,LRSB,LRSS,LRTM60,LRTX,LRUID,LRWRDVEW,LRX,X,Y
"RTN","LRVR0",12,0)
 ;
"RTN","LRVR0",13,0)
 S LRSS=$P($G(^LRO(68,+$G(LRAA),0)),U,2) Q:LRSS=""
"RTN","LRVR0",14,0)
 I LRSS'?1(1"MI",1"SP",1"CY",1"EM") Q
"RTN","LRVR0",15,0)
 ;
"RTN","LRVR0",16,0)
 S LRDINST=+$$KSP^XUPARAM("INST")
"RTN","LRVR0",17,0)
 S LRLEDI=1,LRCFL="",EAMODE=1,LRWRDVEW=1
"RTN","LRVR0",18,0)
 S LRX=$S(+$P($G(^LAB(69.9,1,0)),U,7):+$P(^(0),U,7),1:1)
"RTN","LRVR0",19,0)
 S LRANYAA=+$P($G(^LRO(68.2,LRLL,10,LRPROF,0)),"^",3)
"RTN","LRVR0",20,0)
 I $G(LRVBY)=1 D ACC
"RTN","LRVR0",21,0)
 I $G(LRVBY)=2 S LRUID="" D UID
"RTN","LRVR0",22,0)
 D CLEAN
"RTN","LRVR0",23,0)
 Q
"RTN","LRVR0",24,0)
 ;
"RTN","LRVR0",25,0)
 ;
"RTN","LRVR0",26,0)
UID ;UID driven look-up
"RTN","LRVR0",27,0)
 N DIR,DIRUT,DTOUT,DUOUT,X,Y
"RTN","LRVR0",28,0)
 ;
"RTN","LRVR0",29,0)
 F  D  Q:$G(LREND)
"RTN","LRVR0",30,0)
 . N LRMULTSQ
"RTN","LRVR0",31,0)
 . I $G(IOF)'="" W @IOF
"RTN","LRVR0",32,0)
 . K C5,DIC,DIR,DIRUT,DTOUT,DUOUT,LRAB,LRDEL,LRDL,LRFP,LRLDT,LRNG,LRNM,LRNOP,LRSET,LRTEST,LRVER,T,X,Y,Z
"RTN","LRVR0",33,0)
 . S X=DUZ D DUZ^LRX S LRTEC=LRUSI
"RTN","LRVR0",34,0)
 . D WLN^LRVRA I $G(LRNOP) D NEXT^LRVRA Q
"RTN","LRVR0",35,0)
 . ;
"RTN","LRVR0",36,0)
 . F  Q:$G(LRNOP)  D
"RTN","LRVR0",37,0)
 . . N LRSEQCNT
"RTN","LRVR0",38,0)
 . . D ISQN
"RTN","LRVR0",39,0)
 . . I $G(LRSEQCNT)>1 S LRMULTSQ=1
"RTN","LRVR0",40,0)
 . . I $G(LRNOP) Q
"RTN","LRVR0",41,0)
 . . D ACCSET
"RTN","LRVR0",42,0)
 . . I $G(LRNOP) Q
"RTN","LRVR0",43,0)
 . . I "SPCYEM"[LRSS D ^LRVRAP4
"RTN","LRVR0",44,0)
 . . I LRSS="MI" D PROC,ACCEPT
"RTN","LRVR0",45,0)
 . . I $G(LRNOP) Q
"RTN","LRVR0",46,0)
 . . I $G(LRSEQCNT)<2 S LRNOP=1 Q
"RTN","LRVR0",47,0)
 . . I $G(IOF)'="" W @IOF
"RTN","LRVR0",48,0)
 . . W !,PNM,?30,SSN,"  Age: ",AGE(2)
"RTN","LRVR0",49,0)
 . . W !,"ORDER #: ",LRCEN,"    ",LRACC,"    ["_LRUID,"]"
"RTN","LRVR0",50,0)
 . . W !
"RTN","LRVR0",51,0)
 . . S (ISQN,LRISQN)=0
"RTN","LRVR0",52,0)
 . ;
"RTN","LRVR0",53,0)
 . D UNLOCK,NEXT^LRVRA
"RTN","LRVR0",54,0)
 D CLEAN
"RTN","LRVR0",55,0)
 Q
"RTN","LRVR0",56,0)
 ;
"RTN","LRVR0",57,0)
 ;
"RTN","LRVR0",58,0)
ERR1 ;Look-up Error
"RTN","LRVR0",59,0)
 W !,"No data for "_LRUID_" in file"
"RTN","LRVR0",60,0)
 Q
"RTN","LRVR0",61,0)
 ;
"RTN","LRVR0",62,0)
 ;
"RTN","LRVR0",63,0)
CLEAN ;
"RTN","LRVR0",64,0)
 ;
"RTN","LRVR0",65,0)
 ; Task of background jobs for workload and HL7 message processing
"RTN","LRVR0",66,0)
 D ^LRCAPV2
"RTN","LRVR0",67,0)
 ;
"RTN","LRVR0",68,0)
 K ^TMP("LRMI",$J)
"RTN","LRVR0",69,0)
 K AGE,DFN,I,LRACC,LRCDT,DIRUT
"RTN","LRVR0",70,0)
 K LRCEN,LRDFN,LRDPF,LRNOP,LRLOCK,LRPUID,LRISQN,LRODT,LROU3,LRPROF
"RTN","LRVR0",71,0)
 K LRSN,LRSTATUS,LRTEC,LRUSI,LRVBY,PNM,SSN,X,Y
"RTN","LRVR0",72,0)
 K ZTRTN,ZTIO,ZTDTH,ZTDESC
"RTN","LRVR0",73,0)
 D ^LRVRKIL
"RTN","LRVR0",74,0)
 Q
"RTN","LRVR0",75,0)
 ;
"RTN","LRVR0",76,0)
 ;
"RTN","LRVR0",77,0)
ACC ; Accession number look-up
"RTN","LRVR0",78,0)
 D ADATE^LRWU
"RTN","LRVR0",79,0)
 I LRAD<1 S LRNOP=1 Q
"RTN","LRVR0",80,0)
 S LRAN=0
"RTN","LRVR0",81,0)
 F  D  Q:$G(LRDBUG,$G(LREND))
"RTN","LRVR0",82,0)
 . N LRMULTSQ
"RTN","LRVR0",83,0)
 . I $G(IOF)'="" W @IOF
"RTN","LRVR0",84,0)
 . K DIR,DIC,Y,LRNOP
"RTN","LRVR0",85,0)
 . S LRAN=$O(^LAH(LRLL,1,"C",LRAN)) I 'LRAN D ACCMSG Q
"RTN","LRVR0",86,0)
 . S Y=LRAN
"RTN","LRVR0",87,0)
 . S LRISQN=$O(^LAH(LRLL,1,"C",LRAN,0)) I 'LRISQN D ACCMSG Q
"RTN","LRVR0",88,0)
 . I '$O(^LAH(LRLL,1,LRISQN,0)) D ACCMSG Q
"RTN","LRVR0",89,0)
 . S DIR(0)="FO^1:10",DIR("A")="Enter Accession number part",DIR("?")="^D LW^LRVR"
"RTN","LRVR0",90,0)
 . S DIR("S")="I $O(^LAH(LRLL,1,""C"","_Y_",0)"
"RTN","LRVR0",91,0)
 . I $G(LRAN) S DIR("B")=LRAN
"RTN","LRVR0",92,0)
 . D ^DIR
"RTN","LRVR0",93,0)
 . I $D(DIRUT) D STOP^LRVR S LRNOP=1 Q
"RTN","LRVR0",94,0)
 . S LRAN=+Y I Y<1 D ACCMSG Q
"RTN","LRVR0",95,0)
 . ;
"RTN","LRVR0",96,0)
 . F  Q:$G(LRNOP)  D
"RTN","LRVR0",97,0)
 . . N LRSEQCNT
"RTN","LRVR0",98,0)
 . . D ISQN
"RTN","LRVR0",99,0)
 . . I $G(LRSEQCNT)>1 S LRMULTSQ=1
"RTN","LRVR0",100,0)
 . . I $G(LRNOP) Q
"RTN","LRVR0",101,0)
 . . D ACCSET
"RTN","LRVR0",102,0)
 . . S LRTM60=$$LRTM60^LRVR(LRCDT)
"RTN","LRVR0",103,0)
 . . I $G(LRNOP) Q
"RTN","LRVR0",104,0)
 . . I "SPCYEM"[LRSS D ^LRVRAP4
"RTN","LRVR0",105,0)
 . . I LRSS="MI" D PROC,ACCEPT
"RTN","LRVR0",106,0)
 . . I $G(LRNOP) Q
"RTN","LRVR0",107,0)
 . . I $G(LRSEQCNT)<2 S LRNOP=1 Q
"RTN","LRVR0",108,0)
 . . I $G(IOF)'="" W @IOF
"RTN","LRVR0",109,0)
 . . S (ISQN,LRISQN)=0
"RTN","LRVR0",110,0)
 . D UNLOCK
"RTN","LRVR0",111,0)
 ;
"RTN","LRVR0",112,0)
 D CLEAN
"RTN","LRVR0",113,0)
 Q
"RTN","LRVR0",114,0)
 ;
"RTN","LRVR0",115,0)
 ;
"RTN","LRVR0",116,0)
ACCMSG ;
"RTN","LRVR0",117,0)
 W !,"  No accession available for this Load/Worklist",!
"RTN","LRVR0",118,0)
 D STOP^LRVR S LRNOP=1
"RTN","LRVR0",119,0)
 Q
"RTN","LRVR0",120,0)
 ;
"RTN","LRVR0",121,0)
 ;
"RTN","LRVR0",122,0)
PROC ;Process the entry from LAH(LRLL
"RTN","LRVR0",123,0)
 Q:$$LEDIERR^LRVRMI0(LRLL,LRISQN,0,1)
"RTN","LRVR0",124,0)
 ;
"RTN","LRVR0",125,0)
 ; Set MI specific variables
"RTN","LRVR0",126,0)
 S LRBG0=^LR(LRDFN,"MI",LRIDT,0),LRSSC=$P(LRBG0,U,5)_U_$P(LRBG0,U,11),LRFIFO=1
"RTN","LRVR0",127,0)
 ;
"RTN","LRVR0",128,0)
 D EN^LRVRMI1
"RTN","LRVR0",129,0)
 Q
"RTN","LRVR0",130,0)
 ;
"RTN","LRVR0",131,0)
 ;
"RTN","LRVR0",132,0)
ACCSET ;Set up accession variables
"RTN","LRVR0",133,0)
 N DA,DIC,DIR,DIRUT,DTOUT,DUOUT,LRCNT,LRLAHD,LRI,LRNODE
"RTN","LRVR0",134,0)
 K LRERR
"RTN","LRVR0",135,0)
 S (LRLOCK,LRNOP)=0,LRLAHD=$G(^LAH(LRLL,1,LRISQN,0))
"RTN","LRVR0",136,0)
 I LRLAHD="" D  Q
"RTN","LRVR0",137,0)
 . W !,"^LAH("_LRLL_",1,"_LRISQN_",0)  Global is corrupt"
"RTN","LRVR0",138,0)
 . D ZAP S LRNOP=1
"RTN","LRVR0",139,0)
 ;
"RTN","LRVR0",140,0)
 S LRAA=$P(LRLAHD,U,3)
"RTN","LRVR0",141,0)
 I $P(^LRO(68,LRAA,0),U,2)'=LRSS  W !,"Not a "_LRSS_" Area - Abort",! S LRNOP=1 Q
"RTN","LRVR0",142,0)
 S LRAN=$P(LRLAHD,U,5),LRAD=$P(LRLAHD,U,4)
"RTN","LRVR0",143,0)
 ;
"RTN","LRVR0",144,0)
 I LRAA=""!(LRAD="")!(LRAN="") D  Q
"RTN","LRVR0",145,0)
 . W !,"^LAH("_LRLL_",1,"_LRISQN_",0)  Global is corrupt"
"RTN","LRVR0",146,0)
 . D ZAP S LRNOP=1
"RTN","LRVR0",147,0)
 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) D  Q
"RTN","LRVR0",148,0)
 . W !,"Accession does not exist in ACCESSION file (#68)"
"RTN","LRVR0",149,0)
 . D ZAP S LRNOP=1
"RTN","LRVR0",150,0)
 ;
"RTN","LRVR0",151,0)
 S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRCEN=$S($D(^(.1)):^(.1),1:0)
"RTN","LRVR0",152,0)
 S LRACC=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),LRCDT=$P($G(^(3)),U)
"RTN","LRVR0",153,0)
 S LRODT=$S($P(^(0),U,4):$P(^(0),U,4),1:$P(^(0),U,3)),LRSN=$P(^(0),U,5)
"RTN","LRVR0",154,0)
 S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),LRIDT=$P(^(3),U,5)
"RTN","LRVR0",155,0)
 S LRUID=$P(LRORU3,U),LRTS=""
"RTN","LRVR0",156,0)
 ;
"RTN","LRVR0",157,0)
 S LRI=0
"RTN","LRVR0",158,0)
 F  S LRI=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI)) Q:LRI<1!$G(LRTS)  S LRNODE=^(LRI,0) I $P(LRNODE,U,2)<50 S LRTS=+LRNODE
"RTN","LRVR0",159,0)
 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
"RTN","LRVR0",160,0)
 D PT^LRX
"RTN","LRVR0",161,0)
 ;
"RTN","LRVR0",162,0)
 ; Patient info displayed during UID lookup - display here when lookup by accession number
"RTN","LRVR0",163,0)
 I $G(LRVBY)'=2 D
"RTN","LRVR0",164,0)
 . W !,PNM,?30,SSN,"  Age: ",AGE(2)
"RTN","LRVR0",165,0)
 . W !,"ORDER #: ",LRCEN,"    ",LRACC,"    ["_LRUID,"]"
"RTN","LRVR0",166,0)
 ;
"RTN","LRVR0",167,0)
 I $$GET^XPAR("USR^DIV^PKG","LR MI VERIFY DISPLAY PROVIDER",1,"Q") D PROV^LRMIEDZ2
"RTN","LRVR0",168,0)
 ;
"RTN","LRVR0",169,0)
 S DIR(0)="E"
"RTN","LRVR0",170,0)
 D ^DIR
"RTN","LRVR0",171,0)
 I $D(DIRUT) S LRNOP=1 Q
"RTN","LRVR0",172,0)
 ;
"RTN","LRVR0",173,0)
 K LRERR
"RTN","LRVR0",174,0)
 S X=$$GETLOCK^LRUTIL("^LR(LRDFN,LRSS,LRIDT)",10,1)
"RTN","LRVR0",175,0)
 I 'X S LRERR=1 D NOLOCK Q
"RTN","LRVR0",176,0)
 S X=$$GETLOCK^LRUTIL("^LRO(68,LRAA,1,LRAD,1,LRAN)",10,1)
"RTN","LRVR0",177,0)
 I 'X S LRERR=2 D NOLOCK Q
"RTN","LRVR0",178,0)
 ;
"RTN","LRVR0",179,0)
 S LRLOCK=1
"RTN","LRVR0",180,0)
 I '$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",3) D
"RTN","LRVR0",181,0)
 . N LRAA,LRAD,LRAN
"RTN","LRVR0",182,0)
 . S LRSTATUS="C" D P15^LROE1
"RTN","LRVR0",183,0)
 . I LRCDT<1 S LRNOP=1
"RTN","LRVR0",184,0)
 ;
"RTN","LRVR0",185,0)
 I '$G(LRNOP),$P($G(^LRO(69,LRODT,1,LRSN,1)),U,4)'="C" D
"RTN","LRVR0",186,0)
 . W !,"You cannot verify an accession which has not been collected.",$C(7)
"RTN","LRVR0",187,0)
 . S LRNOP=1
"RTN","LRVR0",188,0)
 ;
"RTN","LRVR0",189,0)
 ; Determine if one or more tests on accession.
"RTN","LRVR0",190,0)
 S (LRI,LRCNT,LRPTP)=0
"RTN","LRVR0",191,0)
 F  S LRI=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI)) Q:'LRI  D
"RTN","LRVR0",192,0)
 . I $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRI,0),"^",2)<50 S LRCNT=LRCNT+1,LRPTP=LRI
"RTN","LRVR0",193,0)
 ;
"RTN","LRVR0",194,0)
 ; If more than one test on accession then select the test to work with (URGENCY<50 - non-workload tests).
"RTN","LRVR0",195,0)
 I LRCNT>1 D
"RTN","LRVR0",196,0)
 . K DA,DIC
"RTN","LRVR0",197,0)
 . S DIC="^LRO(68,LRAA,1,LRAD,1,LRAN,4,",DIC(0)="AEMOQ",DIC("A")="Select TEST/PROCEDURE: ",DIC("S")="I $P(^(0),U,2)<50"
"RTN","LRVR0",198,0)
 . S DA(2)=LRAA,DA(1)=LRAD,DA=LRAN,LRPTP=0
"RTN","LRVR0",199,0)
 . D ^DIC
"RTN","LRVR0",200,0)
 . I Y<1 S LRNOP=1 Q
"RTN","LRVR0",201,0)
 . S LRPTP=+Y
"RTN","LRVR0",202,0)
 ;
"RTN","LRVR0",203,0)
 I $G(LRNOP) Q
"RTN","LRVR0",204,0)
 ;
"RTN","LRVR0",205,0)
 S LRMIDEF=$P(^LAB(69.9,1,1),U,10),LRMIOTH=$P(^(1),U,11)
"RTN","LRVR0",206,0)
 ;
"RTN","LRVR0",207,0)
 ; Set interface type
"RTN","LRVR0",208,0)
 S LRINTYPE=$P(^LAH(LRLL,1,LRISQN,0),"^",12)
"RTN","LRVR0",209,0)
 ;
"RTN","LRVR0",210,0)
 Q
"RTN","LRVR0",211,0)
 ;
"RTN","LRVR0",212,0)
 ;
"RTN","LRVR0",213,0)
NOLOCK ; Not able to lock message
"RTN","LRVR0",214,0)
 W !!,$S($G(LRERR)=1:" **Accession** ",$G(LRERR)=2:"**Patient's ^LR( file**",1:"Record")_" is locked by another user. " H 5
"RTN","LRVR0",215,0)
 S LRNOP=1
"RTN","LRVR0",216,0)
 Q
"RTN","LRVR0",217,0)
 ;
"RTN","LRVR0",218,0)
 ;
"RTN","LRVR0",219,0)
UNLOCK ; Unlock accession and ^LR( global
"RTN","LRVR0",220,0)
 Q:'$G(LRLOCK)
"RTN","LRVR0",221,0)
 L -^LRO(68,$G(LRAA),1,$G(LRAD),1,$G(LRAN))
"RTN","LRVR0",222,0)
 L -^LR($G(LRDFN),$G(LRSS),$G(LRIDT))
"RTN","LRVR0",223,0)
 Q
"RTN","LRVR0",224,0)
 ;
"RTN","LRVR0",225,0)
 ;
"RTN","LRVR0",226,0)
ACCEPT ;Display results and accept data
"RTN","LRVR0",227,0)
 N LRBATCH,LRMODE,LRNPTP
"RTN","LRVR0",228,0)
 I $G(LREND) S LREND=0 Q
"RTN","LRVR0",229,0)
 ;
"RTN","LRVR0",230,0)
 S LRMODE="LDSI",LRBATCH=1
"RTN","LRVR0",231,0)
 D DQ^LRMIPSZ1
"RTN","LRVR0",232,0)
 ;
"RTN","LRVR0",233,0)
 D EC^LRMIEDZ4
"RTN","LRVR0",234,0)
 S LRTS=LRTS(LRI)
"RTN","LRVR0",235,0)
 ;
"RTN","LRVR0",236,0)
 K DIR
"RTN","LRVR0",237,0)
 S DIR(0)="Y",DIR("A")="Do you want to APPROVE these results",DIR("B")="NO"
"RTN","LRVR0",238,0)
 S DIR("?")="Enter Y if you want to approve these results"
"RTN","LRVR0",239,0)
 S DIR("?",1)="Entering Y will store the results in the Lab System"
"RTN","LRVR0",240,0)
 D ^DIR
"RTN","LRVR0",241,0)
 I $D(DIRUT) S LRNOP=1 Q
"RTN","LRVR0",242,0)
 I Y=0 D PURG Q
"RTN","LRVR0",243,0)
 I Y<1 S LRNOP=1 Q
"RTN","LRVR0",244,0)
 ;
"RTN","LRVR0",245,0)
 D EN^LRVRMI4
"RTN","LRVR0",246,0)
 ;
"RTN","LRVR0",247,0)
 ; Store performing lab info
"RTN","LRVR0",248,0)
 I $D(^TMP("LRPL",$J)) D ROLLUPPL^LRRPLUA(LRDFN,LRSS,LRIDT)
"RTN","LRVR0",249,0)
 ;
"RTN","LRVR0",250,0)
 ; Ask for performing laboratory assignment
"RTN","LRVR0",251,0)
 W !! D EDIT^LRRPLU(LRDFN,"MI",LRIDT)
"RTN","LRVR0",252,0)
 ;
"RTN","LRVR0",253,0)
 ; Store reporting lab
"RTN","LRVR0",254,0)
 D SETRL^LRVERA(LRDFN,LRSS,LRIDT,DUZ(2))
"RTN","LRVR0",255,0)
 ;
"RTN","LRVR0",256,0)
 ; Update clinical reminders
"RTN","LRVR0",257,0)
 D UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
"RTN","LRVR0",258,0)
 ;
"RTN","LRVR0",259,0)
 ; Ask to send CPRS alert
"RTN","LRVR0",260,0)
 D ASKXQA^LRMIEDZ2
"RTN","LRVR0",261,0)
 ;
"RTN","LRVR0",262,0)
 ; Update accession and order
"RTN","LRVR0",263,0)
 D EC3^LRMIEDZ2
"RTN","LRVR0",264,0)
 ;
"RTN","LRVR0",265,0)
 ; Queue results if LEDI and cleanup
"RTN","LRVR0",266,0)
 D LEDI,ZAP
"RTN","LRVR0",267,0)
 K ^TMP("LRMI",$J)
"RTN","LRVR0",268,0)
 ;
"RTN","LRVR0",269,0)
 Q
"RTN","LRVR0",270,0)
 ;
"RTN","LRVR0",271,0)
 ;
"RTN","LRVR0",272,0)
PURG ; Ask if the entry should be purged from ^LAH(
"RTN","LRVR0",273,0)
 W !
"RTN","LRVR0",274,0)
 N DIR
"RTN","LRVR0",275,0)
 S DIR(0)="Y",DIR("A")="Do you want to PURGE these results",DIR("B")="NO"
"RTN","LRVR0",276,0)
 S DIR("?",1)="Enter NO if you want to process these results at a later time"
"RTN","LRVR0",277,0)
 S DIR("?")="Enter YES to remove these results from the list"
"RTN","LRVR0",278,0)
 D ^DIR
"RTN","LRVR0",279,0)
 I $D(DIRUT) S LRNOP=1 Q
"RTN","LRVR0",280,0)
 I Y=1 D ZAP
"RTN","LRVR0",281,0)
 Q
"RTN","LRVR0",282,0)
 ;
"RTN","LRVR0",283,0)
 ;
"RTN","LRVR0",284,0)
ZAP ; Remove entry from ^LAH( global
"RTN","LRVR0",285,0)
 N REC
"RTN","LRVR0",286,0)
 S REC=$S($G(ISQN):ISQN,1:$G(LRISQN))
"RTN","LRVR0",287,0)
 I LRLL,REC D ZAPALL^LRVR3(LRLL,REC)
"RTN","LRVR0",288,0)
 Q
"RTN","LRVR0",289,0)
 ;
"RTN","LRVR0",290,0)
 ;
"RTN","LRVR0",291,0)
SETACC ;
"RTN","LRVR0",292,0)
 N LRFILE,LRIENS,LRFDA,LRERR
"RTN","LRVR0",293,0)
 S LRFILE=68.04,LRERR=""
"RTN","LRVR0",294,0)
 S LRIENS=LRTS_","_LRAN_","_LRAD_","_LRAA_","
"RTN","LRVR0",295,0)
 S LRFDA(1,LRFILE,LRIENS,3)=DUZ
"RTN","LRVR0",296,0)
 S LRFDA(1,LRFILE,LRIENS,4)=$$NOW^XLFDT
"RTN","LRVR0",297,0)
 S LRFDA(1,LRFILE,LRIENS,8)=$G(LRCDEF)
"RTN","LRVR0",298,0)
 D FILE^DIE("KS","LRFDA(1)","LRERR")
"RTN","LRVR0",299,0)
 Q
"RTN","LRVR0",300,0)
 ;
"RTN","LRVR0",301,0)
 ;
"RTN","LRVR0",302,0)
LEDI ; If LEDI put results in queue to return to collecting lab
"RTN","LRVR0",303,0)
 ; Called from above, LRMIEDZ2, LRMISTF1 and LRVRAP4.
"RTN","LRVR0",304,0)
 N IEN,LRCDEFX,LRERR,LRIDT,LRORDT,LRORU3,LRSS,LRTSDEF
"RTN","LRVR0",305,0)
 Q:'$D(^LRO(68,+$G(LRAA),1,+$G(LRAD),1,+$G(LRAN),0))
"RTN","LRVR0",306,0)
 ;
"RTN","LRVR0",307,0)
 S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
"RTN","LRVR0",308,0)
 Q:'$P(LRORU3,U,3)
"RTN","LRVR0",309,0)
 ;
"RTN","LRVR0",310,0)
 S LRODT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4)
"RTN","LRVR0",311,0)
 S LRSS=$P(^LRO(68,LRAA,0),U,2)
"RTN","LRVR0",312,0)
 S LRIDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,5)
"RTN","LRVR0",313,0)
 I '$$OK2SEND^LA7SRR D LEDINO Q
"RTN","LRVR0",314,0)
 ;
"RTN","LRVR0",315,0)
 I '$G(LRCDEF) N LRCDEF I "SPEMCY"[LRSS S LRCDEF=3241,LRCDEFX=1
"RTN","LRVR0",316,0)
 I '$G(LRTS) N LRTS D
"RTN","LRVR0",317,0)
 . S IEN=0
"RTN","LRVR0",318,0)
 . F  S IEN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,IEN)) Q:IEN<1  D  Q:$G(LRTS)
"RTN","LRVR0",319,0)
 . . I $P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,IEN,0)),U,2)<50 S LRTS=IEN,LRTSDEF=1
"RTN","LRVR0",320,0)
 I $G(LRTS) D SETACC
"RTN","LRVR0",321,0)
 ;
"RTN","LRVR0",322,0)
 ; Comment out the following line after testing is complete
"RTN","LRVR0",323,0)
 W !!,$$CJ^XLFSTR("Sending report to LEDI collecting site",IOM)
"RTN","LRVR0",324,0)
 D MIAP^LA7VMSG(LRAA,LRAD,LRAN,+$G(LRTS),LRDFN,LRSS,LRIDT,LRODT)
"RTN","LRVR0",325,0)
 Q
"RTN","LRVR0",326,0)
 ;
"RTN","LRVR0",327,0)
 ;
"RTN","LRVR0",328,0)
LEDINO ; LEDI HL7 message sending error message
"RTN","LRVR0",329,0)
 W !!,$$CJ^XLFSTR("Unable to sent report to LEDI collecting site - no date report approved",IOM)
"RTN","LRVR0",330,0)
 Q
"RTN","LRVR0",331,0)
 ;
"RTN","LRVR0",332,0)
 ;
"RTN","LRVR0",333,0)
ISQN ; Find the entry associated with this accession area and accession number
"RTN","LRVR0",334,0)
 N LRI,LRSQ
"RTN","LRVR0",335,0)
 S (LRI,LRSEQCNT)=0
"RTN","LRVR0",336,0)
 F  S LRI=$O(^LAH(LRLL,1,"C",LRAN,LRI)) Q:LRI<1  D
"RTN","LRVR0",337,0)
 . N LRX
"RTN","LRVR0",338,0)
 . S LRX=$G(^LAH(LRLL,1,LRI,0))
"RTN","LRVR0",339,0)
 . ; Quit if different accession area.
"RTN","LRVR0",340,0)
 . I $P(LRX,"^",3),$P(LRX,"^",3)'=LRAA Q
"RTN","LRVR0",341,0)
 . ; Quit if different accession date and not a rollover accession (same original accession date).
"RTN","LRVR0",342,0)
 . I $P(LRX,"^",4),$P(LRX,"^",4)'=LRAD,$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",3)'=$P($G(^LRO(68,LRAA,1,$P(LRX,"^",4),1,LRAN,0)),"^",3) Q
"RTN","LRVR0",343,0)
 . I LRSEQCNT W !
"RTN","LRVR0",344,0)
 . S LRSEQCNT=LRSEQCNT+1,LRSQ=LRI,LRSQ(LRI)=""
"RTN","LRVR0",345,0)
 . W !,?2,"Seq #: ",LRI,?13," Accession: ",$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2)),"^")
"RTN","LRVR0",346,0)
 . I $P(LRX,"^",10) W ?40," Results received: ",$$FMTE^XLFDT($P(LRX,"^",10),"1M")
"RTN","LRVR0",347,0)
 . W !,?20,"UID: ",$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3),"UNKNOWN"),"^")
"RTN","LRVR0",348,0)
 . I $P(LRX,"^",11) W ?44," Last updated: ",$$FMTE^XLFDT($P(LRX,"^",11),"1M")
"RTN","LRVR0",349,0)
 . I $G(^LAH(LRLL,1,LRI,.1,"OBR","ORDNLT"))'="" D
"RTN","LRVR0",350,0)
 . . N LR64,LRNLT,LRNLTN,LRPIECE
"RTN","LRVR0",351,0)
 . . W !,?13," Order NLT: "
"RTN","LRVR0",352,0)
 . . F LRPIECE=1:1 S LRNLT=$P($G(^LAH(LRLL,1,LRI,.1,"OBR","ORDNLT")),"^",LRPIECE) Q:LRNLT=""  D
"RTN","LRVR0",353,0)
 . . . S LR64=+$O(^LAM("E",LRNLT,0))
"RTN","LRVR0",354,0)
 . . . S LRNLTN=$$GET1^DIQ(64,LR64_",",.01)
"RTN","LRVR0",355,0)
 . . . W ?25,$S(LRNLTN'="":LRNLTN,1:LRNLT),!
"RTN","LRVR0",356,0)
 ;
"RTN","LRVR0",357,0)
 I LRSEQCNT=0 W !,"No data for that accession" S LRNOP=1 Q
"RTN","LRVR0",358,0)
 I LRSEQCNT=1,'$G(LRMULTSQ) S (ISQN,LRISQN)=LRSQ Q
"RTN","LRVR0",359,0)
 ;
"RTN","LRVR0",360,0)
 ; If multiple entries (sequence - overlay data=no) then ask user which one to use.
"RTN","LRVR0",361,0)
 N DIR,DIRUT,DIROUT,DTOUT,DUOUT
"RTN","LRVR0",362,0)
 S DIR(0)=""
"RTN","LRVR0",363,0)
 S I=0 F  S I=$O(LRSQ(I)) Q:'I  S DIR(0)=DIR(0)_$S(I=1:"",1:";")_I_":Seq #"_I
"RTN","LRVR0",364,0)
 S DIR(0)="SO^"_DIR(0),DIR("A")="Choose sequence number"
"RTN","LRVR0",365,0)
 I LRSEQCNT=1,$G(LRMULTSQ) S DIR("B")=LRSQ
"RTN","LRVR0",366,0)
 D ^DIR
"RTN","LRVR0",367,0)
 I $D(DIRUT)!(Y<1) S LRNOP=1 Q
"RTN","LRVR0",368,0)
 S (ISQN,LRISQN)=+Y Q
"RTN","LRVR0",369,0)
 Q
"RTN","LRVRAP4")
0^18^B35152791
"RTN","LRVRAP4",1,0)
LRVRAP4 ;DALOI/STAFF - LAB AP INTERFACE ;06/19/13  11:48
"RTN","LRVRAP4",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRVRAP4",3,0)
 ;
"RTN","LRVRAP4",4,0)
 ; Extracts the results information in the ^LAH(LWL,1,ISQN... global and stores it in the Lab Data AP subfile.
"RTN","LRVRAP4",5,0)
 ;
"RTN","LRVRAP4",6,0)
DISPLAY ; Display AP results
"RTN","LRVRAP4",7,0)
 ;
"RTN","LRVRAP4",8,0)
 I LRSS'?1(1"SP",1"CY",1"EM") W !,"Abort- Not an AP accession" Q
"RTN","LRVRAP4",9,0)
 S %ZIS="MQ" D ^%ZIS
"RTN","LRVRAP4",10,0)
 I POP D HOME^%ZIS Q
"RTN","LRVRAP4",11,0)
 I $D(IO("Q")) D  Q
"RTN","LRVRAP4",12,0)
 . S ZTRTN="DQ^LRVRAP4",ZTDESC="PRINT LEDI AP RESULTS",ZTSAVE("LR*")=""
"RTN","LRVRAP4",13,0)
 . D ^%ZTLOAD,HOME^%ZIS K IO("Q")
"RTN","LRVRAP4",14,0)
 ;
"RTN","LRVRAP4",15,0)
 ;
"RTN","LRVRAP4",16,0)
DQ ;
"RTN","LRVRAP4",17,0)
 U IO
"RTN","LRVRAP4",18,0)
 N LRLINE,LRI,LRPAGE
"RTN","LRVRAP4",19,0)
 S LRPAGE=1,LREND=0,$P(LRLINE,"-",IOM)=""
"RTN","LRVRAP4",20,0)
 W @IOF
"RTN","LRVRAP4",21,0)
 I $D(LRDFN) D PT^LRX
"RTN","LRVRAP4",22,0)
 D HDG,DATA
"RTN","LRVRAP4",23,0)
 I $D(ZTQUEUED) S ZTREQ="@" Q
"RTN","LRVRAP4",24,0)
 D ACCEPT
"RTN","LRVRAP4",25,0)
 ;
"RTN","LRVRAP4",26,0)
EXIT ;
"RTN","LRVRAP4",27,0)
 Q
"RTN","LRVRAP4",28,0)
 ;
"RTN","LRVRAP4",29,0)
 ;
"RTN","LRVRAP4",30,0)
HDG ;
"RTN","LRVRAP4",31,0)
 ;
"RTN","LRVRAP4",32,0)
 W !,"Accession #: ",$G(LRACC)," UID: ",$G(LRUID)
"RTN","LRVRAP4",33,0)
 W !,"Name: ",$G(PNM)," SSN: ",$G(SSN)," DOB: ",$$FMTE^XLFDT($G(DOB),"1M")," Age: ",$G(AGE(2))
"RTN","LRVRAP4",34,0)
 W ?(IOM-10),"PAGE: ",LRPAGE
"RTN","LRVRAP4",35,0)
 W !,"Collection Date: ",$$FMTE^XLFDT($G(LRCDT))
"RTN","LRVRAP4",36,0)
 S LRPAGE=LRPAGE+1
"RTN","LRVRAP4",37,0)
 W !,LRLINE
"RTN","LRVRAP4",38,0)
 Q
"RTN","LRVRAP4",39,0)
 ;
"RTN","LRVRAP4",40,0)
 ;
"RTN","LRVRAP4",41,0)
DATA ;
"RTN","LRVRAP4",42,0)
 N FLDNM,LINE,LRI
"RTN","LRVRAP4",43,0)
 F LRI=99,.2,.3,.4,.5,1,1.1,1.2,1.3,1.4 I $D(^LAH(LRLL,1,LRISQN,LRSS,LRI))&('LREND) D
"RTN","LRVRAP4",44,0)
 . S FLDNM=$S(LRI=.2:"Brief Clinical History",LRI=.3:"Preoperative Diagnosis",LRI=.4:"Operative Findings",LRI=.5:"Postoperative Findings",LRI=99:"Report",1:0)
"RTN","LRVRAP4",45,0)
 . I FLDNM=0 S FLDNM=$S(LRI=1:"Gross Description",LRI=1.1:"Microscopic Description",LRI=1.2:"Supplementary Report",LRI=1.3:"Frozen Section",1:0)
"RTN","LRVRAP4",46,0)
 . I LRI=1.4 S FLDNM=$S(LRSS="EM":"EM",LRSS="SP":"Surgical Pathology",LRSS="CY":"Cytopathology",1:0)_"Diagnosis"
"RTN","LRVRAP4",47,0)
 . W !,LRLINE,!,FLDNM
"RTN","LRVRAP4",48,0)
 . K ^UTILITY($J)
"RTN","LRVRAP4",49,0)
 . S DIWR=IOM-5,DIWL=5,DIWF="W"
"RTN","LRVRAP4",50,0)
 . S:LRI=99 DIWR=IOM,DIWL=0
"RTN","LRVRAP4",51,0)
 . I LRI=1.2 D PRTSR Q
"RTN","LRVRAP4",52,0)
 . S LINE=0
"RTN","LRVRAP4",53,0)
 . F  S LINE=$O(^LAH(LRLL,1,LRISQN,LRSS,LRI,LINE)) Q:'LINE!LREND  D
"RTN","LRVRAP4",54,0)
 . . S X=^LAH(LRLL,1,LRISQN,LRSS,LRI,LINE,0) D ^DIWP
"RTN","LRVRAP4",55,0)
 . . D ^DIWW
"RTN","LRVRAP4",56,0)
 . . D PAUSE Q:LREND
"RTN","LRVRAP4",57,0)
 ;
"RTN","LRVRAP4",58,0)
 Q
"RTN","LRVRAP4",59,0)
 ;
"RTN","LRVRAP4",60,0)
 ;
"RTN","LRVRAP4",61,0)
PRTSR ; Print Supplemental Report
"RTN","LRVRAP4",62,0)
 N LINE,LRISQN2
"RTN","LRVRAP4",63,0)
 S LRISQN2=0
"RTN","LRVRAP4",64,0)
 F  S LRISQN2=$O(^LAH(LRLL,1,LRISQN,LRSS,LRI,LRISQN2)) Q:'LRISQN2!LREND  D
"RTN","LRVRAP4",65,0)
 .  S LINE=0
"RTN","LRVRAP4",66,0)
 . F  S LINE=$O(^LAH(LRLL,1,LRISQN,LRSS,LRI,LRISQN2,1,LINE)) Q:'LINE!LREND  D
"RTN","LRVRAP4",67,0)
 . . S X=^LAH(LRLL,1,LRISQN,LRSS,LRI,LRISQN2,1,LINE,0) D ^DIWP
"RTN","LRVRAP4",68,0)
 . . D ^DIWW
"RTN","LRVRAP4",69,0)
 . . D PAUSE Q:LREND
"RTN","LRVRAP4",70,0)
 Q
"RTN","LRVRAP4",71,0)
 ;
"RTN","LRVRAP4",72,0)
 ;
"RTN","LRVRAP4",73,0)
ACCEPT ; Ask if want to accept results
"RTN","LRVRAP4",74,0)
 N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
"RTN","LRVRAP4",75,0)
 S DIR(0)="Y",DIR("A")="Do you want to ACCEPT these results",DIR("B")="NO"
"RTN","LRVRAP4",76,0)
 S DIR("?")="Enter Y if you want to accept these results"
"RTN","LRVRAP4",77,0)
 S DIR("?",1)="Entering Y will store the results for this accession"
"RTN","LRVRAP4",78,0)
 D ^DIR
"RTN","LRVRAP4",79,0)
 I $D(DIRUT) S LRNOP=1 Q
"RTN","LRVRAP4",80,0)
 I 'Y D PURG Q
"RTN","LRVRAP4",81,0)
 ;
"RTN","LRVRAP4",82,0)
STORE ;
"RTN","LRVRAP4",83,0)
 ; First, some setup stuff
"RTN","LRVRAP4",84,0)
 ;
"RTN","LRVRAP4",85,0)
 N FIELD,FILE,DIC,LRA,LRI,LRSF,LRP,LRAC
"RTN","LRVRAP4",86,0)
 ;
"RTN","LRVRAP4",87,0)
 S DIC(0)="LXZ"
"RTN","LRVRAP4",88,0)
 ; Begin actual processing of the data
"RTN","LRVRAP4",89,0)
 ;
"RTN","LRVRAP4",90,0)
 I LRSS="EM" S FILE=63.02
"RTN","LRVRAP4",91,0)
 I LRSS="CY" S FILE=63.09
"RTN","LRVRAP4",92,0)
 I LRSS="SP" S FILE=63.08
"RTN","LRVRAP4",93,0)
 ;
"RTN","LRVRAP4",94,0)
 ; Set DATE REPORT COMPLETED(.03), REPORT RELEASE DATE/TIME (.11) and RELEASED BY (.13) fields
"RTN","LRVRAP4",95,0)
 N FDA,FLDS,IEN,LRDATE,LRERR
"RTN","LRVRAP4",96,0)
 S LRI=LRIDT,LRDATE=$$NOW^XLFDT,IEN=LRIDT_","_LRDFN_","
"RTN","LRVRAP4",97,0)
 S FDA(1,FILE,IEN,.03)=LRDATE
"RTN","LRVRAP4",98,0)
 S FDA(1,FILE,IEN,.11)=LRDATE
"RTN","LRVRAP4",99,0)
 S FDA(1,FILE,IEN,.13)=DUZ
"RTN","LRVRAP4",100,0)
 D FILE^DIE("","FDA(1)","LRERR")
"RTN","LRVRAP4",101,0)
 ;
"RTN","LRVRAP4",102,0)
 F LRI=99,.2,.3,.4,.5,1,1.1,1.2,1.3,1.4 I $D(^LAH(LRLL,1,LRISQN,LRSS,LRI)) D
"RTN","LRVRAP4",103,0)
 . S FIELD=$S(LRI=99:99,LRI=.2:.013,LRI=.3:.014,LRI=.4:.015,LRI=.5:.016,LRI=1:1,LRI=1.1:1.1,LRI=1.2:1.2,LRI=1.3:1.3,LRI=1.4:1.4,1:0)
"RTN","LRVRAP4",104,0)
 . I LRI=99 D COMMENT Q
"RTN","LRVRAP4",105,0)
 . I LRI=1.2 D SRPT Q  ; SUPPLEMENTARY REPORT
"RTN","LRVRAP4",106,0)
 . D WP^DIE(FILE,LRIDT_","_LRDFN_",",FIELD,"K","^LAH(LRLL,1,LRISQN,LRSS,LRI)","LRERR") ; WORD-PROCESSING FIELDS
"RTN","LRVRAP4",107,0)
 ;
"RTN","LRVRAP4",108,0)
 ; Store performing lab info
"RTN","LRVRAP4",109,0)
 I $D(^TMP("LRPL",$J)) D ROLLUPPL^LRRPLUA(LRDFN,LRSS,LRIDT)
"RTN","LRVRAP4",110,0)
 ;
"RTN","LRVRAP4",111,0)
 ; Ask for performing laboratory assignment
"RTN","LRVRAP4",112,0)
 W !! D EDIT^LRRPLU(LRDFN,LRSS,LRIDT)
"RTN","LRVRAP4",113,0)
 ;
"RTN","LRVRAP4",114,0)
 ; Store reporting lab
"RTN","LRVRAP4",115,0)
 D SETRL^LRVERA(LRDFN,LRSS,LRIDT,DUZ(2))
"RTN","LRVRAP4",116,0)
 S LRI=LRIDT,LRSF=FILE,LRP=PNM,LRAC=LRACC
"RTN","LRVRAP4",117,0)
 S LRA=^LR(LRDFN,LRSS,LRIDT,0)
"RTN","LRVRAP4",118,0)
 D ACCCOMP^LRAPRES
"RTN","LRVRAP4",119,0)
 D MAIN^LRAPRES1(LRDFN,LRSS,LRI,LRSF,LRP,LRAC)
"RTN","LRVRAP4",120,0)
 ;
"RTN","LRVRAP4",121,0)
 ; Update clinical reminders
"RTN","LRVRAP4",122,0)
 D UPDATE^LRPXRM(LRDFN,LRSS,LRIDT)
"RTN","LRVRAP4",123,0)
 ;
"RTN","LRVRAP4",124,0)
 ; Queue results if LEDI and cleanup
"RTN","LRVRAP4",125,0)
 D LEDI^LRVR0,ZAP^LRVR0
"RTN","LRVRAP4",126,0)
 ;
"RTN","LRVRAP4",127,0)
 ;K ENTRY,I,SECTION,FDA,FILE,DIC,Y,BUG,IEN,M,F
"RTN","LRVRAP4",128,0)
 Q
"RTN","LRVRAP4",129,0)
 ;
"RTN","LRVRAP4",130,0)
 ;
"RTN","LRVRAP4",131,0)
COMMENT ;
"RTN","LRVRAP4",132,0)
 N CFILE,LRISQN2
"RTN","LRVRAP4",133,0)
 S LRISQN2=0
"RTN","LRVRAP4",134,0)
 I LRSS="SP" S CFILE=63.98
"RTN","LRVRAP4",135,0)
 I LRSS="CY" S CFILE=63.908
"RTN","LRVRAP4",136,0)
 I LRSS="EM" S CFILE=63.208
"RTN","LRVRAP4",137,0)
 F  S LRISQN2=$O(^LAH(LRLL,1,LRISQN,LRSS,LRI,LRISQN2)) Q:'LRISQN2  S LRLINE=^LAH(LRLL,1,LRISQN,LRSS,LRI,LRISQN2,0) D
"RTN","LRVRAP4",138,0)
 . K FDA,IEN,LRERR
"RTN","LRVRAP4",139,0)
 . S IEN="?+1,"_LRIDT_","_LRDFN_","
"RTN","LRVRAP4",140,0)
 . S FDA(2,CFILE,IEN,.01)=LRLINE
"RTN","LRVRAP4",141,0)
 . D UPDATE^DIE("","FDA(2)","IEN","LRERR")
"RTN","LRVRAP4",142,0)
 Q
"RTN","LRVRAP4",143,0)
 ;
"RTN","LRVRAP4",144,0)
 ;
"RTN","LRVRAP4",145,0)
SRPT ; SUPPLEMENTARY REPORT
"RTN","LRVRAP4",146,0)
 N SRFILE,LRISQN2
"RTN","LRVRAP4",147,0)
 S LRISQN2=0
"RTN","LRVRAP4",148,0)
 I LRSS="SP" S SRFILE=63.817,FIELD=1
"RTN","LRVRAP4",149,0)
 I LRSS="CY" S SRFILE=63.907,FIELD=1
"RTN","LRVRAP4",150,0)
 I LRSS="EM" S SRFILE=63.207,FIELD=1
"RTN","LRVRAP4",151,0)
 F  S LRISQN2=$O(^LAH(LRLL,1,LRISQN,LRSS,LRI,LRISQN2)) Q:'LRISQN2  D
"RTN","LRVRAP4",152,0)
 . K FDA,IEN,LRERR,LRERR2
"RTN","LRVRAP4",153,0)
 . S IEN="?+1,"_LRIDT_","_LRDFN_","
"RTN","LRVRAP4",154,0)
 . S FDA(1,SRFILE,IEN,.01)=$$NOW^XLFDT
"RTN","LRVRAP4",155,0)
 . S FDA(1,SRFILE,IEN,.02)=1
"RTN","LRVRAP4",156,0)
 . D UPDATE^DIE("","FDA(1)","IEN","LRERR2")
"RTN","LRVRAP4",157,0)
 . I $G(IEN(1)) D WP^DIE(SRFILE,IEN(1)_","_LRIDT_","_LRDFN_",",FIELD,"K","^LAH(LRLL,1,LRISQN,LRSS,LRI,LRISQN2,1)","LRERR")
"RTN","LRVRAP4",158,0)
 Q
"RTN","LRVRAP4",159,0)
 ;
"RTN","LRVRAP4",160,0)
 ;
"RTN","LRVRAP4",161,0)
PURG ; Ask if the entry should be purged from ^LAH(
"RTN","LRVRAP4",162,0)
 W !
"RTN","LRVRAP4",163,0)
 N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
"RTN","LRVRAP4",164,0)
 S DIR(0)="Y",DIR("A")="Do you want to purge this entry from ^LAH Global"
"RTN","LRVRAP4",165,0)
 S DIR("?")="Remove the entry from the list",DIR("B")="No"
"RTN","LRVRAP4",166,0)
 D ^DIR
"RTN","LRVRAP4",167,0)
 I $D(DIRUT) S LRNOP=1 Q
"RTN","LRVRAP4",168,0)
 I $G(Y)=1 D ZAP^LRVR0
"RTN","LRVRAP4",169,0)
 Q
"RTN","LRVRAP4",170,0)
 ;
"RTN","LRVRAP4",171,0)
 ;
"RTN","LRVRAP4",172,0)
PAUSE ; Check for end of page
"RTN","LRVRAP4",173,0)
 I $Y>(IOSL-6)&($E(IOST,1,2)="C-") D  Q:$G(LREND)
"RTN","LRVRAP4",174,0)
 . N DIR,DIRUT,DIROUT,DTOUT,DUOUT,X,Y
"RTN","LRVRAP4",175,0)
 . S DIR(0)="E"
"RTN","LRVRAP4",176,0)
 . D ^DIR S:'Y LREND=1
"RTN","LRVRAP4",177,0)
 I $Y>(IOSL-6) S $Y=0 W @IOF D HDG Q
"RTN","LRVRAP4",178,0)
 Q
"RTN","LRVRMI1A")
0^44^B12793155
"RTN","LRVRMI1A",1,0)
LRVRMI1A ;DALOI/STAFF - LAB MICRO HL7 INTERFACE ;08/16/13  17:53
"RTN","LRVRMI1A",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRVRMI1A",3,0)
 ;
"RTN","LRVRMI1A",4,0)
 Q
"RTN","LRVRMI1A",5,0)
 ;
"RTN","LRVRMI1A",6,0)
SRCHEN2 ;
"RTN","LRVRMI1A",7,0)
 ; Continued from SRCHEN^LRVRMI1
"RTN","LRVRMI1A",8,0)
 N IEN,IEN2,LRND,LRNDINFO
"RTN","LRVRMI1A",9,0)
 ;
"RTN","LRVRMI1A",10,0)
 ; virus
"RTN","LRVRMI1A",11,0)
 I $D(^LAH(LWL,1,ISQN,"MI",16)) D
"RTN","LRVRMI1A",12,0)
 . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,16)=^LAH(LWL,1,ISQN,"MI",16)
"RTN","LRVRMI1A",13,0)
 ;
"RTN","LRVRMI1A",14,0)
 I $D(^LAH(LWL,1,ISQN,"MI",17)) D
"RTN","LRVRMI1A",15,0)
 . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17)=^LAH(LWL,1,ISQN,"MI",17)
"RTN","LRVRMI1A",16,0)
 . S IEN=0
"RTN","LRVRMI1A",17,0)
 . F  S IEN=$O(^LAH(LWL,1,ISQN,"MI",17,IEN)) Q:'IEN  D
"RTN","LRVRMI1A",18,0)
 . . S LRX=$G(^LAH(LWL,1,ISQN,"MI",17,IEN,0,.01,0))
"RTN","LRVRMI1A",19,0)
 . . I $P(LRX,"^")'="" D BLDSTAT(34,$P(LRX,"^"))
"RTN","LRVRMI1A",20,0)
 . D USERDT(16,$G(LRSTATUS(63.05,34)))
"RTN","LRVRMI1A",21,0)
 ;
"RTN","LRVRMI1A",22,0)
 ; virus remark
"RTN","LRVRMI1A",23,0)
 I $D(^LAH(LWL,1,ISQN,"MI",18)) D
"RTN","LRVRMI1A",24,0)
 . N STAT
"RTN","LRVRMI1A",25,0)
 . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18)=^LAH(LWL,1,ISQN,"MI",18)
"RTN","LRVRMI1A",26,0)
 . S STAT=$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,0),U,4)
"RTN","LRVRMI1A",27,0)
 . D BLDSTAT(34,STAT),USERDT(16,$G(LRSTATUS(63.05,34)))
"RTN","LRVRMI1A",28,0)
 ;
"RTN","LRVRMI1A",29,0)
 ;
"RTN","LRVRMI1A",30,0)
 ; Process similar multiples - nodes 15,19-31
"RTN","LRVRMI1A",31,0)
 ;
"RTN","LRVRMI1A",32,0)
 ; LRNDINFO(NODE)= Status Node ^ Status field
"RTN","LRVRMI1A",33,0)
 S LRNDINFO(15)="8^19" ; mycology prep/smear
"RTN","LRVRMI1A",34,0)
 S LRNDINFO(19)="1^11.5" ; preliminary bacteria comment
"RTN","LRVRMI1A",35,0)
 S LRNDINFO(20)="16^34" ; preliminary virus comment
"RTN","LRVRMI1A",36,0)
 S LRNDINFO(21)="5^15" ; preliminary parasite comment
"RTN","LRVRMI1A",37,0)
 S LRNDINFO(22)="8^19" ; preliminary mycology comment
"RTN","LRVRMI1A",38,0)
 S LRNDINFO(23)="11^23" ; preliminary TB comment
"RTN","LRVRMI1A",39,0)
 S LRNDINFO(24)="5^15" ; parasite prep/smear
"RTN","LRVRMI1A",40,0)
 S LRNDINFO(25)="1^11.5" ; bacteriology prep/smear
"RTN","LRVRMI1A",41,0)
 S LRNDINFO(26)="1^11.5" ; bacteria tests
"RTN","LRVRMI1A",42,0)
 S LRNDINFO(27)="5^15" ; parasitology tests
"RTN","LRVRMI1A",43,0)
 S LRNDINFO(28)="8^19" ; mycology tests
"RTN","LRVRMI1A",44,0)
 S LRNDINFO(29)="11^23" ; TB tests
"RTN","LRVRMI1A",45,0)
 S LRNDINFO(30)="16^34" ; virology tests
"RTN","LRVRMI1A",46,0)
 S LRNDINFO(31)="1^11.5" ; sterility tests
"RTN","LRVRMI1A",47,0)
 ;
"RTN","LRVRMI1A",48,0)
 F LRND=15,19:1:31 D
"RTN","LRVRMI1A",49,0)
 . I $D(^LAH(LWL,1,ISQN,"MI",LRND)) D
"RTN","LRVRMI1A",50,0)
 . . N LRIEN,LRSTAT,LRSTATND,LRSTATFLD
"RTN","LRVRMI1A",51,0)
 . . M ^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRND)=^LAH(LWL,1,ISQN,"MI",LRND)
"RTN","LRVRMI1A",52,0)
 . . S LRSTAT=$P($G(^LAH(LWL,1,ISQN,"MI",LRND,0)),U,4)
"RTN","LRVRMI1A",53,0)
 . . S LRSTATND=$P($G(LRNDINFO(LRND)),U,1)
"RTN","LRVRMI1A",54,0)
 . . S LRSTATFLD=$P($G(LRNDINFO(LRND)),U,2)
"RTN","LRVRMI1A",55,0)
 . . D BLDSTAT(LRSTATFLD,LRSTAT),USERDT(LRSTATND,$G(LRSTATUS(63.05,LRSTATFLD)))
"RTN","LRVRMI1A",56,0)
 . . ;
"RTN","LRVRMI1A",57,0)
 . . S LRIEN=0
"RTN","LRVRMI1A",58,0)
 . . F  S LRIEN=$O(^LAH(LWL,1,ISQN,"MI",LRND,LRIEN)) Q:LRIEN<1  D
"RTN","LRVRMI1A",59,0)
 . . . I $D(^LAH(LWL,1,ISQN,"MI",LRND,LRIEN,0,0)) D
"RTN","LRVRMI1A",60,0)
 . . . . S LRSTAT=$P($G(^LAH(LWL,1,ISQN,"MI",LRND,LRIEN,0,0)),U,4)
"RTN","LRVRMI1A",61,0)
 . . . . S LRSTATND=$P($G(LRNDINFO(LRND)),U,1)
"RTN","LRVRMI1A",62,0)
 . . . . S LRSTATFLD=$P($G(LRNDINFO(LRND)),U,2)
"RTN","LRVRMI1A",63,0)
 . . . . D BLDSTAT(LRSTATFLD,LRSTAT),USERDT(LRSTATND,$G(LRSTATUS(63.05,LRSTATFLD)))
"RTN","LRVRMI1A",64,0)
 ;
"RTN","LRVRMI1A",65,0)
 ;
"RTN","LRVRMI1A",66,0)
 Q
"RTN","LRVRMI1A",67,0)
 ;
"RTN","LRVRMI1A",68,0)
 ;
"RTN","LRVRMI1A",69,0)
BLDSTAT(FLD,VAL) ;
"RTN","LRVRMI1A",70,0)
 ; Convenience method
"RTN","LRVRMI1A",71,0)
 D BLDSTAT^LRVRMI4A(63.05,FLD,VAL,.LRSTATUS)
"RTN","LRVRMI1A",72,0)
 Q
"RTN","LRVRMI1A",73,0)
 ;
"RTN","LRVRMI1A",74,0)
 ;
"RTN","LRVRMI1A",75,0)
USERDT(LRNODE,LRSTAT) ; Set user and date/time in respective MI section
"RTN","LRVRMI1A",76,0)
 ; Call with LRNODE = MI node to set
"RTN","LRVRMI1A",77,0)
 ;           LRSTAT = status to set (optional)
"RTN","LRVRMI1A",78,0)
 ;
"RTN","LRVRMI1A",79,0)
 I '$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE)) S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE),U)=LRNOW
"RTN","LRVRMI1A",80,0)
 ;
"RTN","LRVRMI1A",81,0)
 ; Update status, don't change an existing "P" to a "F"
"RTN","LRVRMI1A",82,0)
 I $G(LRSTAT)'="" D
"RTN","LRVRMI1A",83,0)
 . I LRSTAT="F",$P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE),"^",2)="P" Q
"RTN","LRVRMI1A",84,0)
 . S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE),"^",2)=LRSTAT
"RTN","LRVRMI1A",85,0)
 ;
"RTN","LRVRMI1A",86,0)
 ; AFB (node=11) stores user in 5th piece instead of usual 3rd piece for other nodes.
"RTN","LRVRMI1A",87,0)
 I LRNODE'=11 S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE),U,3)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI1A",88,0)
 E  S $P(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE),U,5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI1A",89,0)
 ;
"RTN","LRVRMI1A",90,0)
 Q
"RTN","LRVRMI2")
0^10^B35719383
"RTN","LRVRMI2",1,0)
LRVRMI2 ;DALOI/STAFF - LAH/TMP TO FILE #63 ;11/27/12  18:19
"RTN","LRVRMI2",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRVRMI2",3,0)
 ;
"RTN","LRVRMI2",4,0)
 ; Continuation of LRVRMI4 and is used for extracting results from the LAH global and storing it into LAB DATA FILE (#63).
"RTN","LRVRMI2",5,0)
 ;
"RTN","LRVRMI2",6,0)
 Q
"RTN","LRVRMI2",7,0)
 ;
"RTN","LRVRMI2",8,0)
N7 ; Process Parasite Remarks
"RTN","LRVRMI2",9,0)
 N DIERR,IEN,LRCMT,LRFDA,LRFDAIEN,LRIEN,LRIENS,LRMSG,LRPL,LRX,X,STAT
"RTN","LRVRMI2",10,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,0))
"RTN","LRVRMI2",11,0)
 S LRPL=$P(LRX,"^"),STAT=$P(LRX,"^",4)
"RTN","LRVRMI2",12,0)
 D BLDSTAT^LRVRMI4A(63.05,15,STAT,.LRSTATUS)
"RTN","LRVRMI2",13,0)
 M LRCMT=^LR(LRDFN,"MI",LRIDT,7)
"RTN","LRVRMI2",14,0)
 ;
"RTN","LRVRMI2",15,0)
 S IEN=0
"RTN","LRVRMI2",16,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,IEN)) Q:IEN<1  D  ;
"RTN","LRVRMI2",17,0)
 . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
"RTN","LRVRMI2",18,0)
 . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
"RTN","LRVRMI2",19,0)
 . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI2",20,0)
 . S LRFDA(7,63.36,LRIEN,.01)=LRX
"RTN","LRVRMI2",21,0)
 ;
"RTN","LRVRMI2",22,0)
 I $D(LRFDA) D
"RTN","LRVRMI2",23,0)
 . D UPDATE^DIE("","LRFDA(7)","LRFDAIEN","LRMSG")
"RTN","LRVRMI2",24,0)
 . S IEN=0
"RTN","LRVRMI2",25,0)
 . F  S IEN=$O(LRFDAIEN(IEN)) Q:'IEN  I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",7,"_LRFDAIEN(IEN),LRPL)
"RTN","LRVRMI2",26,0)
 ;
"RTN","LRVRMI2",27,0)
 K LRFDA,LRIEN,LRMSG,DIERR
"RTN","LRVRMI2",28,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI2",29,0)
 S LRFDA(7,63.05,LRIEN,14)=LRNOW
"RTN","LRVRMI2",30,0)
 S LRFDA(7,63.05,LRIEN,15.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI2",31,0)
 D FILE^DIE("","LRFDA(7)","LRMSG")
"RTN","LRVRMI2",32,0)
 S LRRPTAPP=1
"RTN","LRVRMI2",33,0)
 Q
"RTN","LRVRMI2",34,0)
 ;
"RTN","LRVRMI2",35,0)
 ;
"RTN","LRVRMI2",36,0)
N10 ; Process Mycology Remarks
"RTN","LRVRMI2",37,0)
 N DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
"RTN","LRVRMI2",38,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,0))
"RTN","LRVRMI2",39,0)
 S LRPL=$P(LRX,"^"),STAT=$P(LRX,U,4)
"RTN","LRVRMI2",40,0)
 D BLDSTAT^LRVRMI4A(63.05,19,STAT,.LRSTATUS)
"RTN","LRVRMI2",41,0)
 M LRCMT=^LR(LRDFN,"MI",LRIDT,10)
"RTN","LRVRMI2",42,0)
 ;
"RTN","LRVRMI2",43,0)
 S IEN=0
"RTN","LRVRMI2",44,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,IEN)) Q:IEN<1  D
"RTN","LRVRMI2",45,0)
 . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
"RTN","LRVRMI2",46,0)
 . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
"RTN","LRVRMI2",47,0)
 . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI2",48,0)
 . S LRFDA(10,63.38,LRIEN,.01)=LRX
"RTN","LRVRMI2",49,0)
 I $D(LRFDA) D
"RTN","LRVRMI2",50,0)
 . D UPDATE^DIE("","LRFDA(10)","LRFDAIEN","LRMSG")
"RTN","LRVRMI2",51,0)
 . S IEN=0
"RTN","LRVRMI2",52,0)
 . F  S IEN=$O(LRFDAIEN(IEN)) Q:'IEN  I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",10,"_LRFDAIEN(IEN),LRPL)
"RTN","LRVRMI2",53,0)
 ;
"RTN","LRVRMI2",54,0)
 K LRFDA,LRIEN,LRMSG,DIERR
"RTN","LRVRMI2",55,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI2",56,0)
 S LRFDA(10,63.05,LRIEN,18)=LRNOW
"RTN","LRVRMI2",57,0)
 S LRFDA(10,63.05,LRIEN,19.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI2",58,0)
 D FILE^DIE("","LRFDA(10)","LRMSG")
"RTN","LRVRMI2",59,0)
 S LRRPTAPP=1
"RTN","LRVRMI2",60,0)
 Q
"RTN","LRVRMI2",61,0)
 ;
"RTN","LRVRMI2",62,0)
 ;
"RTN","LRVRMI2",63,0)
N13 ; Process TB Rpt Remarks
"RTN","LRVRMI2",64,0)
 N DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
"RTN","LRVRMI2",65,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,0))
"RTN","LRVRMI2",66,0)
 S LRPL=$P(LRX,"^"),STAT=$P(LRX,U,4)
"RTN","LRVRMI2",67,0)
 D BLDSTAT^LRVRMI4A(63.05,23,STAT,.LRSTATUS)
"RTN","LRVRMI2",68,0)
 M LRCMT=^LR(LRDFN,"MI",LRIDT,13)
"RTN","LRVRMI2",69,0)
 ;
"RTN","LRVRMI2",70,0)
 S IEN=0
"RTN","LRVRMI2",71,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,IEN)) Q:IEN<1  D
"RTN","LRVRMI2",72,0)
 . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
"RTN","LRVRMI2",73,0)
 . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
"RTN","LRVRMI2",74,0)
 . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI2",75,0)
 . S LRFDA(13,63.41,LRIEN,.01)=LRX
"RTN","LRVRMI2",76,0)
 I $D(LRFDA) D
"RTN","LRVRMI2",77,0)
 . D UPDATE^DIE("","LRFDA(13)","LRFDAIEN","LRMSG")
"RTN","LRVRMI2",78,0)
 . S IEN=0
"RTN","LRVRMI2",79,0)
 . F  S IEN=$O(LRFDAIEN(IEN)) Q:'IEN  I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",13,"_LRFDAIEN(IEN),LRPL)
"RTN","LRVRMI2",80,0)
 ;
"RTN","LRVRMI2",81,0)
 K LRFDA,LRIEN,LRMSG,DIERR
"RTN","LRVRMI2",82,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI2",83,0)
 S LRFDA(13,63.05,LRIEN,22)=LRNOW
"RTN","LRVRMI2",84,0)
 S LRFDA(13,63.05,LRIEN,25.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI2",85,0)
 D FILE^DIE("","LRFDA(13)","LRMSG")
"RTN","LRVRMI2",86,0)
 S LRRPTAPP=1
"RTN","LRVRMI2",87,0)
 Q
"RTN","LRVRMI2",88,0)
 ;
"RTN","LRVRMI2",89,0)
 ;
"RTN","LRVRMI2",90,0)
N15 ; Mycology smear/prep
"RTN","LRVRMI2",91,0)
 N DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX
"RTN","LRVRMI2",92,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,0))
"RTN","LRVRMI2",93,0)
 S LRPL=$P(LRX,"^"),STAT=$P(LRX,U,4)
"RTN","LRVRMI2",94,0)
 D BLDSTAT^LRVRMI4A(63.05,19,STAT,.LRSTATUS)
"RTN","LRVRMI2",95,0)
 M LRCMT=^LR(LRDFN,"MI",LRIDT,15)
"RTN","LRVRMI2",96,0)
 ;
"RTN","LRVRMI2",97,0)
 S IEN=0
"RTN","LRVRMI2",98,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,IEN)) Q:IEN<1  D  ;
"RTN","LRVRMI2",99,0)
 . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
"RTN","LRVRMI2",100,0)
 . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
"RTN","LRVRMI2",101,0)
 . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI2",102,0)
 . S LRFDA(15,63.371,LRIEN,.01)=LRX
"RTN","LRVRMI2",103,0)
 ;
"RTN","LRVRMI2",104,0)
 I $D(LRFDA) D
"RTN","LRVRMI2",105,0)
 . D UPDATE^DIE("","LRFDA(15)","LRFDAIEN","LRMSG")
"RTN","LRVRMI2",106,0)
 . S IEN=0
"RTN","LRVRMI2",107,0)
 . F  S IEN=$O(LRFDAIEN(IEN)) Q:'IEN  I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",15,"_LRFDAIEN(IEN),LRPL)
"RTN","LRVRMI2",108,0)
 ;
"RTN","LRVRMI2",109,0)
 K LRFDA,LRIEN,LRMSG,DIERR
"RTN","LRVRMI2",110,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI2",111,0)
 S LRFDA(15,63.05,LRIEN,18)=LRNOW
"RTN","LRVRMI2",112,0)
 S LRFDA(15,63.05,LRIEN,19.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI2",113,0)
 D FILE^DIE("","LRFDA(15)","LRMSG")
"RTN","LRVRMI2",114,0)
 S LRRPTAPP=1
"RTN","LRVRMI2",115,0)
 Q
"RTN","LRVRMI2",116,0)
 ;
"RTN","LRVRMI2",117,0)
 ;
"RTN","LRVRMI2",118,0)
N18 ; Process Virology Rpt Remarks
"RTN","LRVRMI2",119,0)
 N DIERR,IEN,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
"RTN","LRVRMI2",120,0)
 ;
"RTN","LRVRMI2",121,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,0))
"RTN","LRVRMI2",122,0)
 S LRPL=$P(LRX,"^"),STAT=$P(LRX,U,4)
"RTN","LRVRMI2",123,0)
 D BLDSTAT^LRVRMI4A(63.05,34,STAT,.LRSTATUS)
"RTN","LRVRMI2",124,0)
 M LRCMT=^LR(LRDFN,"MI",LRIDT,18)
"RTN","LRVRMI2",125,0)
 ;
"RTN","LRVRMI2",126,0)
 S IEN=0
"RTN","LRVRMI2",127,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,IEN)) Q:IEN<1  D  ;
"RTN","LRVRMI2",128,0)
 . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
"RTN","LRVRMI2",129,0)
 . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
"RTN","LRVRMI2",130,0)
 . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI2",131,0)
 . S LRFDA(18,63.44,LRIEN,.01)=LRX
"RTN","LRVRMI2",132,0)
 I $D(LRFDA) D
"RTN","LRVRMI2",133,0)
 . D UPDATE^DIE("","LRFDA(18)","LRFDAIEN","LRMSG")
"RTN","LRVRMI2",134,0)
 . S IEN=0
"RTN","LRVRMI2",135,0)
 . F  S IEN=$O(LRFDAIEN(IEN)) Q:'IEN  I $G(LRPL) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",18,"_LRFDAIEN(IEN),LRPL)
"RTN","LRVRMI2",136,0)
 ;
"RTN","LRVRMI2",137,0)
 K LRFDA,LRIEN,LRMSG,DIERR
"RTN","LRVRMI2",138,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI2",139,0)
 S LRFDA(18,63.05,LRIEN,33)=LRNOW
"RTN","LRVRMI2",140,0)
 S LRFDA(18,63.05,LRIEN,35)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI2",141,0)
 D FILE^DIE("","LRFDA(18)","LRMSG")
"RTN","LRVRMI2",142,0)
 S LRRPTAPP=1
"RTN","LRVRMI2",143,0)
 Q
"RTN","LRVRMI2",144,0)
 ;
"RTN","LRVRMI2",145,0)
 ;
"RTN","LRVRMI2",146,0)
HEAD ;
"RTN","LRVRMI2",147,0)
 ; Start by getting the demographic data from LAH
"RTN","LRVRMI2",148,0)
 S EOL=$G(^LAH(LWL,1,ISQN,.1,"OBR","EOL"))
"RTN","LRVRMI2",149,0)
 S FID=$G(^LAH(LWL,1,ISQN,.1,"OBR","FID"))
"RTN","LRVRMI2",150,0)
 S ORCDT=$G(^LAH(LWL,1,ISQN,.1,"OBR","ORCDT"))
"RTN","LRVRMI2",151,0)
 S ORDNLT=$G(^LAH(LWL,1,ISQN,.1,"OBR","ORDNLT"))
"RTN","LRVRMI2",152,0)
 S ORDP=$G(^LAH(LWL,1,ISQN,.1,"OBR","ORDP"))
"RTN","LRVRMI2",153,0)
 S PEB=$G(^LAH(LWL,1,ISQN,.1,"OBR","PEB"))
"RTN","LRVRMI2",154,0)
 S PVB=$G(^LAH(LWL,1,ISQN,.1,"OBR","PVB"))
"RTN","LRVRMI2",155,0)
 S SID=$G(^LAH(LWL,1,ISQN,.1,"OBR","SID"))
"RTN","LRVRMI2",156,0)
 S DFN=$G(^LAH(LWL,1,ISQN,.1,"PID","DFN"))
"RTN","LRVRMI2",157,0)
 S DOB=$G(^LAH(LWL,1,ISQN,.1,"PID","DOB"))
"RTN","LRVRMI2",158,0)
 S ICN=$G(^LAH(LWL,1,ISQN,.1,"PID","ICN"))
"RTN","LRVRMI2",159,0)
 S LRTDFN=$G(^LAH(LWL,1,ISQN,.1,"PID","LRTDFN"))
"RTN","LRVRMI2",160,0)
 S PNM=$G(^LAH(LWL,1,ISQN,.1,"PID","PNM"))
"RTN","LRVRMI2",161,0)
 S SEX=$G(^LAH(LWL,1,ISQN,.1,"PID","SEX"))
"RTN","LRVRMI2",162,0)
 S SSN=$G(^LAH(LWL,1,ISQN,.1,"PID","SSN"))
"RTN","LRVRMI2",163,0)
 S LRUID=$G(^LAH(LWL,1,ISQN,.3))
"RTN","LRVRMI2",164,0)
 Q
"RTN","LRVRMI2A")
0^6^B78174930
"RTN","LRVRMI2A",1,0)
LRVRMI2A ;DALOI/STAFF - LAH/TMP TO FILE #63 ;11/27/12  18:20
"RTN","LRVRMI2A",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRVRMI2A",3,0)
 ;
"RTN","LRVRMI2A",4,0)
 ; Continuation of LRVRMI4 and is used for extracting results from the LAH global and storing it into LAB DATA FILE (#63).
"RTN","LRVRMI2A",5,0)
 ;
"RTN","LRVRMI2A",6,0)
 Q
"RTN","LRVRMI2A",7,0)
 ;
"RTN","LRVRMI2A",8,0)
N9 ; Process Fungus/Yeast
"RTN","LRVRMI2A",9,0)
 N DATA,DIERR,IEN,IEN2,IEN3,ISOID,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRN9,LRX,R6337,STAT
"RTN","LRVRMI2A",10,0)
 ;
"RTN","LRVRMI2A",11,0)
 ;ZEXCEPT: LRDFN,LRDUZ,LRFDAIEN,LRIDT,LRLL,LRNOW,LRPROF,LRSTATUS
"RTN","LRVRMI2A",12,0)
 ;
"RTN","LRVRMI2A",13,0)
 S (IEN,IEN2,IEN3)=0
"RTN","LRVRMI2A",14,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN)) Q:IEN<1  D N9A
"RTN","LRVRMI2A",15,0)
 ;
"RTN","LRVRMI2A",16,0)
 K LRFDA,LRMSG,LRIENS,DIERR
"RTN","LRVRMI2A",17,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI2A",18,0)
 S LRFDA(9,63.05,LRIEN,18)=LRNOW
"RTN","LRVRMI2A",19,0)
 S LRFDA(9,63.05,LRIEN,19.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI2A",20,0)
 D FILE^DIE("","LRFDA(9)","LRMSG")
"RTN","LRVRMI2A",21,0)
 S LRRPTAPP=1
"RTN","LRVRMI2A",22,0)
 Q
"RTN","LRVRMI2A",23,0)
 ;
"RTN","LRVRMI2A",24,0)
 ;
"RTN","LRVRMI2A",25,0)
N9A ; Process fungus yeast organism
"RTN","LRVRMI2A",26,0)
 ;
"RTN","LRVRMI2A",27,0)
 N DIERR,IEN2,ISOID,LRCMT,LRFDA,LRFDAIEN,LRI,LRIEN,LRIENS,LRMSG,LRN9,LRX,R6337,STAT
"RTN","LRVRMI2A",28,0)
 ;
"RTN","LRVRMI2A",29,0)
 S LRN9=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0))
"RTN","LRVRMI2A",30,0)
 Q:LRN9=""
"RTN","LRVRMI2A",31,0)
 S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,.1))
"RTN","LRVRMI2A",32,0)
 Q:ISOID=""
"RTN","LRVRMI2A",33,0)
 ; Delete ISOID if it exists
"RTN","LRVRMI2A",34,0)
 S R6337=$O(^LR(LRDFN,"MI",LRIDT,9,"C",ISOID,0))
"RTN","LRVRMI2A",35,0)
 I R6337 D
"RTN","LRVRMI2A",36,0)
 . K LRFDA,LRMSG,LRIENS,DIERR
"RTN","LRVRMI2A",37,0)
 . S LRIEN=R6337_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI2A",38,0)
 . S LRFDA(9,63.37,LRIEN,.01)="@"
"RTN","LRVRMI2A",39,0)
 . D FILE^DIE("","LRFDA(9)","LRMSG")
"RTN","LRVRMI2A",40,0)
 ;
"RTN","LRVRMI2A",41,0)
 K LRFDA,LRMSG,LRIENS,DIERR
"RTN","LRVRMI2A",42,0)
 S LRIEN="+1,"_LRIDT_","_LRDFN_","
"RTN","LRVRMI2A",43,0)
 S LRFDA(9,63.37,LRIEN,.01)=$P(LRN9,"^") ; fungus/yeast
"RTN","LRVRMI2A",44,0)
 S LRFDA(9,63.37,LRIEN,1)=$P(LRN9,"^",2) ; quantity
"RTN","LRVRMI2A",45,0)
 S LRFDA(9,63.37,LRIEN,.1)=ISOID
"RTN","LRVRMI2A",46,0)
 D UPDATE^DIE("","LRFDA(9)","LRIENS","LRMSG")
"RTN","LRVRMI2A",47,0)
 S R6337=$G(LRIENS(1))
"RTN","LRVRMI2A",48,0)
 Q:'R6337
"RTN","LRVRMI2A",49,0)
 ;
"RTN","LRVRMI2A",50,0)
 ; Store code system references for fungus
"RTN","LRVRMI2A",51,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0,.01))
"RTN","LRVRMI2A",52,0)
 F LRI=1:1:3 I $P(LRX,"^",LRI) D
"RTN","LRVRMI2A",53,0)
 . N LRDATA
"RTN","LRVRMI2A",54,0)
 . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",9,"_R6337_",0;1"
"RTN","LRVRMI2A",55,0)
 . S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
"RTN","LRVRMI2A",56,0)
 . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
"RTN","LRVRMI2A",57,0)
 ;
"RTN","LRVRMI2A",58,0)
 ; Store code system references for yeast quantity
"RTN","LRVRMI2A",59,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0,.02))
"RTN","LRVRMI2A",60,0)
 F LRI=1,2 I $P(LRX,"^",LRI) D
"RTN","LRVRMI2A",61,0)
 . N LRDATA
"RTN","LRVRMI2A",62,0)
 . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",9,"_R6337_"0;2"
"RTN","LRVRMI2A",63,0)
 . S LRDATA(.02)=2,LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT","^",LRI)
"RTN","LRVRMI2A",64,0)
 . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
"RTN","LRVRMI2A",65,0)
 ;
"RTN","LRVRMI2A",66,0)
 ; Store performing lab
"RTN","LRVRMI2A",67,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0,.01,1))
"RTN","LRVRMI2A",68,0)
 I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",9,"_R6337_",0",$P(LRX,"^"))
"RTN","LRVRMI2A",69,0)
 ;
"RTN","LRVRMI2A",70,0)
 S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0,.01,0))
"RTN","LRVRMI2A",71,0)
 D BLDSTAT^LRVRMI4A(63.05,19,STAT,.LRSTATUS)
"RTN","LRVRMI2A",72,0)
 ;
"RTN","LRVRMI2A",73,0)
 ; fungus/yeast comments - comments don't have status
"RTN","LRVRMI2A",74,0)
 K LRFDA,LRFDAIEN,LRMSG,LRIENS,DIERR
"RTN","LRVRMI2A",75,0)
 M LRCMT=^LR(LRDFN,"MI",LRIDT,9,IEN,1)
"RTN","LRVRMI2A",76,0)
 S IEN2=0
"RTN","LRVRMI2A",77,0)
 F  S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,1,IEN2)) Q:IEN2<1  D
"RTN","LRVRMI2A",78,0)
 . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,1,IEN2,0),LRX=$S(LRX'="":LRX,1:" ")
"RTN","LRVRMI2A",79,0)
 . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
"RTN","LRVRMI2A",80,0)
 . S LRIEN="+"_IEN2_","_R6337_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI2A",81,0)
 . S LRFDA(9,63.372,LRIEN,.01)=LRX
"RTN","LRVRMI2A",82,0)
 ;
"RTN","LRVRMI2A",83,0)
 I $D(LRFDA) D UPDATE^DIE("","LRFDA(9)","","LRMSG")
"RTN","LRVRMI2A",84,0)
 ;
"RTN","LRVRMI2A",85,0)
 Q
"RTN","LRVRMI2A",86,0)
 ;
"RTN","LRVRMI2A",87,0)
 ;
"RTN","LRVRMI2A",88,0)
N11 ; Process Acid Fast
"RTN","LRVRMI2A",89,0)
 N AFS,DIERR,LRFDA,LRIEN,LRIENS,LRMSG,LRX,QTY
"RTN","LRVRMI2A",90,0)
 ;
"RTN","LRVRMI2A",91,0)
 ;ZEXCEPT: LRDFN,LRDUZ,LRI,LRIDT,LRNOW
"RTN","LRVRMI2A",92,0)
 ;
"RTN","LRVRMI2A",93,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11))
"RTN","LRVRMI2A",94,0)
 D BLDSTAT^LRVRMI4A(63.05,23,$P(LRX,"^",2),.LRSTATUS)
"RTN","LRVRMI2A",95,0)
 ;
"RTN","LRVRMI2A",96,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI2A",97,0)
 S LRFDA(11,63.05,LRIEN,22)=LRNOW
"RTN","LRVRMI2A",98,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0))
"RTN","LRVRMI2A",99,0)
 S AFS=$P(LRX,"^",3),QTY=$P(LRX,U,4)
"RTN","LRVRMI2A",100,0)
 S LRFDA(11,63.05,LRIEN,24)=AFS ; Acid Fast Stain
"RTN","LRVRMI2A",101,0)
 ;I $L(QTY)>68 S QTY=$E(QTY,1,65)_"..."
"RTN","LRVRMI2A",102,0)
 S LRFDA(11,63.05,LRIEN,25)=QTY ; Quantity
"RTN","LRVRMI2A",103,0)
 S LRFDA(11,63.05,LRIEN,25.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI2A",104,0)
 ; derive status
"RTN","LRVRMI2A",105,0)
 I AFS'="" D
"RTN","LRVRMI2A",106,0)
 . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0,.01,0))
"RTN","LRVRMI2A",107,0)
 . D BLDSTAT^LRVRMI4A(63.05,23,$P(LRX,"^"),.LRSTATUS)
"RTN","LRVRMI2A",108,0)
 I QTY'="" D
"RTN","LRVRMI2A",109,0)
 . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0,.02,0))
"RTN","LRVRMI2A",110,0)
 . D BLDSTAT^LRVRMI4A(63.05,23,$P(LRX,"^"),.LRSTATUS)
"RTN","LRVRMI2A",111,0)
 ;
"RTN","LRVRMI2A",112,0)
 D FILE^DIE("","LRFDA(11)","LRMSG")
"RTN","LRVRMI2A",113,0)
 S LRRPTAPP=1
"RTN","LRVRMI2A",114,0)
 ;
"RTN","LRVRMI2A",115,0)
 ; Store code system references for AFB Stain
"RTN","LRVRMI2A",116,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0,.01))
"RTN","LRVRMI2A",117,0)
 F LRI=1,2 I $P(LRX,"^",LRI) D
"RTN","LRVRMI2A",118,0)
 . N LRDATA
"RTN","LRVRMI2A",119,0)
 . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",11,0;3"
"RTN","LRVRMI2A",120,0)
 . S LRDATA(.02)=2,LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT","^",LRI)
"RTN","LRVRMI2A",121,0)
 . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
"RTN","LRVRMI2A",122,0)
 ;
"RTN","LRVRMI2A",123,0)
 ; Store code system references for AFB quantity
"RTN","LRVRMI2A",124,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0,.02))
"RTN","LRVRMI2A",125,0)
 F LRI=1,2 I $P(LRX,"^",LRI) D
"RTN","LRVRMI2A",126,0)
 . N LRDATA
"RTN","LRVRMI2A",127,0)
 . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",11,0;4"
"RTN","LRVRMI2A",128,0)
 . S LRDATA(.02)=2,LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT","^",LRI)
"RTN","LRVRMI2A",129,0)
 . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
"RTN","LRVRMI2A",130,0)
 ;
"RTN","LRVRMI2A",131,0)
 Q
"RTN","LRVRMI2A",132,0)
 ;
"RTN","LRVRMI2A",133,0)
 ;
"RTN","LRVRMI2A",134,0)
N12 ; Process Mycobacteria
"RTN","LRVRMI2A",135,0)
 ;
"RTN","LRVRMI2A",136,0)
 N DATA,DIERR,DNFLDS,FLD,IEN,IEN2,ISOID,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRN12,LRX,R6339,STAT
"RTN","LRVRMI2A",137,0)
 ;
"RTN","LRVRMI2A",138,0)
 ;ZEXCEPT: LRDFN,LRIDT,LRLL,LRPROF,LRSTATUS
"RTN","LRVRMI2A",139,0)
 ;
"RTN","LRVRMI2A",140,0)
 S IEN=0
"RTN","LRVRMI2A",141,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN)) Q:IEN<1  D N12A
"RTN","LRVRMI2A",142,0)
 ;
"RTN","LRVRMI2A",143,0)
 Q
"RTN","LRVRMI2A",144,0)
 ;
"RTN","LRVRMI2A",145,0)
 ;
"RTN","LRVRMI2A",146,0)
N12A ; Process mycobacteria organism
"RTN","LRVRMI2A",147,0)
 ;
"RTN","LRVRMI2A",148,0)
 N DATA,DIERR,DNFLDS,FLD,I,IEN2,ISOID,LRCMT,LRCSR,LRFDA,LRI,LRIEN,LRIENS,LRMSG,LRN12,LRX,R6339,STAT
"RTN","LRVRMI2A",149,0)
 ;
"RTN","LRVRMI2A",150,0)
 ;ZEXCEPT: IEN,LRDFN,LRIDT,LRLL,LRPROF,LRSTATUS
"RTN","LRVRMI2A",151,0)
 ;
"RTN","LRVRMI2A",152,0)
 S LRN12=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,0))
"RTN","LRVRMI2A",153,0)
 Q:LRN12=""
"RTN","LRVRMI2A",154,0)
 S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,.1))
"RTN","LRVRMI2A",155,0)
 Q:ISOID=""
"RTN","LRVRMI2A",156,0)
 ;
"RTN","LRVRMI2A",157,0)
 ; Delete ISOID entry if it exists
"RTN","LRVRMI2A",158,0)
 S R6339=$O(^LR(LRDFN,"MI",LRIDT,12,"C",ISOID,0))
"RTN","LRVRMI2A",159,0)
 I R6339 D
"RTN","LRVRMI2A",160,0)
 . K LRFDA,LRMSG,DIERR
"RTN","LRVRMI2A",161,0)
 . S LRIEN=R6339_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI2A",162,0)
 . S LRFDA(12,63.39,LRIEN,.01)="@"
"RTN","LRVRMI2A",163,0)
 . D FILE^DIE("","LRFDA(12)","LRMSG")
"RTN","LRVRMI2A",164,0)
 ; existing ISOID was deleted so always add record
"RTN","LRVRMI2A",165,0)
 ;
"RTN","LRVRMI2A",166,0)
 K LRFDA,LRIENS,LRMSG,DIERR
"RTN","LRVRMI2A",167,0)
 S LRIEN="+1,"_LRIDT_","_LRDFN_","
"RTN","LRVRMI2A",168,0)
 S LRFDA(12,63.39,LRIEN,.01)=$P(LRN12,U)
"RTN","LRVRMI2A",169,0)
 S LRFDA(12,63.39,LRIEN,.1)=ISOID
"RTN","LRVRMI2A",170,0)
 S LRFDA(12,63.39,LRIEN,1)=$P(LRN12,U,2)
"RTN","LRVRMI2A",171,0)
 D UPDATE^DIE("","LRFDA(12)","LRIENS","LRMSG")
"RTN","LRVRMI2A",172,0)
 S R6339=$G(LRIENS(1))
"RTN","LRVRMI2A",173,0)
 Q:'R6339
"RTN","LRVRMI2A",174,0)
 ;
"RTN","LRVRMI2A",175,0)
 ; Store code system references
"RTN","LRVRMI2A",176,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,0,.01))
"RTN","LRVRMI2A",177,0)
 F LRI=1:1:3 I $P(LRX,"^",LRI) D
"RTN","LRVRMI2A",178,0)
 . N LRDATA
"RTN","LRVRMI2A",179,0)
 . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",12,"_R6339_",0"
"RTN","LRVRMI2A",180,0)
 . S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
"RTN","LRVRMI2A",181,0)
 . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
"RTN","LRVRMI2A",182,0)
 ;
"RTN","LRVRMI2A",183,0)
 ; Store performing lab
"RTN","LRVRMI2A",184,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,0,.01,1))
"RTN","LRVRMI2A",185,0)
 I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",12,"_R6339_",0",$P(LRX,"^"))
"RTN","LRVRMI2A",186,0)
 ;
"RTN","LRVRMI2A",187,0)
 S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,0,.01,0))
"RTN","LRVRMI2A",188,0)
 D BLDSTAT^LRVRMI4A(63.05,23,STAT,.LRSTATUS)
"RTN","LRVRMI2A",189,0)
 ;
"RTN","LRVRMI2A",190,0)
 ; Process comments
"RTN","LRVRMI2A",191,0)
 K LRFDA,LRIENS,LRMSG,DIERR
"RTN","LRVRMI2A",192,0)
 M LRCMT=^LR(LRDFN,"MI",LRIDT,12,IEN,1)
"RTN","LRVRMI2A",193,0)
 S IEN2=0
"RTN","LRVRMI2A",194,0)
 F  S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,1,IEN2)) Q:'IEN2  D
"RTN","LRVRMI2A",195,0)
 . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,1,IEN2,0),LRX=$S(LRX'="":LRX,1:" ")
"RTN","LRVRMI2A",196,0)
 . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
"RTN","LRVRMI2A",197,0)
 . S LRIEN="+"_IEN2_","_R6339_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI2A",198,0)
 . S LRFDA(12,63.4,LRIEN,.01)=LRX
"RTN","LRVRMI2A",199,0)
 I $D(LRFDA) D UPDATE^DIE("","LRFDA(12)","","LRMSG")
"RTN","LRVRMI2A",200,0)
 ;
"RTN","LRVRMI2A",201,0)
 ; Add drug susceptibilities
"RTN","LRVRMI2A",202,0)
 S IEN2=1.999999999,IEN2=2
"RTN","LRVRMI2A",203,0)
 K LRFDA,LRIENS,LRMSG,DIERR
"RTN","LRVRMI2A",204,0)
 F  S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,IEN2)) Q:'IEN2  D  ;
"RTN","LRVRMI2A",205,0)
 . S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,IEN2,.01,0))
"RTN","LRVRMI2A",206,0)
 . D BLDSTAT^LRVRMI4A(63.05,23,STAT,.LRSTATUS)
"RTN","LRVRMI2A",207,0)
 . S LRIEN=R6339_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI2A",208,0)
 . S DATA=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,IEN2)
"RTN","LRVRMI2A",209,0)
 . S DNFLDS=$$DN2FLDS^LRVRMI4A(IEN2,,12)
"RTN","LRVRMI2A",210,0)
 . S FLD=$P(DNFLDS,"^",1)
"RTN","LRVRMI2A",211,0)
 . I FLD S LRFDA(12,63.39,LRIEN,FLD)=DATA
"RTN","LRVRMI2A",212,0)
 . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,IEN2,.01))
"RTN","LRVRMI2A",213,0)
 . F I=1:1:3 I $P(LRX,"^",I) S LRCSR(IEN2_";1",$S(I<3:2,1:3),$P("LN^NLT^SCT","^",I))=$P(LRX,"^",I)
"RTN","LRVRMI2A",214,0)
 ;
"RTN","LRVRMI2A",215,0)
 ; File susceptibilities
"RTN","LRVRMI2A",216,0)
 I $D(LRFDA) D FILE^DIE("","LRFDA(12)","LRMSG")
"RTN","LRVRMI2A",217,0)
 ;
"RTN","LRVRMI2A",218,0)
 ; Store code system references
"RTN","LRVRMI2A",219,0)
 I $D(LRCSR) D CSR^LRVRMI4A(.LRCSR,LRDFN_",MI,"_LRIDT_",12,"_IEN_",")
"RTN","LRVRMI2A",220,0)
 ;
"RTN","LRVRMI2A",221,0)
 Q
"RTN","LRVRMI2A",222,0)
 ;
"RTN","LRVRMI2A",223,0)
 ;
"RTN","LRVRMI2A",224,0)
N17 ; Process Virology
"RTN","LRVRMI2A",225,0)
 N DIERR,IEN,IEN2,IEN3,LRFDA,LRIEN,LRMSG
"RTN","LRVRMI2A",226,0)
 ;
"RTN","LRVRMI2A",227,0)
 ;ZEXCEPT: LRDFN,LRDUZ,LRIDT,LRNOW
"RTN","LRVRMI2A",228,0)
 ;
"RTN","LRVRMI2A",229,0)
 S (IEN,IEN2,IEN3)=0
"RTN","LRVRMI2A",230,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN)) Q:IEN<1  D N17A
"RTN","LRVRMI2A",231,0)
 ;
"RTN","LRVRMI2A",232,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI2A",233,0)
 S LRFDA(17,63.05,LRIEN,33)=LRNOW
"RTN","LRVRMI2A",234,0)
 S LRFDA(17,63.05,LRIEN,35)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI2A",235,0)
 D FILE^DIE("","LRFDA(17)","LRMSG")
"RTN","LRVRMI2A",236,0)
 S LRRPTAPP=1
"RTN","LRVRMI2A",237,0)
 Q
"RTN","LRVRMI2A",238,0)
 ;
"RTN","LRVRMI2A",239,0)
 ;
"RTN","LRVRMI2A",240,0)
N17A ; Process virus
"RTN","LRVRMI2A",241,0)
 ;
"RTN","LRVRMI2A",242,0)
 N DIERR,ISOID,LRFDA,LRI,LRIEN,LRMSG,LRN17,LRX,R6343
"RTN","LRVRMI2A",243,0)
 ;
"RTN","LRVRMI2A",244,0)
 ;ZEXCEPT: IEN,LRDFN,LRIDT
"RTN","LRVRMI2A",245,0)
 ;
"RTN","LRVRMI2A",246,0)
 S LRN17=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,0)
"RTN","LRVRMI2A",247,0)
 Q:LRN17=""
"RTN","LRVRMI2A",248,0)
 S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,.1))
"RTN","LRVRMI2A",249,0)
 Q:ISOID=""
"RTN","LRVRMI2A",250,0)
 ;
"RTN","LRVRMI2A",251,0)
 ; Delete ISOID if it exists
"RTN","LRVRMI2A",252,0)
 S R6343=$O(^LR(LRDFN,"MI",LRIDT,17,"C",ISOID,0))
"RTN","LRVRMI2A",253,0)
 I R6343 D
"RTN","LRVRMI2A",254,0)
 . K LRFDA,LRMSG,DIERR
"RTN","LRVRMI2A",255,0)
 . S LRIEN=R6343_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI2A",256,0)
 . S LRFDA(17,63.43,LRIEN,.01)="@"
"RTN","LRVRMI2A",257,0)
 . D FILE^DIE("","LRFDA(17)","LRMSG")
"RTN","LRVRMI2A",258,0)
 ;
"RTN","LRVRMI2A",259,0)
 ; Store code system references
"RTN","LRVRMI2A",260,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,0,.01))
"RTN","LRVRMI2A",261,0)
 F LRI=1:1:3 I $P(LRX,"^",LRI) D
"RTN","LRVRMI2A",262,0)
 . N LRDATA
"RTN","LRVRMI2A",263,0)
 . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",17,"_R6343_",0"
"RTN","LRVRMI2A",264,0)
 . S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
"RTN","LRVRMI2A",265,0)
 . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
"RTN","LRVRMI2A",266,0)
 ;
"RTN","LRVRMI2A",267,0)
 ; Store performing lab
"RTN","LRVRMI2A",268,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,0,.01,1))
"RTN","LRVRMI2A",269,0)
 I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",17,"_R6343_",0",$P(LRX,"^"))
"RTN","LRVRMI2A",270,0)
 ;
"RTN","LRVRMI2A",271,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,0,.01,0))
"RTN","LRVRMI2A",272,0)
 D BLDSTAT^LRVRMI4A(63.05,34,$P(LRX,"^"),.LRSTATUS)
"RTN","LRVRMI2A",273,0)
 ;
"RTN","LRVRMI2A",274,0)
 K LRFDA,LRIEN,LRMSG,DIERR
"RTN","LRVRMI2A",275,0)
 S LRIEN="+1,"_LRIDT_","_LRDFN_","
"RTN","LRVRMI2A",276,0)
 S LRFDA(17,63.43,LRIEN,.01)=LRN17
"RTN","LRVRMI2A",277,0)
 S LRFDA(17,63.43,LRIEN,.1)=ISOID
"RTN","LRVRMI2A",278,0)
 D UPDATE^DIE("","LRFDA(17)","","LRMSG")
"RTN","LRVRMI2A",279,0)
 ;
"RTN","LRVRMI2A",280,0)
 Q
"RTN","LRVRMI3")
0^7^B26579796
"RTN","LRVRMI3",1,0)
LRVRMI3 ;DALOI/STAFF - LAB MICRO LEDI INTERFACE ;08/15/13  16:08
"RTN","LRVRMI3",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRVRMI3",3,0)
 ;
"RTN","LRVRMI3",4,0)
 ; Part of Micro LEDI interface.  It is a continuation of ^LRVRMI4 and ^LRVRMI2. Processes data in the temp global ^TMP("LRMI")
"RTN","LRVRMI3",5,0)
 ; and stores it into the appropriate sections of the Lab Data Microbiology file (#63.05).
"RTN","LRVRMI3",6,0)
 ;
"RTN","LRVRMI3",7,0)
 ;
"RTN","LRVRMI3",8,0)
NODE(LRNODE) ;  Process similar multiples - nodes 15,19-31
"RTN","LRVRMI3",9,0)
 ; Call with LRNODE = node in MI subscript to process
"RTN","LRVRMI3",10,0)
 ;
"RTN","LRVRMI3",11,0)
 N DIERR,IEN,LRCMT,LRFDA,LRFDAIEN,LRFILE,LRERR,LRIEN,LRMSG,LRPL,LRX,X
"RTN","LRVRMI3",12,0)
 ; Mycology smear/prep^^^^Preliminary bacteriology comment^Preliminary virology comment^Preliminary parasite comment^Preliminary mycology comment^Preliminary TB comment^
"RTN","LRVRMI3",13,0)
 ; Parasitology smear/prep^Bacteriology smear/prep^Bacteriology test^Parasite test^Mycology test^TB test^Virology test^Sterility test
"RTN","LRVRMI3",14,0)
 ;
"RTN","LRVRMI3",15,0)
 S LRFILE=$P("63.371^^^^63.06^63.431^63.1^63.11^63.18^63.341^63.291^63.061^63.361^63.111^63.181^63.432^63.292^","^",LRNODE-14)
"RTN","LRVRMI3",16,0)
 M LRCMT=^LR(LRDFN,"MI",LRIDT,LRNODE)
"RTN","LRVRMI3",17,0)
 ;
"RTN","LRVRMI3",18,0)
 S IEN=0
"RTN","LRVRMI3",19,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,IEN)) Q:IEN<1  D
"RTN","LRVRMI3",20,0)
 . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,IEN,0)),LRX=$S(LRX'="":LRX,1:" ")
"RTN","LRVRMI3",21,0)
 . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
"RTN","LRVRMI3",22,0)
 . S LRFDA(1,LRFILE,"+"_IEN_","_LRIDT_","_LRDFN_",",.01)=LRX
"RTN","LRVRMI3",23,0)
 . S LRFDAIEN(IEN)=IEN
"RTN","LRVRMI3",24,0)
 . ;
"RTN","LRVRMI3",25,0)
 . ; if result came across in NTE, PL and status info will be under ^(0) node
"RTN","LRVRMI3",26,0)
 . I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,0)) D  ;
"RTN","LRVRMI3",27,0)
 . . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,0))
"RTN","LRVRMI3",28,0)
 . . S X=$P(LRX,"^",4)
"RTN","LRVRMI3",29,0)
 . . D STAT4CMT(LRFILE,X,.LRSTATUS)
"RTN","LRVRMI3",30,0)
 . . I $P(LRX,"^") S LRPL(IEN)=$P(LRX,"^")
"RTN","LRVRMI3",31,0)
 . ;
"RTN","LRVRMI3",32,0)
 . ; if result came across in OBX, PL and status info will be under ^(IEN,0,0) node
"RTN","LRVRMI3",33,0)
 . I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,IEN,0,0)) D  ;
"RTN","LRVRMI3",34,0)
 . . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,IEN,0,0))
"RTN","LRVRMI3",35,0)
 . . S X=$P(LRX,"^",4)
"RTN","LRVRMI3",36,0)
 . . D STAT4CMT(LRFILE,X,.LRSTATUS)
"RTN","LRVRMI3",37,0)
 . . I $P(LRX,"^") S LRPL(IEN)=$P(LRX,"^")
"RTN","LRVRMI3",38,0)
 . ;
"RTN","LRVRMI3",39,0)
 ;
"RTN","LRVRMI3",40,0)
 I '$D(LRFDA) Q
"RTN","LRVRMI3",41,0)
 ;
"RTN","LRVRMI3",42,0)
 D UPDATE^DIE("","LRFDA(1)","LRFDAIEN","LRERR")
"RTN","LRVRMI3",43,0)
 S IEN=0
"RTN","LRVRMI3",44,0)
 F  S IEN=$O(LRPL(IEN)) Q:'IEN  D
"RTN","LRVRMI3",45,0)
 . I $G(LRFDAIEN(IEN)) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_","_LRNODE_","_LRFDAIEN(IEN),LRPL(IEN))
"RTN","LRVRMI3",46,0)
 ;
"RTN","LRVRMI3",47,0)
 ;
"RTN","LRVRMI3",48,0)
 ; Update d/t approved and user approving
"RTN","LRVRMI3",49,0)
 S LRX=$$RPTDT(LRDFN,LRIDT,LRNODE,LRNOW,$S($G(LRDUZ):LRDUZ,1:$G(DUZ)))
"RTN","LRVRMI3",50,0)
 ;
"RTN","LRVRMI3",51,0)
 Q
"RTN","LRVRMI3",52,0)
 ;
"RTN","LRVRMI3",53,0)
 ;
"RTN","LRVRMI3",54,0)
SETPL(NODE) ; Setup LRPL array
"RTN","LRVRMI3",55,0)
 ; Call with NODE = node in MI subscript to retrieve the performing lab
"RTN","LRVRMI3",56,0)
 ;
"RTN","LRVRMI3",57,0)
 N LRX
"RTN","LRVRMI3",58,0)
 S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,NODE,IEN,0,0)
"RTN","LRVRMI3",59,0)
 I $P(LRX,"^") S LRPL(IEN)=$P(LRX,"^")
"RTN","LRVRMI3",60,0)
 Q
"RTN","LRVRMI3",61,0)
 ;
"RTN","LRVRMI3",62,0)
 ;
"RTN","LRVRMI3",63,0)
STOREPL(NODE) ; Set performing lab
"RTN","LRVRMI3",64,0)
 ; Call with NODE = node in MI subscript to retrieve the performing lab
"RTN","LRVRMI3",65,0)
 N IEN
"RTN","LRVRMI3",66,0)
 S IEN=0
"RTN","LRVRMI3",67,0)
 F  S IEN=$O(LRPL(IEN)) Q:'IEN  I $G(LRFDAIEN(IEN)) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_","_NODE_","_LRFDAIEN(IEN),LRPL(IEN))
"RTN","LRVRMI3",68,0)
 Q
"RTN","LRVRMI3",69,0)
 ;
"RTN","LRVRMI3",70,0)
 ;
"RTN","LRVRMI3",71,0)
DUPCHK(LRLL,LRPROF,LRCMT,LRCOM) ; Check for duplicates - comment stripped if spaces, force to upper case unless
"RTN","LRVRMI3",72,0)
 ; flag set to store duplicates (Field #2.2 of PROFILE multiple in file #68.2)
"RTN","LRVRMI3",73,0)
 ;
"RTN","LRVRMI3",74,0)
 ; Call with  LRLL = load/work list ien
"RTN","LRVRMI3",75,0)
 ;          LRPROF = profile ien in load/worklist
"RTN","LRVRMI3",76,0)
 ;           LRCMT = array containing current comments on file
"RTN","LRVRMI3",77,0)
 ;           LRCOM = new comment to check
"RTN","LRVRMI3",78,0)
 ;
"RTN","LRVRMI3",79,0)
 ; Returns LRDUP = 0 (no duplicate), 1 (duplicate)
"RTN","LRVRMI3",80,0)
 ;
"RTN","LRVRMI3",81,0)
 N LRDUP,LRI,LRX,LRY
"RTN","LRVRMI3",82,0)
 S LRDUP=0
"RTN","LRVRMI3",83,0)
 I '$P($G(^LRO(68.2,LRLL,10,+$G(LRPROF),0)),U,4) D
"RTN","LRVRMI3",84,0)
 . S LRI=0,LRY=$TR(LRCOM," ",""),LRY=$$UP^XLFSTR(LRY)
"RTN","LRVRMI3",85,0)
 . F  S LRI=$O(LRCMT(LRI)) Q:'LRI  D  Q:LRDUP
"RTN","LRVRMI3",86,0)
 . . S LRX=$P(LRCMT(LRI,0),U),LRX=$TR(LRX," ",""),LRX=$$UP^XLFSTR(LRX)
"RTN","LRVRMI3",87,0)
 . . I LRX=LRY S LRDUP=1
"RTN","LRVRMI3",88,0)
 Q LRDUP
"RTN","LRVRMI3",89,0)
 ;
"RTN","LRVRMI3",90,0)
 ;
"RTN","LRVRMI3",91,0)
STAT4CMT(FILE,STAT,LRSTATUS) ; Calculate status for comment nodes (eg BACT SMEAR)
"RTN","LRVRMI3",92,0)
 ; Inputs
"RTN","LRVRMI3",93,0)
 ;       FILE: The file # of the comment field in #63.
"RTN","LRVRMI3",94,0)
 ;       STAT: The status (eg F)
"RTN","LRVRMI3",95,0)
 ;   LRSTATUS:<byref>  Input and Output
"RTN","LRVRMI3",96,0)
 ; Outputs
"RTN","LRVRMI3",97,0)
 ;   LRSTATUS:
"RTN","LRVRMI3",98,0)
 N SUBF,FLD
"RTN","LRVRMI3",99,0)
 S (FLD,SUBF)=""
"RTN","LRVRMI3",100,0)
 ;
"RTN","LRVRMI3",101,0)
 I FILE=63.291 S SUBF=63.05,FLD=11.5 ; Bact Smear
"RTN","LRVRMI3",102,0)
 I FILE=63.341 S SUBF=63.05,FLD=15 ; Para Smear
"RTN","LRVRMI3",103,0)
 I FILE=63.371 S SUBF=63.05,FLD=19 ; Myco Smear
"RTN","LRVRMI3",104,0)
 I FILE=63.06 S SUBF=63.05,FLD=11.5 ; preliminary bacteria comment
"RTN","LRVRMI3",105,0)
 I FILE=63.431 S SUBF=63.05,FLD=34 ; preliminary virus comment
"RTN","LRVRMI3",106,0)
 I FILE=63.1 S SUBF=63.05,FLD=15 ; preliminary parasite comment
"RTN","LRVRMI3",107,0)
 I FILE=63.11 S SUBF=63.05,FLD=19 ; preliminary mycology comment
"RTN","LRVRMI3",108,0)
 I FILE=63.18 S SUBF=63.05,FLD=23 ; preliminary TB comment
"RTN","LRVRMI3",109,0)
 I FILE=63.061 S SUBF=63.05,FLD=11.5 ; bacteria tests
"RTN","LRVRMI3",110,0)
 I FILE=63.361 S SUBF=63.05,FLD=15 ; parasitology tests
"RTN","LRVRMI3",111,0)
 I FILE=63.111 S SUBF=63.05,FLD=19 ; mycology tests
"RTN","LRVRMI3",112,0)
 I FILE=63.181 S SUBF=63.05,FLD=23 ; TB tests
"RTN","LRVRMI3",113,0)
 I FILE=63.432 S SUBF=63.05,FLD=34 ; virology tests
"RTN","LRVRMI3",114,0)
 I FILE=63.292 S SUBF=63.05,FLD=11.5 ; sterility tests
"RTN","LRVRMI3",115,0)
 ;
"RTN","LRVRMI3",116,0)
 I FLD,SUBF D BLDSTAT^LRVRMI4A(SUBF,FLD,STAT,.LRSTATUS)
"RTN","LRVRMI3",117,0)
 ;
"RTN","LRVRMI3",118,0)
 Q
"RTN","LRVRMI3",119,0)
 ;
"RTN","LRVRMI3",120,0)
 ;
"RTN","LRVRMI3",121,0)
RPTDT(LRDFN,LRIDT,SUBSCR,RPTDT,USER) ; File Report Approved Date and Person Reporting
"RTN","LRVRMI3",122,0)
 ; Inputs
"RTN","LRVRMI3",123,0)
 ;  LRDFN: LRDFN
"RTN","LRVRMI3",124,0)
 ;  LRIDT: LRIDT
"RTN","LRVRMI3",125,0)
 ; SUBSCR: MI Result Subscript (eg 19,21,23,24,25,26)
"RTN","LRVRMI3",126,0)
 ;  RPTDT: Report Approved Date/Time
"RTN","LRVRMI3",127,0)
 ;   USER: Person Reporting (#200)
"RTN","LRVRMI3",128,0)
 ; Outputs
"RTN","LRVRMI3",129,0)
 ;  Returns 0^ErrNum^ErrMsg on error, 1 on success
"RTN","LRVRMI3",130,0)
 N DIERR,FLDS,IEN,LRFDA,LRMSG,LRX
"RTN","LRVRMI3",131,0)
 ;
"RTN","LRVRMI3",132,0)
 S LRDFN=$G(LRDFN),LRIDT=$G(LRIDT),SUBSCR=$G(SUBSCR),(FLDS,LRX)=""
"RTN","LRVRMI3",133,0)
 ;
"RTN","LRVRMI3",134,0)
 I $G(RPTDT)'>0 S RPTDT=$$NOW^XLFDT()
"RTN","LRVRMI3",135,0)
 I $G(USER)="" S USER=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI3",136,0)
 I LRDFN,LRIDT,SUBSCR S FLDS=$$NODE2FLD(SUBSCR)
"RTN","LRVRMI3",137,0)
 ;
"RTN","LRVRMI3",138,0)
 I FLDS'="" D
"RTN","LRVRMI3",139,0)
 . S IEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI3",140,0)
 . S LRFDA(1,63.05,IEN,$P(FLDS,"^",1))=RPTDT
"RTN","LRVRMI3",141,0)
 . S LRFDA(1,63.05,IEN,$P(FLDS,"^",2))=USER
"RTN","LRVRMI3",142,0)
 . D FILE^DIE("","LRFDA(1)","LRMSG")
"RTN","LRVRMI3",143,0)
 . I '$D(LRMSG) S LRX=1,LRRPTAPP=1 Q
"RTN","LRVRMI3",144,0)
 . S LRX="0^2^FileMan error"
"RTN","LRVRMI3",145,0)
 E  S LRX="0^1^No Field #s found"
"RTN","LRVRMI3",146,0)
 ;
"RTN","LRVRMI3",147,0)
 Q LRX
"RTN","LRVRMI3",148,0)
 ;
"RTN","LRVRMI3",149,0)
 ;
"RTN","LRVRMI3",150,0)
NODE2FLD(NODE) ; Resolve the fields to update based on the node
"RTN","LRVRMI3",151,0)
 ; Call with NODE = node in MI subscript to process
"RTN","LRVRMI3",152,0)
 ;
"RTN","LRVRMI3",153,0)
 ; Returns FIELDS = Report Date Approved^Person Reporting field #s
"RTN","LRVRMI3",154,0)
 ;
"RTN","LRVRMI3",155,0)
 N FIELDS
"RTN","LRVRMI3",156,0)
 S NODE=$G(NODE),FIELDS=""
"RTN","LRVRMI3",157,0)
 ;
"RTN","LRVRMI3",158,0)
 I NODE'="" D
"RTN","LRVRMI3",159,0)
 . I NODE?1(1"19",1"25",1"26",1"31") S FIELDS="11^11.55" Q
"RTN","LRVRMI3",160,0)
 . I NODE?1(1"23",1"29") S FIELDS="22^25.5" Q
"RTN","LRVRMI3",161,0)
 . I NODE?1(1"21",1"24",1"27") S FIELDS="14^15.5" Q
"RTN","LRVRMI3",162,0)
 . I NODE?1(1"15",1"22",1"28") S FIELDS="18^19.5" Q
"RTN","LRVRMI3",163,0)
 . I NODE?1(1"20",1"30") S FIELDS="33^35" Q
"RTN","LRVRMI3",164,0)
 ;
"RTN","LRVRMI3",165,0)
 Q FIELDS
"RTN","LRVRMI4")
0^8^B38736850
"RTN","LRVRMI4",1,0)
LRVRMI4 ;DALOI/STAFF - LAH/TMP TO FILE 63 ;11/28/12  14:03
"RTN","LRVRMI4",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRVRMI4",3,0)
 ;
"RTN","LRVRMI4",4,0)
 ; Extracts the information in the ^TMP("LRMI",$J) global and stores it into the Lab Data micro subfile.
"RTN","LRVRMI4",5,0)
 ;
"RTN","LRVRMI4",6,0)
 Q
"RTN","LRVRMI4",7,0)
 ;
"RTN","LRVRMI4",8,0)
EN ;
"RTN","LRVRMI4",9,0)
 N LRNODE,LRNOW,LRRPTAPP,LRSTATUS,LR63539,X,I
"RTN","LRVRMI4",10,0)
 Q:'$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT))
"RTN","LRVRMI4",11,0)
 S LRNOW=$$NOW^XLFDT
"RTN","LRVRMI4",12,0)
 ; Get IEN of last Micro Audit on file
"RTN","LRVRMI4",13,0)
 S LR63539=0
"RTN","LRVRMI4",14,0)
 S X=$O(^LR(LRDFN,"MI",LRIDT,32,"B","A"),-1)
"RTN","LRVRMI4",15,0)
 I X S LR63539=$O(^LR(LRDFN,"MI",LRIDT,32,"B",X,0))
"RTN","LRVRMI4",16,0)
 ;
"RTN","LRVRMI4",17,0)
 ; If any of these nodes are defined then trigger the audit
"RTN","LRVRMI4",18,0)
 F I=1,2,3,4,5,6,7,8,9,10,11,12,13,15,16,17,18,99 I $D(^LR(LRDFN,"MI",LRIDT,I)) D  Q
"RTN","LRVRMI4",19,0)
 . I $G(LRSB)'>0 N LRSB S LRSB=$S(I<5:1,I<8:5,I<11:8,I<14:11,I<19:16,I=99:.99,1:0)
"RTN","LRVRMI4",20,0)
 . I LRSB>0 D AUDTRG
"RTN","LRVRMI4",21,0)
 ;
"RTN","LRVRMI4",22,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,0)) D N2
"RTN","LRVRMI4",23,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,0)) D N3^LRVRMI4A
"RTN","LRVRMI4",24,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,0)) D N4
"RTN","LRVRMI4",25,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,0)) D N6^LRVRMI4A
"RTN","LRVRMI4",26,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,0)) D N7^LRVRMI2
"RTN","LRVRMI4",27,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,0)) D N9^LRVRMI2A
"RTN","LRVRMI4",28,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,0)) D N10^LRVRMI2
"RTN","LRVRMI4",29,0)
 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11)) D N11^LRVRMI2A
"RTN","LRVRMI4",30,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,0)) D N12^LRVRMI2A
"RTN","LRVRMI4",31,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,0)) D N13^LRVRMI2
"RTN","LRVRMI4",32,0)
 ;I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,0)) D N15^LRVRMI2
"RTN","LRVRMI4",33,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,0)) D N17^LRVRMI2A
"RTN","LRVRMI4",34,0)
 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,0)) D N18^LRVRMI2
"RTN","LRVRMI4",35,0)
 ;
"RTN","LRVRMI4",36,0)
 F LRNODE=15,19:1:31 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,0)) D NODE^LRVRMI3(LRNODE)
"RTN","LRVRMI4",37,0)
 ;
"RTN","LRVRMI4",38,0)
 I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,99)) D N99
"RTN","LRVRMI4",39,0)
 ;
"RTN","LRVRMI4",40,0)
 D SETSTAT^LRVRMI4A(.LRSTATUS)
"RTN","LRVRMI4",41,0)
 I (LRSTATUS(0)="C")!(LRSTATUS(0)="F") D FIN  ; ccr_5439n - Added IF statement to only Do FIN if overall status is final or corrected. LMT 9/6/11
"RTN","LRVRMI4",42,0)
 ;
"RTN","LRVRMI4",43,0)
 I $G(LRRPTAPP) D VT1^LRMIUT1
"RTN","LRVRMI4",44,0)
 ;
"RTN","LRVRMI4",45,0)
 ; Update MICRO AUDIT to reflect corrected status
"RTN","LRVRMI4",46,0)
 ;  If audit doesn't exist then create instead of updating.
"RTN","LRVRMI4",47,0)
 I LRSTATUS(0)="C" D
"RTN","LRVRMI4",48,0)
 . I LR63539<1 D AUDTRG Q
"RTN","LRVRMI4",49,0)
 . N LRFDA,LRIEN,LRMSG,DIERR
"RTN","LRVRMI4",50,0)
 . S LRIEN=LR63539_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI4",51,0)
 . S LRFDA(1,63.539,LRIEN,3)=3 ; Edit Type
"RTN","LRVRMI4",52,0)
 . D FILE^DIE("","LRFDA(1)","LRMSG")
"RTN","LRVRMI4",53,0)
 ;
"RTN","LRVRMI4",54,0)
 Q
"RTN","LRVRMI4",55,0)
 ;
"RTN","LRVRMI4",56,0)
 ;
"RTN","LRVRMI4",57,0)
FIN ; Release report
"RTN","LRVRMI4",58,0)
 N LRFDA,LRIEN,LRMSG,DIERR
"RTN","LRVRMI4",59,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI4",60,0)
 S LRFDA(1,63.05,LRIEN,.04)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI4",61,0)
 S LRFDA(1,63.05,LRIEN,.03)=LRNOW
"RTN","LRVRMI4",62,0)
 ;S LRFDA(1,63.05,LRIEN,.2)=LRNOW ; ccr_5439n - Commented this line out as there is no field .2 in subfile #63.05. LMT 9/6/11
"RTN","LRVRMI4",63,0)
 D FILE^DIE("","LRFDA(1)","LRMSG")
"RTN","LRVRMI4",64,0)
 Q
"RTN","LRVRMI4",65,0)
 ;
"RTN","LRVRMI4",66,0)
 ;
"RTN","LRVRMI4",67,0)
N2 ; Process gram stain comments
"RTN","LRVRMI4",68,0)
 N DIERR,IEN,LRCMT,LRCSR,LRDATA,LRFDA,LRFDAIEN,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
"RTN","LRVRMI4",69,0)
 ;
"RTN","LRVRMI4",70,0)
 M LRCMT=^LR(LRDFN,"MI",LRIDT,2)
"RTN","LRVRMI4",71,0)
 ;
"RTN","LRVRMI4",72,0)
 S IEN=0,STAT=""
"RTN","LRVRMI4",73,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,IEN)) Q:IEN<1  D
"RTN","LRVRMI4",74,0)
 . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
"RTN","LRVRMI4",75,0)
 . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
"RTN","LRVRMI4",76,0)
 . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI4",77,0)
 . S LRFDA(2,63.29,LRIEN,.01)=LRX
"RTN","LRVRMI4",78,0)
 . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,IEN,0,0)
"RTN","LRVRMI4",79,0)
 . I $P(LRX,"^") S LRPL(IEN)=$P(LRX,"^")
"RTN","LRVRMI4",80,0)
 . I $P(LRX,"^",3) S LRCSR(IEN,2,"LN")=$P(LRX,"^",3)
"RTN","LRVRMI4",81,0)
 . I $P(LRX,"^",4) S LRCSR(IEN,2,"NLT")=$P(LRX,"^",4)
"RTN","LRVRMI4",82,0)
 . I $P(LRX,"^",5)'="" D BLDSTAT^LRVRMI4A(63.05,11.5,$P(LRX,"^",5),.LRSTATUS)
"RTN","LRVRMI4",83,0)
 I '$D(LRFDA) Q
"RTN","LRVRMI4",84,0)
 ;
"RTN","LRVRMI4",85,0)
 D UPDATE^DIE("","LRFDA(2)","LRFDAIEN","LRMSG")
"RTN","LRVRMI4",86,0)
 ; Store performing lab
"RTN","LRVRMI4",87,0)
 S IEN=0
"RTN","LRVRMI4",88,0)
 F  S IEN=$O(LRPL(IEN)) Q:'IEN  D
"RTN","LRVRMI4",89,0)
 . I $G(LRPL(IEN)),$G(LRFDAIEN(IEN)) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",2,"_LRFDAIEN(IEN),LRPL(IEN))
"RTN","LRVRMI4",90,0)
 ;
"RTN","LRVRMI4",91,0)
 ; Store code system references
"RTN","LRVRMI4",92,0)
 I $D(LRCSR) D CSR(.LRCSR,.LRFDAIEN,LRDFN_",MI,"_LRIDT_",2,")
"RTN","LRVRMI4",93,0)
 ;
"RTN","LRVRMI4",94,0)
 K LRFDA,LRIENS,LRMSG,DIERR
"RTN","LRVRMI4",95,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI4",96,0)
 S LRFDA(2,63.05,LRIEN,11)=LRNOW
"RTN","LRVRMI4",97,0)
 S LRFDA(2,63.05,LRIEN,11.55)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI4",98,0)
 D FILE^DIE("","LRFDA(2)","LRMSG")
"RTN","LRVRMI4",99,0)
 S LRRPTAPP=1
"RTN","LRVRMI4",100,0)
 Q
"RTN","LRVRMI4",101,0)
 ;
"RTN","LRVRMI4",102,0)
 ;
"RTN","LRVRMI4",103,0)
N4 ; Bact report remarks
"RTN","LRVRMI4",104,0)
 N DIERR,IEN,LRCMT,LRCSR,LRFDA,LRFDAIEN,LRIEN,LRIENS,LRMSG,LRPL,LRX
"RTN","LRVRMI4",105,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,0))
"RTN","LRVRMI4",106,0)
 D BLDSTAT^LRVRMI4A(63.05,11.5,$P(LRX,"^",4),.LRSTATUS)
"RTN","LRVRMI4",107,0)
 S LRPL=$P(LRX,"^")
"RTN","LRVRMI4",108,0)
 M LRCMT=^LR(LRDFN,"MI",LRIDT,4)
"RTN","LRVRMI4",109,0)
 ;
"RTN","LRVRMI4",110,0)
 S IEN=0
"RTN","LRVRMI4",111,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,IEN)) Q:IEN<1  D  ;
"RTN","LRVRMI4",112,0)
 . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
"RTN","LRVRMI4",113,0)
 . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
"RTN","LRVRMI4",114,0)
 . S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI4",115,0)
 . S LRFDA(4,63.33,LRIEN,.01)=LRX
"RTN","LRVRMI4",116,0)
 . I $P(LRX,"^",3) S LRCSR(IEN,2,"LN")=$P(LRX,"^",3)
"RTN","LRVRMI4",117,0)
 . I $P(LRX,"^",4) S LRCSR(IEN,2,"NLT")=$P(LRX,"^",4)
"RTN","LRVRMI4",118,0)
 I '$D(LRFDA) Q
"RTN","LRVRMI4",119,0)
 ;
"RTN","LRVRMI4",120,0)
 D UPDATE^DIE("","LRFDA(4)","LRFDAIEN","LRMSG")
"RTN","LRVRMI4",121,0)
 ;
"RTN","LRVRMI4",122,0)
 ; Store performing lab
"RTN","LRVRMI4",123,0)
 S IEN=0
"RTN","LRVRMI4",124,0)
 F  S IEN=$O(LRFDAIEN(IEN)) Q:'IEN  I LRPL D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",4,"_LRFDAIEN(IEN),LRPL)
"RTN","LRVRMI4",125,0)
 ;
"RTN","LRVRMI4",126,0)
 ; Store code system references
"RTN","LRVRMI4",127,0)
 I $D(LRCSR) D CSR(.LRCSR,.LRFDAIEN,LRDFN_",MI,"_LRIDT_",4,")
"RTN","LRVRMI4",128,0)
 ;
"RTN","LRVRMI4",129,0)
 K LRFDA,LRIENS,LRMSG,DIERR
"RTN","LRVRMI4",130,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI4",131,0)
 S LRFDA(4,63.05,LRIEN,11)=LRNOW
"RTN","LRVRMI4",132,0)
 S LRFDA(4,63.05,LRIEN,11.5)=$P($G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,0)),U,4)
"RTN","LRVRMI4",133,0)
 S LRFDA(4,63.05,LRIEN,11.55)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI4",134,0)
 D FILE^DIE("","LRFDA(4)","LRMSG")
"RTN","LRVRMI4",135,0)
 S LRRPTAPP=1
"RTN","LRVRMI4",136,0)
 Q
"RTN","LRVRMI4",137,0)
 ;
"RTN","LRVRMI4",138,0)
 ;
"RTN","LRVRMI4",139,0)
N99 ; Comment on specimen
"RTN","LRVRMI4",140,0)
 N LRDATA,LRFDA,LRMSG,LRX
"RTN","LRVRMI4",141,0)
 S LRDATA=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,99))
"RTN","LRVRMI4",142,0)
 Q:$TR(LRDATA," ","")=""  ; don't file empty comments
"RTN","LRVRMI4",143,0)
 ; Don't file same comment
"RTN","LRVRMI4",144,0)
 I LRDATA=$G(^LR(LRDFN,"MI",LRIDT,99)) Q
"RTN","LRVRMI4",145,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI4",146,0)
 S LRFDA(99,63.05,LRIEN,.99)=LRDATA
"RTN","LRVRMI4",147,0)
 D FILE^DIE("","LRFDA(99)","LRMSG")
"RTN","LRVRMI4",148,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,99,0))
"RTN","LRVRMI4",149,0)
 I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",99",$P(LRX,"^"))
"RTN","LRVRMI4",150,0)
 Q
"RTN","LRVRMI4",151,0)
 ;
"RTN","LRVRMI4",152,0)
 ;
"RTN","LRVRMI4",153,0)
AUDTRG ; Trigger the audit trail
"RTN","LRVRMI4",154,0)
 N LRDATA,LRMODE,LRBATCH
"RTN","LRVRMI4",155,0)
 S LRMODE="LDSI",LRBATCH=1
"RTN","LRVRMI4",156,0)
 S LRDATA(63.539,1)=LRNOW
"RTN","LRVRMI4",157,0)
 S LRDATA(63.539,3)=$S($G(LRSTATUS(0))'="C":1,1:3)
"RTN","LRVRMI4",158,0)
 I LRINTYPE=1 S LRDATA(63.539,4)="Update from lab automated instrument via HL7"
"RTN","LRVRMI4",159,0)
 I LRINTYPE=10 S LRDATA(63.539,4)="Update from performing lab via HL7"
"RTN","LRVRMI4",160,0)
 D LEDI^LRMIAUD(.LRDATA)
"RTN","LRVRMI4",161,0)
 Q
"RTN","LRVRMI4",162,0)
 ;
"RTN","LRVRMI4",163,0)
 ;
"RTN","LRVRMI4",164,0)
CSR(LRCSR,LRFDAIEN,LRREF) ; Store code system references
"RTN","LRVRMI4",165,0)
 ; Call with LRCSR = array of ien/codes to store as references (pass by value)
"RTN","LRVRMI4",166,0)
 ;        LRFDAIEN = FileMan array of entries added by DBA call (pass by value)
"RTN","LRVRMI4",167,0)
 ;           LRREF = root of reference to build full reference to data
"RTN","LRVRMI4",168,0)
 ;
"RTN","LRVRMI4",169,0)
 N IEN,LRDATA,LRDATAREF,LRDFN,LRROOT,ROLE,TYPE
"RTN","LRVRMI4",170,0)
 ;
"RTN","LRVRMI4",171,0)
 S LRROOT="LRCSR",LRDFN=$P(LRREF,",")
"RTN","LRVRMI4",172,0)
 F  S LRROOT=$Q(@LRROOT) Q:LRROOT=""  D
"RTN","LRVRMI4",173,0)
 . S IEN=$QS(LRROOT,1),ROLE=$QS(LRROOT,2),TYPE=$QS(LRROOT,3)
"RTN","LRVRMI4",174,0)
 . I '$G(LRFDAIEN(IEN)) Q
"RTN","LRVRMI4",175,0)
 . S LRDATAREF=LRREF_LRFDAIEN(IEN)
"RTN","LRVRMI4",176,0)
 . S LRDATA(.01)=LRDATAREF,LRDATA(.02)=ROLE,LRDATA(.03)=LRCSR(IEN,ROLE,TYPE),LRDATA(.04)=TYPE
"RTN","LRVRMI4",177,0)
 . D SETREF^LRUCSR(LRDFN,LRDATAREF,.LRDATA,1)
"RTN","LRVRMI4",178,0)
 Q
"RTN","LRVRMI4A")
0^9^B96274363
"RTN","LRVRMI4A",1,0)
LRVRMI4A ;DALOI/STAFF - LAH/TMP TO FILE 63 ;11/27/12  18:17
"RTN","LRVRMI4A",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRVRMI4A",3,0)
 ;
"RTN","LRVRMI4A",4,0)
 ; Reference to global ^DD(filenumber,"GL") supported by ICR 999
"RTN","LRVRMI4A",5,0)
 ; Extracts the information in the ^TMP("LRMI",$J) global and stores it into the Lab Data micro subfile.
"RTN","LRVRMI4A",6,0)
 ;
"RTN","LRVRMI4A",7,0)
 Q
"RTN","LRVRMI4A",8,0)
 ;
"RTN","LRVRMI4A",9,0)
N3 ;Process Organism
"RTN","LRVRMI4A",10,0)
 ;
"RTN","LRVRMI4A",11,0)
 N DIERR,IEN,LRFDA,LRIEN,LRIENS,LRMSG
"RTN","LRVRMI4A",12,0)
 ;
"RTN","LRVRMI4A",13,0)
 ;ZEXCEPT: LRDFN,LRDUZ,LRIDT,LRNOW,LRRPTAPP
"RTN","LRVRMI4A",14,0)
 ;
"RTN","LRVRMI4A",15,0)
 S IEN=0
"RTN","LRVRMI4A",16,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN)) Q:IEN<1  D N3A
"RTN","LRVRMI4A",17,0)
 ;
"RTN","LRVRMI4A",18,0)
 K LRFDA,LRIENS,LRMSG,DIERR
"RTN","LRVRMI4A",19,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI4A",20,0)
 S LRFDA(3,63.05,LRIEN,11)=LRNOW
"RTN","LRVRMI4A",21,0)
 S LRFDA(3,63.05,LRIEN,11.55)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI4A",22,0)
 D FILE^DIE("","LRFDA(3)","LRMSG")
"RTN","LRVRMI4A",23,0)
 S LRRPTAPP=1
"RTN","LRVRMI4A",24,0)
 Q
"RTN","LRVRMI4A",25,0)
 ;
"RTN","LRVRMI4A",26,0)
 ;
"RTN","LRVRMI4A",27,0)
N3A ; Process each organism
"RTN","LRVRMI4A",28,0)
 ;
"RTN","LRVRMI4A",29,0)
 N DATA,DIERR,DNFLDS,FLD,I,IEN2,ISOID
"RTN","LRVRMI4A",30,0)
 N LRCSR,LRCMT,LRDATA,LRFDA,LRI,LRIEN,LRIENS,LRMSG,LRN3,LRX,R633,STAT
"RTN","LRVRMI4A",31,0)
 ;
"RTN","LRVRMI4A",32,0)
 ; ZEXCEPT: IEN,LRDFN,LRIDT,LRLL,LRPROF,LRSTATUS
"RTN","LRVRMI4A",33,0)
 ;
"RTN","LRVRMI4A",34,0)
 S LRN3=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,0))
"RTN","LRVRMI4A",35,0)
 Q:LRN3=""
"RTN","LRVRMI4A",36,0)
 S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,.1))
"RTN","LRVRMI4A",37,0)
 Q:ISOID=""
"RTN","LRVRMI4A",38,0)
 ;
"RTN","LRVRMI4A",39,0)
 ; Delete ISOID entry if it exists
"RTN","LRVRMI4A",40,0)
 S R633=$O(^LR(LRDFN,"MI",LRIDT,3,"C",ISOID,0))
"RTN","LRVRMI4A",41,0)
 I R633 D
"RTN","LRVRMI4A",42,0)
 . K LRFDA,LRMSG
"RTN","LRVRMI4A",43,0)
 . S LRIEN=R633_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI4A",44,0)
 . S LRFDA(3,63.3,LRIEN,.01)="@"
"RTN","LRVRMI4A",45,0)
 . D FILE^DIE("","LRFDA(3)","LRMSG")
"RTN","LRVRMI4A",46,0)
 ; existing ISOID was deleted so always add record
"RTN","LRVRMI4A",47,0)
 ;
"RTN","LRVRMI4A",48,0)
 S LRIEN="+1,"_LRIDT_","_LRDFN_","
"RTN","LRVRMI4A",49,0)
 S LRFDA(3,63.3,LRIEN,.01)=$P(LRN3,U)
"RTN","LRVRMI4A",50,0)
 S LRFDA(3,63.3,LRIEN,.1)=ISOID
"RTN","LRVRMI4A",51,0)
 S LRFDA(3,63.3,LRIEN,1)=$P(LRN3,U,2)
"RTN","LRVRMI4A",52,0)
 D UPDATE^DIE("","LRFDA(3)","LRIENS","LRMSG")
"RTN","LRVRMI4A",53,0)
 S R633=$G(LRIENS(1))
"RTN","LRVRMI4A",54,0)
 Q:'R633
"RTN","LRVRMI4A",55,0)
 ;
"RTN","LRVRMI4A",56,0)
 ; Store code system references
"RTN","LRVRMI4A",57,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,0,.01))
"RTN","LRVRMI4A",58,0)
 F LRI=1:1:3 I $P(LRX,"^",LRI) D
"RTN","LRVRMI4A",59,0)
 . N LRDATA
"RTN","LRVRMI4A",60,0)
 . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",3,"_R633_",0"
"RTN","LRVRMI4A",61,0)
 . S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
"RTN","LRVRMI4A",62,0)
 . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
"RTN","LRVRMI4A",63,0)
 ;
"RTN","LRVRMI4A",64,0)
 ; Store performing lab
"RTN","LRVRMI4A",65,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,0,.01,1))
"RTN","LRVRMI4A",66,0)
 I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",3,"_R633_",0",$P(LRX,"^"))
"RTN","LRVRMI4A",67,0)
 ;
"RTN","LRVRMI4A",68,0)
 S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,0,.01,0))
"RTN","LRVRMI4A",69,0)
 S STAT=$P(STAT,U,1)
"RTN","LRVRMI4A",70,0)
 D BLDSTAT(63.05,11.5,STAT,.LRSTATUS)
"RTN","LRVRMI4A",71,0)
 ;
"RTN","LRVRMI4A",72,0)
 ; Process organism comments
"RTN","LRVRMI4A",73,0)
 K LRFDA,LRIENS,LRMSG,DIERR
"RTN","LRVRMI4A",74,0)
 M LRCMT=^LR(LRDFN,"MI",LRIDT,3,IEN,1)
"RTN","LRVRMI4A",75,0)
 S IEN2=0
"RTN","LRVRMI4A",76,0)
 F  S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,1,IEN2)) Q:'IEN2  D
"RTN","LRVRMI4A",77,0)
 . S DATA=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,1,IEN2,0),DATA=$S(DATA'="":DATA,1:" ")
"RTN","LRVRMI4A",78,0)
 . I DATA'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,DATA) Q
"RTN","LRVRMI4A",79,0)
 . S LRIEN="+"_IEN2_","_R633_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI4A",80,0)
 . S LRFDA(3,63.31,LRIEN,.01)=DATA
"RTN","LRVRMI4A",81,0)
 I $D(LRFDA) D UPDATE^DIE("","LRFDA(3)","","LRMSG")
"RTN","LRVRMI4A",82,0)
 ;
"RTN","LRVRMI4A",83,0)
 ; Add drug susceptibilities
"RTN","LRVRMI4A",84,0)
 S IEN2=2
"RTN","LRVRMI4A",85,0)
 K LRFDA,LRIENS,LRMSG,DIERR
"RTN","LRVRMI4A",86,0)
 F  S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,IEN2)) Q:'IEN2  D
"RTN","LRVRMI4A",87,0)
 . S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,IEN2,.01,0))
"RTN","LRVRMI4A",88,0)
 . S STAT=$P(STAT,U,1)
"RTN","LRVRMI4A",89,0)
 . D BLDSTAT(63.05,11.5,STAT,.LRSTATUS)
"RTN","LRVRMI4A",90,0)
 . S LRIEN=R633_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI4A",91,0)
 . S DATA=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,IEN2)
"RTN","LRVRMI4A",92,0)
 . S DNFLDS=$$DN2FLDS(IEN2,,3)
"RTN","LRVRMI4A",93,0)
 . F I=1:1:3 D  ;
"RTN","LRVRMI4A",94,0)
 . . S FLD=$P(DNFLDS,"^",I)
"RTN","LRVRMI4A",95,0)
 . . Q:'FLD
"RTN","LRVRMI4A",96,0)
 . . S LRFDA(3,63.3,LRIEN,FLD)=$P(DATA,U,I)
"RTN","LRVRMI4A",97,0)
 . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,IEN2,.01))
"RTN","LRVRMI4A",98,0)
 . F I=1:1:3 I $P(LRX,"^",I) S LRCSR(IEN2_";1",$S(I<3:2,1:3),$P("LN^NLT^SCT","^",I))=$P(LRX,"^",I)
"RTN","LRVRMI4A",99,0)
 ; File susceptibilities
"RTN","LRVRMI4A",100,0)
 I $D(LRFDA) D FILE^DIE("","LRFDA(3)","LRMSG")
"RTN","LRVRMI4A",101,0)
 ;
"RTN","LRVRMI4A",102,0)
 ; Store code system references
"RTN","LRVRMI4A",103,0)
 I $D(LRCSR) D CSR(.LRCSR,LRDFN_",MI,"_LRIDT_",3,"_IEN_",")
"RTN","LRVRMI4A",104,0)
 ;
"RTN","LRVRMI4A",105,0)
 Q
"RTN","LRVRMI4A",106,0)
 ;
"RTN","LRVRMI4A",107,0)
 ;
"RTN","LRVRMI4A",108,0)
N6 ; Process Parasite
"RTN","LRVRMI4A",109,0)
 ;
"RTN","LRVRMI4A",110,0)
 N DIERR,IEN,LRFDA,LRIEN,LRIENS,LRMSG
"RTN","LRVRMI4A",111,0)
 ;
"RTN","LRVRMI4A",112,0)
 ;ZEXCEPT: LRDFN,LRDUZ,LRIDT,LRLL,LRNOW,LRPROF,LRRPTAPP,LRSTATUS
"RTN","LRVRMI4A",113,0)
 ;
"RTN","LRVRMI4A",114,0)
 S IEN=0
"RTN","LRVRMI4A",115,0)
 F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN)) Q:IEN<1  D N6A
"RTN","LRVRMI4A",116,0)
 ;
"RTN","LRVRMI4A",117,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRVRMI4A",118,0)
 S LRFDA(6,63.05,LRIEN,14)=LRNOW
"RTN","LRVRMI4A",119,0)
 S LRFDA(6,63.05,LRIEN,15.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
"RTN","LRVRMI4A",120,0)
 D FILE^DIE("","LRFDA(6)","LRMSG")
"RTN","LRVRMI4A",121,0)
 S LRRPTAPP=1
"RTN","LRVRMI4A",122,0)
 Q
"RTN","LRVRMI4A",123,0)
 ;
"RTN","LRVRMI4A",124,0)
 ;
"RTN","LRVRMI4A",125,0)
N6A ; Process individual parasite result
"RTN","LRVRMI4A",126,0)
 ;
"RTN","LRVRMI4A",127,0)
 N DIERR,IEN2,ISOID,LRFDA,LRI,LRIEN,LRIENS,LRMSG,LRN6,LRX,R6334,STAT
"RTN","LRVRMI4A",128,0)
 ;
"RTN","LRVRMI4A",129,0)
 ;ZEXCEPT: LRDFN,LRIDT,LRSTATUS,IEN
"RTN","LRVRMI4A",130,0)
 ;
"RTN","LRVRMI4A",131,0)
 S LRN6=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,0))
"RTN","LRVRMI4A",132,0)
 Q:LRN6=""
"RTN","LRVRMI4A",133,0)
 S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,.1))
"RTN","LRVRMI4A",134,0)
 Q:ISOID=""
"RTN","LRVRMI4A",135,0)
 ; Delete ISOID if it exists
"RTN","LRVRMI4A",136,0)
 S R6334=$O(^LR(LRDFN,"MI",LRIDT,6,"C",ISOID,0))
"RTN","LRVRMI4A",137,0)
 I R6334 D
"RTN","LRVRMI4A",138,0)
 . K LRFDA,LRMSG,LRIENS,DIERR
"RTN","LRVRMI4A",139,0)
 . S LRIEN=R6334_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI4A",140,0)
 . S LRFDA(6,63.34,LRIEN,.01)="@"
"RTN","LRVRMI4A",141,0)
 . D FILE^DIE("","LRFDA(6)","LRMSG")
"RTN","LRVRMI4A",142,0)
 ;
"RTN","LRVRMI4A",143,0)
 K LRFDA,LRMSG,LRIENS,DIERR
"RTN","LRVRMI4A",144,0)
 S LRIEN="+1,"_LRIDT_","_LRDFN_","
"RTN","LRVRMI4A",145,0)
 S LRFDA(6,63.34,LRIEN,.01)=LRN6
"RTN","LRVRMI4A",146,0)
 S LRFDA(6,63.34,LRIEN,.1)=ISOID
"RTN","LRVRMI4A",147,0)
 D UPDATE^DIE("","LRFDA(6)","LRIENS","LRMSG")
"RTN","LRVRMI4A",148,0)
 S R6334=$G(LRIENS(1))
"RTN","LRVRMI4A",149,0)
 Q:'R6334
"RTN","LRVRMI4A",150,0)
 ;
"RTN","LRVRMI4A",151,0)
 ; Store code system references
"RTN","LRVRMI4A",152,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,0,.01))
"RTN","LRVRMI4A",153,0)
 F LRI=1:1:3 I $P(LRX,"^",LRI) D
"RTN","LRVRMI4A",154,0)
 . N LRDATA
"RTN","LRVRMI4A",155,0)
 . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",6,"_IEN_",0"
"RTN","LRVRMI4A",156,0)
 . S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
"RTN","LRVRMI4A",157,0)
 . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
"RTN","LRVRMI4A",158,0)
 ;
"RTN","LRVRMI4A",159,0)
 ; Store performing lab
"RTN","LRVRMI4A",160,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,0,.01,1))
"RTN","LRVRMI4A",161,0)
 I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",6,"_R6334_",0",$P(LRX,"^"))
"RTN","LRVRMI4A",162,0)
 ;
"RTN","LRVRMI4A",163,0)
 S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,0,.01,0))
"RTN","LRVRMI4A",164,0)
 S STAT=$P(STAT,U,1)
"RTN","LRVRMI4A",165,0)
 D BLDSTAT(63.05,15,STAT,.LRSTATUS)
"RTN","LRVRMI4A",166,0)
 ;
"RTN","LRVRMI4A",167,0)
 ; Stage results
"RTN","LRVRMI4A",168,0)
 K LRFDA,LRMSG,LRIENS,DIERR
"RTN","LRVRMI4A",169,0)
 S IEN2=0
"RTN","LRVRMI4A",170,0)
 F  S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2)) Q:'IEN2  D N6B
"RTN","LRVRMI4A",171,0)
 ;
"RTN","LRVRMI4A",172,0)
 Q
"RTN","LRVRMI4A",173,0)
 ;
"RTN","LRVRMI4A",174,0)
 ;
"RTN","LRVRMI4A",175,0)
N6B ; Process Parasite Stage results
"RTN","LRVRMI4A",176,0)
 ;
"RTN","LRVRMI4A",177,0)
 N DATA,DIERR,IEN3,LRCMT,LRCSR,LRFDA,LRI,LRIEN,LRIENS,LRMSG,LRPL,LRX,R6335,STAGE,STAT
"RTN","LRVRMI4A",178,0)
 ;
"RTN","LRVRMI4A",179,0)
 ;ZEXCEPT: ISOID,LRDFN,LRIDT,LRLL,LRPROF,IEN,IEN2,LRSTATUS,R6334
"RTN","LRVRMI4A",180,0)
 ;
"RTN","LRVRMI4A",181,0)
 ; Delete STAGE if it exists
"RTN","LRVRMI4A",182,0)
 S STAGE=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,0))
"RTN","LRVRMI4A",183,0)
 S STAGE=$P(STAGE,U,1)
"RTN","LRVRMI4A",184,0)
 S R6335=$O(^LR(LRDFN,"MI",LRIDT,6,IEN,1,"B",ISOID,0))
"RTN","LRVRMI4A",185,0)
 I R6335 D
"RTN","LRVRMI4A",186,0)
 . K LRFDA,LRMSG,LRIENS,DIERR
"RTN","LRVRMI4A",187,0)
 . S LRIEN=R6335_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI4A",188,0)
 . S LRFDA(6,63.35,LRIEN,.01)="@"
"RTN","LRVRMI4A",189,0)
 . D FILE^DIE("","LRFDA(6)","LRMSG")
"RTN","LRVRMI4A",190,0)
 ;
"RTN","LRVRMI4A",191,0)
 K LRFDA,LRMSG,LRIENS,DIERR
"RTN","LRVRMI4A",192,0)
 S LRIEN="+"_IEN2_","_R6334_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI4A",193,0)
 S DATA=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,0))
"RTN","LRVRMI4A",194,0)
 S LRFDA(6,63.35,LRIEN,.01)=$P(DATA,U,1) ;stage
"RTN","LRVRMI4A",195,0)
 S LRFDA(6,63.35,LRIEN,1)=$P(DATA,U,2) ;qty
"RTN","LRVRMI4A",196,0)
 D UPDATE^DIE("","LRFDA(6)","LRIENS","LRMSG")
"RTN","LRVRMI4A",197,0)
 ;
"RTN","LRVRMI4A",198,0)
 S R6335=$G(LRIENS(IEN2))
"RTN","LRVRMI4A",199,0)
 Q:'R6335
"RTN","LRVRMI4A",200,0)
 S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,0,.01,0))
"RTN","LRVRMI4A",201,0)
 S STAT=$P(STAT,U,1)
"RTN","LRVRMI4A",202,0)
 ;
"RTN","LRVRMI4A",203,0)
 ; Store code system references for stage
"RTN","LRVRMI4A",204,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,.01))
"RTN","LRVRMI4A",205,0)
 F LRI=1:1:3 I $P(LRX,"^",LRI) D
"RTN","LRVRMI4A",206,0)
 . N LRDATA
"RTN","LRVRMI4A",207,0)
 . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",6,"_R6334_",1,"_R6335_",0;1"
"RTN","LRVRMI4A",208,0)
 . S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
"RTN","LRVRMI4A",209,0)
 . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
"RTN","LRVRMI4A",210,0)
 ;
"RTN","LRVRMI4A",211,0)
 ; Store code system references for quantity
"RTN","LRVRMI4A",212,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,1))
"RTN","LRVRMI4A",213,0)
 F LRI=1:1:3 I $P(LRX,"^",LRI) D
"RTN","LRVRMI4A",214,0)
 . N LRDATA
"RTN","LRVRMI4A",215,0)
 . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",6,"_R6334_",1,"_R6335_",0;2"
"RTN","LRVRMI4A",216,0)
 . S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
"RTN","LRVRMI4A",217,0)
 . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
"RTN","LRVRMI4A",218,0)
 ;
"RTN","LRVRMI4A",219,0)
 ; Store performing lab
"RTN","LRVRMI4A",220,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",6,IEN,1,IEN2,0,.01,1))
"RTN","LRVRMI4A",221,0)
 I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",6,"_R6334_",1,"_R6335_",0",$P(LRX,"^"))
"RTN","LRVRMI4A",222,0)
 ;
"RTN","LRVRMI4A",223,0)
 D BLDSTAT(63.05,15,STAT,.LRSTATUS)
"RTN","LRVRMI4A",224,0)
 ;
"RTN","LRVRMI4A",225,0)
 ; get stage comments
"RTN","LRVRMI4A",226,0)
 K LRFDA,LRMSG,LRIENS,DIERR
"RTN","LRVRMI4A",227,0)
 M LRCMT=^LR(LRDFN,"MI",LRIDT,6,IEN,1,IEN2,1)
"RTN","LRVRMI4A",228,0)
 S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,1,0))
"RTN","LRVRMI4A",229,0)
 S STAT=$P(LRX,U,4)
"RTN","LRVRMI4A",230,0)
 D BLDSTAT(63.05,15,STAT,.LRSTATUS)
"RTN","LRVRMI4A",231,0)
 S IEN3=0
"RTN","LRVRMI4A",232,0)
 F  S IEN3=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,1,IEN3)) Q:IEN3<1  D
"RTN","LRVRMI4A",233,0)
 . S DATA=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,1,IEN3,0)),DATA=$S(DATA'="":DATA,1:" ")
"RTN","LRVRMI4A",234,0)
 . I DATA'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,DATA) Q
"RTN","LRVRMI4A",235,0)
 . S LRIEN="+"_IEN3_","_R6335_","_R6334_","_LRIDT_","_LRDFN_","
"RTN","LRVRMI4A",236,0)
 . S LRFDA(6,63.351,LRIEN,.01)=DATA
"RTN","LRVRMI4A",237,0)
 . I $P(LRX,"^") S LRPL(IEN3)=$P(LRX,"^")
"RTN","LRVRMI4A",238,0)
 . I $P(LRX,"^",3) S LRCSR(IEN3,2,"LN")=$P(LRX,"^",3)
"RTN","LRVRMI4A",239,0)
 ;
"RTN","LRVRMI4A",240,0)
 I '$D(LRFDA) Q
"RTN","LRVRMI4A",241,0)
 ;
"RTN","LRVRMI4A",242,0)
 D UPDATE^DIE("","LRFDA(6)","LRIENS","LRMSG")
"RTN","LRVRMI4A",243,0)
 ;
"RTN","LRVRMI4A",244,0)
 ; Store performing lab
"RTN","LRVRMI4A",245,0)
 S IEN3=0
"RTN","LRVRMI4A",246,0)
 F  S IEN3=$O(LRPL(IEN3)) Q:'IEN3  I $G(LRIENS(IEN3)) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",6,"_LRIENS(IEN3),LRPL(IEN3))
"RTN","LRVRMI4A",247,0)
 ;
"RTN","LRVRMI4A",248,0)
 ; Store code system references
"RTN","LRVRMI4A",249,0)
 I $D(LRCSR) D CSR^LRVRMI4(.LRCSR,.LRIENS,LRDFN_",MI,"_LRIDT_",6,")
"RTN","LRVRMI4A",250,0)
 Q
"RTN","LRVRMI4A",251,0)
 ;
"RTN","LRVRMI4A",252,0)
 ;
"RTN","LRVRMI4A",253,0)
DN2FLDS(DN,FN,SUB) ;
"RTN","LRVRMI4A",254,0)
 ; Convert a drug node to a field number
"RTN","LRVRMI4A",255,0)
 ;File ^DD(filenumber,"GL")/999
"RTN","LRVRMI4A",256,0)
 ; Inputs
"RTN","LRVRMI4A",257,0)
 ;   DN : Drug Node (ie 2.0003)
"RTN","LRVRMI4A",258,0)
 ;   FN : <opt> File Number (ie 63.3)
"RTN","LRVRMI4A",259,0)
 ;  SUB : <opt> Subscript (ie 3)
"RTN","LRVRMI4A",260,0)
 ;       : Note: either FN or SUB must be supplied
"RTN","LRVRMI4A",261,0)
 ; Output
"RTN","LRVRMI4A",262,0)
 ;   The three associated field numbers for the drug node
"RTN","LRVRMI4A",263,0)
 ;     ie 15^15.1^15.2
"RTN","LRVRMI4A",264,0)
 N FLDS,I,X
"RTN","LRVRMI4A",265,0)
 S DN=$G(DN),FN=$G(FN),SUB=$G(SUB)
"RTN","LRVRMI4A",266,0)
 S FLDS=""
"RTN","LRVRMI4A",267,0)
 I FN="" D  ;
"RTN","LRVRMI4A",268,0)
 . I SUB=3 S FN=63.3
"RTN","LRVRMI4A",269,0)
 . I SUB=6 S FN=63.34
"RTN","LRVRMI4A",270,0)
 . I SUB=9 S FN=63.37
"RTN","LRVRMI4A",271,0)
 . I SUB=12 S FN=63.39
"RTN","LRVRMI4A",272,0)
 . I SUB=17 S FN=63.43
"RTN","LRVRMI4A",273,0)
 I $D(^DD(FN,"GL",DN)) D  ;
"RTN","LRVRMI4A",274,0)
 . F I=1:1:3 S X=$O(^DD(FN,"GL",DN,I,0)) I X S $P(FLDS,"^",I)=X
"RTN","LRVRMI4A",275,0)
 Q FLDS
"RTN","LRVRMI4A",276,0)
 ;
"RTN","LRVRMI4A",277,0)
 ;
"RTN","LRVRMI4A",278,0)
BLDSTAT(FN,FLD,STAT,DATA) ;
"RTN","LRVRMI4A",279,0)
 ; Builds the DATA array used for setting status(es)
"RTN","LRVRMI4A",280,0)
 ; Inputs
"RTN","LRVRMI4A",281,0)
 ;   FN : File Number  (ie 63.5)
"RTN","LRVRMI4A",282,0)
 ;  FLD : Field Number  (ie 19)
"RTN","LRVRMI4A",283,0)
 ; STAT : Status  (ie "F")
"RTN","LRVRMI4A",284,0)
 ; DATA <byref> : See Outputs
"RTN","LRVRMI4A",285,0)
 ;
"RTN","LRVRMI4A",286,0)
 ; Outputs
"RTN","LRVRMI4A",287,0)
 ; DATA <byref> : DATA(file#,field#)=status  DATA(63.05,19)="P"
"RTN","LRVRMI4A",288,0)
 ;
"RTN","LRVRMI4A",289,0)
 N CURR
"RTN","LRVRMI4A",290,0)
 I $G(STAT)="" Q
"RTN","LRVRMI4A",291,0)
 I STAT'?1(1"P",1"F",1"C") S STAT="P"
"RTN","LRVRMI4A",292,0)
 S CURR=$G(DATA(FN,FLD))
"RTN","LRVRMI4A",293,0)
 I CURR="" S DATA(FN,FLD)=STAT Q
"RTN","LRVRMI4A",294,0)
 I CURR=STAT Q
"RTN","LRVRMI4A",295,0)
 I CURR="P" Q
"RTN","LRVRMI4A",296,0)
 I CURR="F" D
"RTN","LRVRMI4A",297,0)
 . I STAT="P" S DATA(FN,FLD)="P" Q
"RTN","LRVRMI4A",298,0)
 . I STAT="C" S DATA(FN,FLD)="C" Q
"RTN","LRVRMI4A",299,0)
 Q
"RTN","LRVRMI4A",300,0)
 ;
"RTN","LRVRMI4A",301,0)
 ;
"RTN","LRVRMI4A",302,0)
SETSTAT(DATA) ;
"RTN","LRVRMI4A",303,0)
 ; Goes thru DATA array and files the status(es)
"RTN","LRVRMI4A",304,0)
 ; Inputs
"RTN","LRVRMI4A",305,0)
 ;   DATA <byref> : DATA(file#,field#)=status  ie DATA(63.05,19)="P"
"RTN","LRVRMI4A",306,0)
 ; Outputs
"RTN","LRVRMI4A",307,0)
 ;   DATA <byref> : Sets DATA(0)=overall status (P,F,C)
"RTN","LRVRMI4A",308,0)
 ;
"RTN","LRVRMI4A",309,0)
 N FLD,FN,LRFDA,LRIEN,LRMSG,NODE,STAT,STAT2
"RTN","LRVRMI4A",310,0)
 ;
"RTN","LRVRMI4A",311,0)
 ;ZEXCEPT: LRDFN,LRIDT
"RTN","LRVRMI4A",312,0)
 ;
"RTN","LRVRMI4A",313,0)
 S LRIEN=LRIDT_","_LRDFN_",",STAT2=""
"RTN","LRVRMI4A",314,0)
 S NODE="DATA(0)"
"RTN","LRVRMI4A",315,0)
 F  S NODE=$Q(@NODE) Q:NODE=""  D
"RTN","LRVRMI4A",316,0)
 . S FN=$QS(NODE,1),FLD=$QS(NODE,2)
"RTN","LRVRMI4A",317,0)
 . I 'FN!('FLD) Q
"RTN","LRVRMI4A",318,0)
 . S STAT=DATA(FN,FLD)
"RTN","LRVRMI4A",319,0)
 . ; derive "overall" status
"RTN","LRVRMI4A",320,0)
 . ; P > C > F
"RTN","LRVRMI4A",321,0)
 . I STAT2="" S STAT2=STAT
"RTN","LRVRMI4A",322,0)
 . I STAT="P" S STAT2="P"
"RTN","LRVRMI4A",323,0)
 . I STAT="C",STAT2'="P" S STAT2="C"
"RTN","LRVRMI4A",324,0)
 . I STAT="F",STAT2'="C",STAT2'="P" S STAT2="F"
"RTN","LRVRMI4A",325,0)
 . ;
"RTN","LRVRMI4A",326,0)
 . ;convert "C" to "F"
"RTN","LRVRMI4A",327,0)
 . I STAT="C" S STAT="F"
"RTN","LRVRMI4A",328,0)
 . S LRFDA(1,FN,LRIEN,FLD)=STAT
"RTN","LRVRMI4A",329,0)
 I $D(LRFDA) D FILE^DIE("","LRFDA(1)","LRMSG")
"RTN","LRVRMI4A",330,0)
 S DATA(0)=STAT2
"RTN","LRVRMI4A",331,0)
 Q
"RTN","LRVRMI4A",332,0)
 ;
"RTN","LRVRMI4A",333,0)
 ;
"RTN","LRVRMI4A",334,0)
CSR(LRCSR,LRREF) ; Store code system references
"RTN","LRVRMI4A",335,0)
 ; Call with LRCSR = array of ien/codes to store as references (pass by value)
"RTN","LRVRMI4A",336,0)
 ;           LRREF = root of reference to build full reference to data
"RTN","LRVRMI4A",337,0)
 ;
"RTN","LRVRMI4A",338,0)
 N IEN,LRDATA,LRDATAREF,LRDFN,LRROOT,ROLE,TYPE
"RTN","LRVRMI4A",339,0)
 ;
"RTN","LRVRMI4A",340,0)
 S LRROOT="LRCSR",LRDFN=$P(LRREF,",")
"RTN","LRVRMI4A",341,0)
 F  S LRROOT=$Q(@LRROOT) Q:LRROOT=""  D
"RTN","LRVRMI4A",342,0)
 . S IEN=$QS(LRROOT,1),ROLE=$QS(LRROOT,2),TYPE=$QS(LRROOT,3),LRDATAREF=LRREF_IEN
"RTN","LRVRMI4A",343,0)
 . S LRDATA(.01)=LRDATAREF,LRDATA(.02)=ROLE,LRDATA(.03)=LRCSR(IEN,ROLE,TYPE),LRDATA(.04)=TYPE
"RTN","LRVRMI4A",344,0)
 . D SETREF^LRUCSR(LRDFN,LRDATAREF,.LRDATA,1)
"RTN","LRVRMI4A",345,0)
 Q
"RTN","LRWLST1")
0^2^B81654382
"RTN","LRWLST1",1,0)
LRWLST1 ;DALOI/STAFF - ACCESSION SETUP ;11/20/12  16:10
"RTN","LRWLST1",2,0)
 ;;5.2;LAB SERVICE;**48,65,121,153,261,286,331,379,415,350,427**;Sep 27, 1994;Build 33
"RTN","LRWLST1",3,0)
 ;
"RTN","LRWLST1",4,0)
 S LRWLC=0
"RTN","LRWLST1",5,0)
 F  S LRWLC=$O(LRTSTS(LRWLC)) Q:LRWLC<1  S LRAD=DT D SPLIT
"RTN","LRWLST1",6,0)
 ;
"RTN","LRWLST1",7,0)
 ; If LEDI and comments came with order then copy to order in #69
"RTN","LRWLST1",8,0)
 I $G(LRORDRR)="R",$G(LR696),$D(^LRO(69.6,LR696,99)) D
"RTN","LRWLST1",9,0)
 . N LRDIE
"RTN","LRWLST1",10,0)
 . D WP^DIE(69.01,LRSN_","_LRODT_",",16,"A","^LRO(69.6,LR696,99)","LRDIE(16)")
"RTN","LRWLST1",11,0)
 ;
"RTN","LRWLST1",12,0)
 K DIC,DLAYGO,DR,DA,DIE,LRIXX
"RTN","LRWLST1",13,0)
 Q:$G(LRORDR)="P"
"RTN","LRWLST1",14,0)
 K LRNM,LRTSTS
"RTN","LRWLST1",15,0)
 K ^TMP("LR",$J,"TMP")
"RTN","LRWLST1",16,0)
 Q
"RTN","LRWLST1",17,0)
 ;
"RTN","LRWLST1",18,0)
SPLIT ;
"RTN","LRWLST1",19,0)
 N LRAA,LRX
"RTN","LRWLST1",20,0)
 ; Setup regular accessions (LRUNQ=0)
"RTN","LRWLST1",21,0)
 S LRUNQ=0,LREND=0
"RTN","LRWLST1",22,0)
 I $D(LRTSTS(LRWLC,0)) D
"RTN","LRWLST1",23,0)
 . S LRSS=$P(^LRO(68,LRWLC,0),"^",2)
"RTN","LRWLST1",24,0)
 . D GTWLN
"RTN","LRWLST1",25,0)
 . I LREND Q
"RTN","LRWLST1",26,0)
 . S LRAA=0
"RTN","LRWLST1",27,0)
 . F  S LRAA=$O(LRTSTS(LRWLC,0,LRAA)) Q:LRAA<1  D
"RTN","LRWLST1",28,0)
 . . S LRSS=LRTSTS(LRWLC,0,LRAA)
"RTN","LRWLST1",29,0)
 . . D STWLN,ST2,^LRWLST11,EN^LA7ADL(LRUID)
"RTN","LRWLST1",30,0)
 . D SICA^LRWLST11
"RTN","LRWLST1",31,0)
 ;
"RTN","LRWLST1",32,0)
 ; Setup accessions requiring 'unique' accession numbers (LRUNQ=1)
"RTN","LRWLST1",33,0)
 S LRUNQ=1,LRAA=0
"RTN","LRWLST1",34,0)
 F  S LRAA=$O(LRTSTS(LRWLC,1,LRAA)) Q:LRAA<1  D
"RTN","LRWLST1",35,0)
 . S LRSS=LRTSTS(LRWLC,1,LRAA)
"RTN","LRWLST1",36,0)
 . F  D GTWLN Q:LREND  D   Q:$O(LRTSTS(LRWLC,1,LRAA,0))<1
"RTN","LRWLST1",37,0)
 . . D STWLN,ST2,^LRWLST11,EN^LA7ADL(LRUID),SICA^LRWLST11
"RTN","LRWLST1",38,0)
 Q
"RTN","LRWLST1",39,0)
 ;
"RTN","LRWLST1",40,0)
 ;
"RTN","LRWLST1",41,0)
STWLN ; Set accession number
"RTN","LRWLST1",42,0)
 ;
"RTN","LRWLST1",43,0)
 D GETLOCK(LRAA,LRAD)
"RTN","LRWLST1",44,0)
 D CHECK68(LRAA,LRAD)
"RTN","LRWLST1",45,0)
 ;
"RTN","LRWLST1",46,0)
 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
"RTN","LRWLST1",47,0)
 ;
"RTN","LRWLST1",48,0)
 ; Handle 'in common' area that was not setup in GTWLN call.
"RTN","LRWLST1",49,0)
 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN)) D SETAN(LRAA,LRAD,LRAN)
"RTN","LRWLST1",50,0)
 ;
"RTN","LRWLST1",51,0)
 S LREND=0,LRLBLBP=1-$P(LRSS,U,2),LRSS=$P(LRSS,U)
"RTN","LRWLST1",52,0)
 S LRACC=$P(^LRO(68,LRAA,0),U,11)_" "_$S(LRAD["0000":$E(LRAD,2,3),1:$E(LRAD,4,7))_" "_LRAN
"RTN","LRWLST1",53,0)
 S LRPRAC=""
"RTN","LRWLST1",54,0)
 I $D(^LRO(69,LRODT,1,LRSN,0)) S LRPRAC=$P(^(0),U,6) S:$D(LRNT) ^(3)=LRNT
"RTN","LRWLST1",55,0)
 ;
"RTN","LRWLST1",56,0)
 ; Location type
"RTN","LRWLST1",57,0)
 S LRCAPLOC=$P($G(^SC(+LROLLOC,0)),U,3)
"RTN","LRWLST1",58,0)
 I LRCAPLOC="" S LRCAPLOC="Z"
"RTN","LRWLST1",59,0)
 ;
"RTN","LRWLST1",60,0)
 ; File information in file #68 for this accession
"RTN","LRWLST1",61,0)
 N LRFDA,LR6802,LRDIE
"RTN","LRWLST1",62,0)
 S LR6802=LRAN_","_LRAD_","_LRAA_","
"RTN","LRWLST1",63,0)
 S LRFDA(1,68.02,LR6802,.01)=LRDFN
"RTN","LRWLST1",64,0)
 S LRFDA(1,68.02,LR6802,1)=LRDPF
"RTN","LRWLST1",65,0)
 S LRFDA(1,68.02,LR6802,2)=LRAD
"RTN","LRWLST1",66,0)
 S LRFDA(1,68.02,LR6802,3)=LRODT
"RTN","LRWLST1",67,0)
 S LRFDA(1,68.02,LR6802,4)=LRSN
"RTN","LRWLST1",68,0)
 S LRFDA(1,68.02,LR6802,6)=LRLLOC
"RTN","LRWLST1",69,0)
 S X=$G(^LRO(69,LRODT,1,LRSN,.1)) I X'="" S LRFDA(1,68.02,LR6802,14)=X
"RTN","LRWLST1",70,0)
 ;
"RTN","LRWLST1",71,0)
 ; No ordering provider/location on controls
"RTN","LRWLST1",72,0)
 I LRDPF'=62.3 D
"RTN","LRWLST1",73,0)
 . S LRFDA(1,68.02,LR6802,6.5)=LRPRAC
"RTN","LRWLST1",74,0)
 . S LRFDA(1,68.02,LR6802,94)=LROLLOC
"RTN","LRWLST1",75,0)
 ;
"RTN","LRWLST1",76,0)
 ; Only store treating specialty on file #2 patients
"RTN","LRWLST1",77,0)
 ; If no treating specialty then use specialty from file #44 location
"RTN","LRWLST1",78,0)
 I LRDPF=2 D
"RTN","LRWLST1",79,0)
 . S LRTREA=$P($G(^DPT(DFN,.103)),U)
"RTN","LRWLST1",80,0)
 . I 'LRTREA S LRTREA=$P($G(^SC(+LROLLOC,0)),U,20)
"RTN","LRWLST1",81,0)
 . I LRTREA S LRFDA(1,68.02,LR6802,6.6)=LRTREA
"RTN","LRWLST1",82,0)
 ;
"RTN","LRWLST1",83,0)
 S LRFDA(1,68.02,LR6802,6.7)=DUZ
"RTN","LRWLST1",84,0)
 S LRFDA(1,68.02,LR6802,15)=LRACC
"RTN","LRWLST1",85,0)
 S LRFDA(1,68.02,LR6802,26)=DUZ(2)
"RTN","LRWLST1",86,0)
 S LRFDA(1,68.02,LR6802,92)=LRCAPLOC
"RTN","LRWLST1",87,0)
 D FILE^DIE("","LRFDA(1)","LRDIE(1)")
"RTN","LRWLST1",88,0)
 I $D(LRDIE(1)) D MAILALRT^LRWLST12("STWLN~LRWLST1")
"RTN","LRWLST1",89,0)
 ;
"RTN","LRWLST1",90,0)
 ; If specimen defined then set nodes, force to ien=1 since many lab
"RTN","LRWLST1",91,0)
 ; routines expect the specimen to be record number 1.
"RTN","LRWLST1",92,0)
 I $G(LRSPEC),'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)) D
"RTN","LRWLST1",93,0)
 . N LRFDAIEN,LRLOCKOK,LRLOOPCT
"RTN","LRWLST1",94,0)
 . S LRFDAIEN(1)=1
"RTN","LRWLST1",95,0)
 . S LRFDA(2,68.05,"+1,"_LR6802,.01)=LRSPEC
"RTN","LRWLST1",96,0)
 . S LRFDA(2,68.05,"+1,"_LR6802,1)=$P(LRSAMP,";",1)
"RTN","LRWLST1",97,0)
 . ;
"RTN","LRWLST1",98,0)
 . ; Modification to prevent lock failures - loop 10 times to give system a chance to get lock
"RTN","LRWLST1",99,0)
 . S LRLOCKOK=0
"RTN","LRWLST1",100,0)
 . F LRLOOPCT=1:1:10 D  Q:LRLOCKOK
"RTN","LRWLST1",101,0)
 . . D UPDATE^DIE("","LRFDA(2)","LRFDAIEN","LRDIE(2)")
"RTN","LRWLST1",102,0)
 . . I $G(LRDIE(2,"DIERR")),LRDIE(2,"DIERR",1)<120  H 5 K:LRLOOPCT<10 LRDIE(2)
"RTN","LRWLST1",103,0)
 . . E  S LRLOCKOK=1
"RTN","LRWLST1",104,0)
 . ;
"RTN","LRWLST1",105,0)
 . I $D(LRDIE(2)) D MAILALRT^LRWLST12("STWLN~LRWLST1")
"RTN","LRWLST1",106,0)
 ;
"RTN","LRWLST1",107,0)
 ; If no specimen defined then use specimen values from file #69.
"RTN","LRWLST1",108,0)
 I $G(LRSPEC)="",$D(^LRO(69,LRODT,1,LRSN,4,0)) D
"RTN","LRWLST1",109,0)
 . N LRFDA,LRFDAIEN,LRI,LRX
"RTN","LRWLST1",110,0)
 . S LRI=0
"RTN","LRWLST1",111,0)
 . F  S LRI=$O(^LRO(69,LRODT,1,LRSN,4,LRI)) Q:'LRI  D
"RTN","LRWLST1",112,0)
 . . I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRI,0)) Q
"RTN","LRWLST1",113,0)
 . . S LRFDAIEN(1)=LRI,LRX=$G(^LRO(69,LRODT,1,LRSN,4,LRI,0))
"RTN","LRWLST1",114,0)
 . . S LRFDA(LRI,68.05,"+1,"_LR6802,.01)=$P(LRX,"^")
"RTN","LRWLST1",115,0)
 . . D UPDATE^DIE("","LRFDA(LRI)","LRFDAIEN","LRDIE(LRI)")
"RTN","LRWLST1",116,0)
 . . I $D(LRDIE(LRI)) D MAILALRT^LRWLST12("STWLN~LRWLST1")
"RTN","LRWLST1",117,0)
 ;
"RTN","LRWLST1",118,0)
 ; Create UID.
"RTN","LRWLST1",119,0)
 S LRUID=$$LRUID^LRX(LRAA,LRAD,LRAN)
"RTN","LRWLST1",120,0)
 I '$D(LRPHSET),('$G(LRQUIET)) W !!,"ACCESSION:  ",LRACC,"  <",LRUID,">"
"RTN","LRWLST1",121,0)
 D UPD696
"RTN","LRWLST1",122,0)
 ;
"RTN","LRWLST1",123,0)
 L -^LRO(68,LRAA,1,LRAD,1,0)
"RTN","LRWLST1",124,0)
 Q
"RTN","LRWLST1",125,0)
 ;
"RTN","LRWLST1",126,0)
 ;
"RTN","LRWLST1",127,0)
UPD696 ; Update file #69.6 if LEDI referral patient and no existing entry
"RTN","LRWLST1",128,0)
 K LR696IEN
"RTN","LRWLST1",129,0)
 I $G(LRORDRR)="R" D
"RTN","LRWLST1",130,0)
 . S LR696IEN=0
"RTN","LRWLST1",131,0)
 . I $G(LRRSITE("SMID"))'="",$G(LRSD("RUID"))'="" S LR696IEN=+$O(^LRO(69.6,"AD",LRRSITE("SMID"),LRSD("RUID"),0))
"RTN","LRWLST1",132,0)
 . I LR696IEN Q
"RTN","LRWLST1",133,0)
 . I '$G(LRRSTAT(0)) S LRRSTAT(0)=$$FIND1^DIC(64.061,"","OMX","Specimen in process","","I $P(^LAB(64.061,Y,0),U,7)=""U""")
"RTN","LRWLST1",134,0)
 . D PSET^LRPEND(SSN(2),+LRRSITE("RSITE"),LRSD("RUID"),+LRSD("RPSITE"),LRSPEC,LRSAMP,LRRSTAT(0),LRODT,$P(LRCDT,U),LRRSITE("SDT"),LRNT,.LROT)
"RTN","LRWLST1",135,0)
 Q
"RTN","LRWLST1",136,0)
 ;
"RTN","LRWLST1",137,0)
 ;
"RTN","LRWLST1",138,0)
ST2 ; Find next available node in LR global
"RTN","LRWLST1",139,0)
 ;
"RTN","LRWLST1",140,0)
 N LRFDA,LRFDAIEN,LRDIE,LRX,LRXIDT
"RTN","LRWLST1",141,0)
 ; Autopsy ("AU") is not a multiple - do not attempt to set in ^LR global
"RTN","LRWLST1",142,0)
 I LRSS="AU" S LRIDT=0 Q
"RTN","LRWLST1",143,0)
 ;
"RTN","LRWLST1",144,0)
 S LRIDT=0
"RTN","LRWLST1",145,0)
 F  D  Q:LRIDT
"RTN","LRWLST1",146,0)
 . S LRXIDT=9999999-LRCDT
"RTN","LRWLST1",147,0)
 . L +^LR(LRDFN,LRSS,LRXIDT,0):5
"RTN","LRWLST1",148,0)
 . I '$T S LRCDT=$$FMADD^XLFDT(LRCDT,0,0,0,1) Q
"RTN","LRWLST1",149,0)
 . I '$D(^LR(LRDFN,LRSS,LRXIDT,0)) S LRIDT=LRXIDT Q
"RTN","LRWLST1",150,0)
 . L -^LR(LRDFN,LRSS,LRXIDT,0)
"RTN","LRWLST1",151,0)
 . S LRCDT=$$FMADD^XLFDT(LRCDT,0,0,0,1)
"RTN","LRWLST1",152,0)
 ;
"RTN","LRWLST1",153,0)
 ; Create entry in appropriate subscript in LAB DATA file (#63).
"RTN","LRWLST1",154,0)
 S LRX=$S(LRSS="CH":63.04,LRSS="MI":63.05,LRSS="BB":63.01,LRSS="SP":63.08,LRSS="CY":63.09,LRSS="EM":63.02,1:0)
"RTN","LRWLST1",155,0)
 S LRFDAIEN(1)=LRIDT
"RTN","LRWLST1",156,0)
 S LRFDA(63,LRX,"+1,"_LRDFN_",",.01)=LRCDT
"RTN","LRWLST1",157,0)
 S LRFDA(63,LRX,"+1,"_LRDFN_",",.06)=LRACC
"RTN","LRWLST1",158,0)
 I LRSS'="CH" D
"RTN","LRWLST1",159,0)
 . S LRFDA(63,LRX,"+1,"_LRDFN_",",.1)=LRNT
"RTN","LRWLST1",160,0)
 . S LRFDA(63,LRX,"+1,"_LRDFN_",",.08)=LRLLOC
"RTN","LRWLST1",161,0)
 I LRSS="CH" D
"RTN","LRWLST1",162,0)
 . S LRFDA(63,LRX,"+1,"_LRDFN_",",.12)=3
"RTN","LRWLST1",163,0)
 . S LRFDA(63,LRX,"+1,"_LRDFN_",",.11)=LRLLOC
"RTN","LRWLST1",164,0)
 I LRSS="MI" S LRFDA(63,LRX,"+1,"_LRDFN_",",38)=3
"RTN","LRWLST1",165,0)
 I "SPCYEM"[LRSS N LRABV S LRABV=$P(LRACC," ")
"RTN","LRWLST1",166,0)
 I LRX D UPDATE^DIE("","LRFDA(63)","LRFDAIEN","LRDIE(63)")
"RTN","LRWLST1",167,0)
 I $D(LRDIE(63)) D MAILALRT^LRWLST12("ST2~LRWLST1")
"RTN","LRWLST1",168,0)
 ;
"RTN","LRWLST1",169,0)
 ; Uncomment following code when new field .9 in"MI" subscript is released
"RTN","LRWLST1",170,0)
 ;I LRSS="MI" D
"RTN","LRWLST1",171,0)
 ;. N LRN,ERR,IENS
"RTN","LRWLST1",172,0)
 ;. S IENS=LRIDT_","_LRDFN_",",LRN=0
"RTN","LRWLST1",173,0)
 ;. F  S LRN=$O(^LRO(69,LRODT,1,LRSN,2,LRN)) Q:LRN<1  D
"RTN","LRWLST1",174,0)
 ;. . I '$D(^LRO(69,LRODT,1,LRSN,2,LRN,1,0)) Q
"RTN","LRWLST1",175,0)
 ;. . D WP^DIE(63.05,IENS,.9,"A","^LRO(69,"_LRODT_",1,"_LRSN_",2,"_LRN_",1)","ERR")
"RTN","LRWLST1",176,0)
 ;
"RTN","LRWLST1",177,0)
 L -^LR(LRDFN,LRSS,LRIDT,0)
"RTN","LRWLST1",178,0)
 ;
"RTN","LRWLST1",179,0)
 Q
"RTN","LRWLST1",180,0)
 ;
"RTN","LRWLST1",181,0)
 ;
"RTN","LRWLST1",182,0)
GTWLN ;
"RTN","LRWLST1",183,0)
 N LRABV,X
"RTN","LRWLST1",184,0)
 ;
"RTN","LRWLST1",185,0)
 ; Execute accession transform for this area.
"RTN","LRWLST1",186,0)
 S LRAN=0
"RTN","LRWLST1",187,0)
 S X=$G(^LRO(68,LRWLC,.1)) X:X'="" X
"RTN","LRWLST1",188,0)
 ;
"RTN","LRWLST1",189,0)
 D GETLOCK(LRWLC,LRAD)
"RTN","LRWLST1",190,0)
 D CHECK68(LRWLC,LRAD)
"RTN","LRWLST1",191,0)
 ;
"RTN","LRWLST1",192,0)
 ; note LRSS can at this point can contain two pieces in the variable.
"RTN","LRWLST1",193,0)
 S:'LRAN LRAN=1+$P($G(^LRO(68,LRWLC,1,LRAD,1,0)),U,3)
"RTN","LRWLST1",194,0)
 I $P(LRSS,"^")?1(1"CH",1"MI",1"BB") F  Q:('$D(^LRO(68,LRWLC,1,LRAD,1,LRAN)))&($$ORIGAAOK)  S LRAN=LRAN+1
"RTN","LRWLST1",195,0)
 ;
"RTN","LRWLST1",196,0)
 ; Check for AP Accessions
"RTN","LRWLST1",197,0)
 S LRABV=$P($G(^LRO(68,LRWLC,0)),U,11)
"RTN","LRWLST1",198,0)
 I $P(LRSS,"^")?1(1"SP",1"CY",1"EM",1"AU") F  Q:'$D(^LRO(68,LRWLC,1,LRAD,1,LRAN))&('$D(^LR("A"_$P(LRSS,"^")_"A",$E(LRAD,1,3),LRABV,LRAN)))&($$ORIGAAOK)  S LRAN=LRAN+1
"RTN","LRWLST1",199,0)
 ;
"RTN","LRWLST1",200,0)
 I '$D(LRPHSET),$D(LRNCWL)!$P(^LAB(69.9,1,0),U,8) D ASK Q:LREND
"RTN","LRWLST1",201,0)
 ;
"RTN","LRWLST1",202,0)
 I '$D(^LRO(68,LRWLC,1,LRAD,1,LRAN)) D SETAN(LRWLC,LRAD,LRAN)
"RTN","LRWLST1",203,0)
 L -^LRO(68,LRWLC,1,LRAD,1,0)
"RTN","LRWLST1",204,0)
 Q
"RTN","LRWLST1",205,0)
 ;
"RTN","LRWLST1",206,0)
 ;
"RTN","LRWLST1",207,0)
ORIGAAOK() ; function to determine if the accession number under consideration
"RTN","LRWLST1",208,0)
 ; is already in use in the originating accession area
"RTN","LRWLST1",209,0)
 ;
"RTN","LRWLST1",210,0)
 ; returns 0 -- accession number under consideration already in use
"RTN","LRWLST1",211,0)
 ;         1 -- accession number under consideration is ok to use
"RTN","LRWLST1",212,0)
 ;
"RTN","LRWLST1",213,0)
 N LRAAX,LRAAOK,LRABVX,LRAA0,LRSSX
"RTN","LRWLST1",214,0)
 S LRAAX=0,LRAAOK=1
"RTN","LRWLST1",215,0)
 ;
"RTN","LRWLST1",216,0)
 F  S LRAAX=$O(LRTSTS(LRWLC,LRUNQ,LRAAX)) Q:LRAAX<1  Q:'LRAAOK  D
"RTN","LRWLST1",217,0)
 . I $D(^LRO(68,LRAAX,1,LRAD,1,LRAN)) S LRAAOK=0 Q
"RTN","LRWLST1",218,0)
 . S LRAA0=^LRO(68,LRAAX,0),LRSSX=$P(LRAA0,"^",2)
"RTN","LRWLST1",219,0)
 . I "CYEMSP"[LRSSX D
"RTN","LRWLST1",220,0)
 . . S LRABVX=$P(LRAA0,"^",11)
"RTN","LRWLST1",221,0)
 . . I $D(^LR("A"_LRSSX_"A",$E(LRAD,1,3),LRABVX,LRAN)) S LRAAOK=0
"RTN","LRWLST1",222,0)
 ;
"RTN","LRWLST1",223,0)
 Q LRAAOK
"RTN","LRWLST1",224,0)
 ;
"RTN","LRWLST1",225,0)
 ;
"RTN","LRWLST1",226,0)
ASK ;
"RTN","LRWLST1",227,0)
 ; Don't ask if tasked or a "silent" call
"RTN","LRWLST1",228,0)
 I $D(ZTQUEUED)!($G(LRQUIET)) Q
"RTN","LRWLST1",229,0)
 ;
"RTN","LRWLST1",230,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LROK,LRANX,X,Y
"RTN","LRWLST1",231,0)
 S LROK=0
"RTN","LRWLST1",232,0)
 F  D  Q:LREND!(LROK)
"RTN","LRWLST1",233,0)
 . K DIR
"RTN","LRWLST1",234,0)
 . S DIR(0)="NO^1:"_$S($P(LRLABKY,U,2):999999,1:LRAN)_":0"
"RTN","LRWLST1",235,0)
 . S DIR("A")="Force to",DIR("B")=LRAN
"RTN","LRWLST1",236,0)
 . D ^DIR
"RTN","LRWLST1",237,0)
 . I $D(DIRUT) S LREND=1 Q
"RTN","LRWLST1",238,0)
 . S LRANX=Y
"RTN","LRWLST1",239,0)
 . I LRANX<+$P($G(^LRO(68,LRWLC,1,LRAD,1,0)),U,3) D
"RTN","LRWLST1",240,0)
 . . W !,"This accession number may be already assigned either in this "
"RTN","LRWLST1",241,0)
 . . W !,"area or a common accession area."
"RTN","LRWLST1",242,0)
 . I $D(^LRO(68,LRWLC,1,LRAD,1,LRANX,0)) D  Q:'LROK
"RTN","LRWLST1",243,0)
 . . N LRDFNX S LRDFNX=LRDFN
"RTN","LRWLST1",244,0)
 . . N DFN,LRDFN,LRDPF,PNM,SSN
"RTN","LRWLST1",245,0)
 . . S LRDFN=+^LRO(68,LRWLC,1,LRAD,1,LRANX,0),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^LR(LRDFN,0),U,3)
"RTN","LRWLST1",246,0)
 . . D PT^LRX
"RTN","LRWLST1",247,0)
 . . W !,"THIS NUMBER BELONGS TO ",!,PNM,"     SSN: ",SSN
"RTN","LRWLST1",248,0)
 . . D INF^LRX
"RTN","LRWLST1",249,0)
 . . I LRDFN=LRDFNX S LROK=1
"RTN","LRWLST1",250,0)
 . K DIR
"RTN","LRWLST1",251,0)
 . S DIR(0)="YO",DIR("A")="Are you sure",DIR("B")="NO"
"RTN","LRWLST1",252,0)
 . D ^DIR
"RTN","LRWLST1",253,0)
 . I $D(DIRUT) S LREND=1 Q
"RTN","LRWLST1",254,0)
 . I Y=1 S LRAN=LRANX,LROK=1
"RTN","LRWLST1",255,0)
 ;
"RTN","LRWLST1",256,0)
 ; Unlock if aborting.
"RTN","LRWLST1",257,0)
 I LREND L -^LRO(68,LRWLC,1,LRAD,1,0)
"RTN","LRWLST1",258,0)
 ;
"RTN","LRWLST1",259,0)
 Q
"RTN","LRWLST1",260,0)
 ;
"RTN","LRWLST1",261,0)
 ;
"RTN","LRWLST1",262,0)
CHECK68(LRAA,LRAD) ; Check for/set header node of ^LRO(68) 68.01 subfile.
"RTN","LRWLST1",263,0)
 ;
"RTN","LRWLST1",264,0)
 ; Call with LRAA = ien of entry in file #68
"RTN","LRWLST1",265,0)
 ;           LRAD = accession date in fileman format
"RTN","LRWLST1",266,0)
 ;
"RTN","LRWLST1",267,0)
 ; Set accession date in file #68 for this accession.
"RTN","LRWLST1",268,0)
 ; Check for existence of accession number multiple but not accession date multiple,
"RTN","LRWLST1",269,0)
 ; FileMan DBS call fails when accession number multiple exists but accession date multiple does not.
"RTN","LRWLST1",270,0)
 ; If this condition found then set missing node directly and quit.
"RTN","LRWLST1",271,0)
 ;
"RTN","LRWLST1",272,0)
 I '$D(^LRO(68,LRAA,1,LRAD,0)) D
"RTN","LRWLST1",273,0)
 . N LRFDA,LRFDAIEN,LRDIE,X
"RTN","LRWLST1",274,0)
 . S X=$Q(^LRO(68,LRAA,1,LRAD,0))
"RTN","LRWLST1",275,0)
 . I X'="",$QS(X,4)=LRAD S $P(^LRO(68,LRAA,1,LRAD,0),"^")=LRAD Q
"RTN","LRWLST1",276,0)
 . S (LRFDAIEN(1),LRFDA(1,68.01,"+1,"_LRAA_",",.01))=LRAD
"RTN","LRWLST1",277,0)
 . D UPDATE^DIE("","LRFDA(1)","LRFDAIEN","LRDIE(1)")
"RTN","LRWLST1",278,0)
 . I $D(LRDIE(1)) D MAILALRT^LRWLST12("CHECK~LRWLST1")
"RTN","LRWLST1",279,0)
 ;
"RTN","LRWLST1",280,0)
 Q
"RTN","LRWLST1",281,0)
 ;
"RTN","LRWLST1",282,0)
 ;
"RTN","LRWLST1",283,0)
GETLOCK(LRAA,LRAD) ; Obtain lock on zeroth node of this accession date
"RTN","LRWLST1",284,0)
 ; Call with LRAA = ien of entry in file #68
"RTN","LRWLST1",285,0)
 ;           LRAD = accession date in fileman format
"RTN","LRWLST1",286,0)
 ;
"RTN","LRWLST1",287,0)
 F  L +^LRO(68,LRAA,1,LRAD,1,0):10 Q:$T  D
"RTN","LRWLST1",288,0)
 . I $D(ZTQUEUED)!($G(LRQUIET)) Q
"RTN","LRWLST1",289,0)
 . W !!?5,"Accession area ",$P(^LRO(68,LRAA,0),"^")," is locked by another user.",!,$C(7)
"RTN","LRWLST1",290,0)
 Q
"RTN","LRWLST1",291,0)
 ;
"RTN","LRWLST1",292,0)
 ;
"RTN","LRWLST1",293,0)
SETAN(LRAA,LRAD,LRAN) ; Create stub entry in file #68 for this accession.
"RTN","LRWLST1",294,0)
 ;
"RTN","LRWLST1",295,0)
 ; Call with LRAA = ien of entry in file #68
"RTN","LRWLST1",296,0)
 ;           LRAD = accession date in fileman format
"RTN","LRWLST1",297,0)
 ;           LRAN = accession number
"RTN","LRWLST1",298,0)
 ;
"RTN","LRWLST1",299,0)
 N LR6802,LRFDA,LRFDAIEN,LRDIE,LRLOCKOK,LRLOOPCT
"RTN","LRWLST1",300,0)
 S LR6802=LRAD_","_LRAA_","
"RTN","LRWLST1",301,0)
 S LRFDAIEN(1)=LRAN
"RTN","LRWLST1",302,0)
 S LRFDA(2,68.02,"+1,"_LR6802,.01)=LRDFN
"RTN","LRWLST1",303,0)
 ;
"RTN","LRWLST1",304,0)
 ; Modification to prevent lock failures - loop 10 times to give system a chance to get lock
"RTN","LRWLST1",305,0)
 S LRLOCKOK=0
"RTN","LRWLST1",306,0)
 F LRLOOPCT=1:1:10 D  Q:LRLOCKOK
"RTN","LRWLST1",307,0)
 . D UPDATE^DIE("","LRFDA(2)","LRFDAIEN","LRDIE(2)")
"RTN","LRWLST1",308,0)
 . I $G(LRDIE(2,"DIERR")),LRDIE(2,"DIERR",1)<120  H 5 K:LRLOOPCT<10 LRDIE(2)
"RTN","LRWLST1",309,0)
 . E  S LRLOCKOK=1
"RTN","LRWLST1",310,0)
 ;
"RTN","LRWLST1",311,0)
 I $D(LRDIE(2)) D MAILALRT^LRWLST12("SET~LRWLST1")
"RTN","LRWLST1",312,0)
 Q
"RTN","LRWLST12")
0^47^B67054395
"RTN","LRWLST12",1,0)
LRWLST12 ;DALOI/STAFF - ACCESSION SETUP ;8/19/2013
"RTN","LRWLST12",2,0)
 ;;5.2;LAB SERVICE;**153,201,350,427**;Sep 27, 1994;Build 33
"RTN","LRWLST12",3,0)
 ;
"RTN","LRWLST12",4,0)
 ;
"RTN","LRWLST12",5,0)
CAP ; from LRWLST11,LRTSTJAM
"RTN","LRWLST12",6,0)
 N LRCNT
"RTN","LRWLST12",7,0)
 Q:'($D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))#2)
"RTN","LRWLST12",8,0)
 S:'($D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0))#2) ^(0)="^68.04PA" S $P(^(0),U,3)=+LRTS,$P(^(0),U,4)=1+$P(^(0),U,4)
"RTN","LRWLST12",9,0)
 S:'($D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,0))#2) ^(0)=LRTS,$P(^(0),U,9)=+$G(LRTSORU)
"RTN","LRWLST12",10,0)
 S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",+LRTS,+LRTS)) ^(+LRTS)=""
"RTN","LRWLST12",11,0)
 ;
"RTN","LRWLST12",12,0)
 S:'$G(LRSAMP) LRSAMP=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)),U,2)
"RTN","LRWLST12",13,0)
 ;
"RTN","LRWLST12",14,0)
 I $P(LRPARAM,U,14),$P($G(^LRO(68,+LRAA,0)),U,16) D
"RTN","LRWLST12",15,0)
 . S LRCI=0
"RTN","LRWLST12",16,0)
 . F  S LRCI=$O(^LAB(60,+LRTS,9.1,LRCI)) Q:LRCI<1  I $D(^(LRCI,0)) S X=^(0),LRCNT=$S(+$P(X,U,3):+$P(X,U,3),1:1) D CAP1
"RTN","LRWLST12",17,0)
 I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D
"RTN","LRWLST12",18,0)
 . S LRCI=0
"RTN","LRWLST12",19,0)
 . F  S LRCI=$O(^LAB(62,+LRSAMP,9,LRAA,1,+LRTS,1,LRCI)) Q:LRCI<1  I $D(^(LRCI,0)) S X=^(0),LRCNT=$S(+$P(X,U,3):+$P(X,U,3),1:1) D CAP1
"RTN","LRWLST12",20,0)
 ;
"RTN","LRWLST12",21,0)
 K LRCI,LRCWT,X,C3,C4,C0,LRCI,LRCNT
"RTN","LRWLST12",22,0)
 Q
"RTN","LRWLST12",23,0)
 ;
"RTN","LRWLST12",24,0)
 ;
"RTN","LRWLST12",25,0)
CAP1 ;
"RTN","LRWLST12",26,0)
 S LRT=+LRTS D STUFI^LRCAPV1
"RTN","LRWLST12",27,0)
 K LRT
"RTN","LRWLST12",28,0)
 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,1,0)) S ^(0)="^68.14P^^"
"RTN","LRWLST12",29,0)
 S C0=^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,1,0),C4=$P(C0,U,4)+1,$P(C0,U,3)=LRCI,$P(C0,U,4)=C4,^(0)=C0
"RTN","LRWLST12",30,0)
 ;
"RTN","LRWLST12",31,0)
C3 ;
"RTN","LRWLST12",32,0)
 I '($D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,1,LRCI,0))#2) D
"RTN","LRWLST12",33,0)
 . S:'$D(LRNT) LRNT=$$HTFM^XLFDT($H)
"RTN","LRWLST12",34,0)
 . S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,+LRTS,1,LRCI,0)=LRCI_U_LRCNT_"^^^^"_LRNT_"^.5"_U_DUZ(2)_U_LRAA_U_LRAA_U
"RTN","LRWLST12",35,0)
 Q
"RTN","LRWLST12",36,0)
 ;
"RTN","LRWLST12",37,0)
 ;
"RTN","LRWLST12",38,0)
VMSG ;
"RTN","LRWLST12",39,0)
 N LA7V
"RTN","LRWLST12",40,0)
 S LA7V=""
"RTN","LRWLST12",41,0)
 I $G(LR696IEN),$D(^LRO(69.6,LR696IEN,0))#2 D
"RTN","LRWLST12",42,0)
 . S $P(^LRO(69.6,LR696IEN,0),U,10)=160,LRCNT=0
"RTN","LRWLST12",43,0)
 . F  S LRCNT=$O(LROT(LRSAMP,LRSPEC,LRCNT)) Q:LRCNT<1  I $D(LROT(LRSAMP,LRSPEC,LRCNT,"B",+LRTS))#2 D
"RTN","LRWLST12",44,0)
 . . S LRTSN=LROT(LRSAMP,LRSPEC,LRCNT,"B",+LRTS)
"RTN","LRWLST12",45,0)
 . . I $D(^LRO(69.6,LR696IEN,2,+LRTSN,0)) S $P(^(0),U,7)=LRNT,$P(^(0),U,9)=LRUID,$P(^(0),U,6)=160 D
"RTN","LRWLST12",46,0)
 . . . D SET^LA7VMSG($P(LRORU3,U,4),$P(LRORU3,U,2),$P(LRORU3,U,5),$P(LRORU3,U,3),$P(LRTSN,U,3),$P(LRTSN,U,2),LRIDT,LRSS,LRDFN,LRODT,,"ORR")
"RTN","LRWLST12",47,0)
 ;. D ORR^LA7VMSG ; Update status to in process - need to task this from another place (JMC/27NOV06)
"RTN","LRWLST12",48,0)
 ;
"RTN","LRWLST12",49,0)
 Q
"RTN","LRWLST12",50,0)
 ;
"RTN","LRWLST12",51,0)
 ;
"RTN","LRWLST12",52,0)
ORUT2 ; Update ordered test in file #69.6
"RTN","LRWLST12",53,0)
 ; Called by LRWLST11
"RTN","LRWLST12",54,0)
 N FDA,LRDIE,LRI,LRNLT,LROK,LRSTATUS,LRUPSTAT,LRTST,LRX
"RTN","LRWLST12",55,0)
 S LRNLT=$$NLT^LRVER1(+LRTSORU) Q:+LRNLT<1
"RTN","LRWLST12",56,0)
 S LRTST=$P($G(^LAM($O(^LAM("E",LRNLT,0)),0)),U) Q:LRTST=""!('$G(LR696IEN))
"RTN","LRWLST12",57,0)
 ;Q:'($D(^LRO(69.6,LR696IEN,0))#2)!($D(^LRO(69.6,LR696IEN,2,"C",LRNLT)))
"RTN","LRWLST12",58,0)
 I '$D(^LRO(69.6,LR696IEN,0)) Q
"RTN","LRWLST12",59,0)
 ;
"RTN","LRWLST12",60,0)
 S LRUPSTAT=$$FIND1^DIC(64.061,"","OX","Specimen in process","B","I $P(^LAB(64.061,Y,0),U,7)=""U""")
"RTN","LRWLST12",61,0)
 ; Update existing entry with current status
"RTN","LRWLST12",62,0)
 I $D(^LRO(69.6,LR696IEN,2,"C",LRNLT)) D
"RTN","LRWLST12",63,0)
 . S LRI=$O(^LRO(69.6,LR696IEN,2,"C",LRNLT,0))
"RTN","LRWLST12",64,0)
 . S FDA(1,69.64,LRI_","_LR696IEN_",",5)=LRUPSTAT
"RTN","LRWLST12",65,0)
 . S FDA(1,69.64,LRI_","_LR696IEN_",",8)=LRNT
"RTN","LRWLST12",66,0)
 . S FDA(1,69.64,LRI_","_LR696IEN_",",9)=LRUID
"RTN","LRWLST12",67,0)
 . S FDA(1,69.64,LRI_","_LR696IEN_",",12)=LRURG
"RTN","LRWLST12",68,0)
 . D FILE^DIE("","FDA(1)","LRDIE(1)")
"RTN","LRWLST12",69,0)
 . D CLEAN^DILF
"RTN","LRWLST12",70,0)
 ;
"RTN","LRWLST12",71,0)
 ; JMC/8 Feb 07 - need to rewrite to use FileMan DBS call
"RTN","LRWLST12",72,0)
 ; Create new entry with current status
"RTN","LRWLST12",73,0)
 I '$D(^LRO(69.6,LR696IEN,2,"C",LRNLT)) D
"RTN","LRWLST12",74,0)
 . S:'$D(^LRO(69.6,LR696IEN,2,0)) ^(0)="^69.64A^"
"RTN","LRWLST12",75,0)
 . N DA,DIC,DIE,DLAYGO,DR
"RTN","LRWLST12",76,0)
 . S DLAYGO=69.6,DA=LR696IEN
"RTN","LRWLST12",77,0)
 . S LRURG=$S($L($P($G(^LAB(62.05,+$P(LRTS,U,2),0)),U,4)):$P(^(0),U,4),1:"R")
"RTN","LRWLST12",78,0)
 . S (DIE,DIC)="^LRO(69.6,",DIC(0)="LM"
"RTN","LRWLST12",79,0)
 . S DR=20_"///"_LRTST_";",DR(1,69.6)="20///"_LRTST_";"
"RTN","LRWLST12",80,0)
 . S DR(2,69.64)=".01///"_LRTST_";1///"_LRNLT_";4///"_LRURG_";5////160;8///"_LRNT_";9///"_LRUID
"RTN","LRWLST12",81,0)
 . D ^DIE
"RTN","LRWLST12",82,0)
 ;
"RTN","LRWLST12",83,0)
 ; Check and update specimen status based on test order status
"RTN","LRWLST12",84,0)
 ;  - if specimen status is 'in-transit' then update if all tests have been processed.
"RTN","LRWLST12",85,0)
 S LRX=+$P(^LRO(69.6,LR696IEN,0),U,10),LROK=1,LRSTATUS=""
"RTN","LRWLST12",86,0)
 I LRX S LRSTATUS=$$GET1^DIQ(64.061,LRX_",",.01)
"RTN","LRWLST12",87,0)
 I LRSTATUS="In-Transit" D
"RTN","LRWLST12",88,0)
 . S LRI=0
"RTN","LRWLST12",89,0)
 . F  S LRI=$O(^LRO(69.6,LR696,2,LRI)) Q:'LRI  D  Q:'LROK
"RTN","LRWLST12",90,0)
 . . S X=$P(^LRO(69.6,LR696,2,LRI,0),"^",6) Q:'X
"RTN","LRWLST12",91,0)
 . . I $$GET1^DIQ(64.061,X_",",.01)="In-Transit" S LROK=0
"RTN","LRWLST12",92,0)
 . I 'LROK Q
"RTN","LRWLST12",93,0)
 . I LRSTATUS="" Q
"RTN","LRWLST12",94,0)
 . S FDA(3,69.6,LR696IEN_",",6)=LRUPSTAT
"RTN","LRWLST12",95,0)
 . D FILE^DIE("","FDA(3)","LRDIE(3)")
"RTN","LRWLST12",96,0)
 . D CLEAN^DILF
"RTN","LRWLST12",97,0)
 Q
"RTN","LRWLST12",98,0)
 ;
"RTN","LRWLST12",99,0)
 ;
"RTN","LRWLST12",100,0)
PROVCPY ; Copy remote ordering provider from file #69.6 to ordered test multiple (#.35)
"RTN","LRWLST12",101,0)
 ; Called from LRWLST11
"RTN","LRWLST12",102,0)
 N FDA,LRDIE,LRFILE,LRI,LRPROV,LRX,LRY,LRZ
"RTN","LRWLST12",103,0)
 ;
"RTN","LRWLST12",104,0)
 S LRFILE=$S(LRSS="CH":63.07,LRSS="MI":63.5,LRSS="SP":63.53,LRSS="CY":63.51,LRSS="EM":63.52,1:"")
"RTN","LRWLST12",105,0)
 I LRFILE="" Q
"RTN","LRWLST12",106,0)
 S LRI=0,LRPROV=""
"RTN","LRWLST12",107,0)
 F  S LRI=$O(^LR(LRDFN,LRSS,LRIDT,"ORUT",LRI)) Q:'LRI  D
"RTN","LRWLST12",108,0)
 . S LRX=$P($G(^LR(LRDFN,LRSS,LRIDT,"ORUT",LRI,0)),"^")
"RTN","LRWLST12",109,0)
 . S LRY=$O(^LRO(69.6,LR696,2,"C",LRX,0))
"RTN","LRWLST12",110,0)
 . I LRY="" Q
"RTN","LRWLST12",111,0)
 . S LRZ=$P($G(^LRO(69.6,LR696,2,LRY,1)),"^")
"RTN","LRWLST12",112,0)
 . I LRZ="" Q
"RTN","LRWLST12",113,0)
 . S LRPROV=$E(LRZ,1,45)
"RTN","LRWLST12",114,0)
 . S FDA(1,LRFILE,LRI_","_LRIDT_","_LRDFN_",",7)=LRPROV
"RTN","LRWLST12",115,0)
 . D FILE^DIE("","FDA(1)","LRDIE(1)")
"RTN","LRWLST12",116,0)
 . K FDA(1),LRDIE(1)
"RTN","LRWLST12",117,0)
 ;
"RTN","LRWLST12",118,0)
 ; Copy ordering provider to file #63, AP field #.011 SPECIMEN SUBMITTED BY (free text field)
"RTN","LRWLST12",119,0)
 ;   - Copied from last or only test, only can store one.
"RTN","LRWLST12",120,0)
 I LRPROV'="","SPCYEM"[LRSS D
"RTN","LRWLST12",121,0)
 . S LRFILE=$S(LRSS="SP":63.08,LRSS="CY":63.09,LRSS="EM":63.02,1:"")
"RTN","LRWLST12",122,0)
 . I LRFILE="" Q
"RTN","LRWLST12",123,0)
 . S FDA(2,LRFILE,LRIDT_","_LRDFN_",",.011)=LRPROV
"RTN","LRWLST12",124,0)
 . D FILE^DIE("","FDA(2)","LRDIE(2)")
"RTN","LRWLST12",125,0)
 . K FDA(2),LRDIE(2)
"RTN","LRWLST12",126,0)
 ;
"RTN","LRWLST12",127,0)
 D CLEAN^DILF
"RTN","LRWLST12",128,0)
 ;
"RTN","LRWLST12",129,0)
 Q
"RTN","LRWLST12",130,0)
 ;
"RTN","LRWLST12",131,0)
 ;
"RTN","LRWLST12",132,0)
APMOVE ; Copy anatomic pathology data from file #69.6 to corresponding fields in file #63 for this accession.
"RTN","LRWLST12",133,0)
 ; Called from LRWLST11
"RTN","LRWLST12",134,0)
 ;
"RTN","LRWLST12",135,0)
 ; Copy specimen multiple to file #63
"RTN","LRWLST12",136,0)
 N FDA,LRDIE,LRFILE,LRI,LRX,LRY
"RTN","LRWLST12",137,0)
 S LRFILE=$S(LRSS="SP":63.812,LRSS="CY":63.902,LRSS="EM":63.202,1:0)
"RTN","LRWLST12",138,0)
 I 'LRFILE Q
"RTN","LRWLST12",139,0)
 S LRI=0
"RTN","LRWLST12",140,0)
 F  S LRI=$O(^LRO(69.6,LR696,61,LRI)) Q:'LRI  D
"RTN","LRWLST12",141,0)
 . N LRCYWKLD
"RTN","LRWLST12",142,0)
 . S LRY=$G(^LRO(69.6,LR696,61,LRI,0))
"RTN","LRWLST12",143,0)
 . I $P(LRY,"^")="" Q
"RTN","LRWLST12",144,0)
 . S FDA(1,LRFILE,"+1,"_LRIDT_","_LRDFN_",",.01)=$P(LRY,"^")
"RTN","LRWLST12",145,0)
 . I $P(LRY,"^",2) S FDA(1,LRFILE,"+1,"_LRIDT_","_LRDFN_",",.06)=$P(LRY,"^",2)
"RTN","LRWLST12",146,0)
 . I $P(LRY,"^",3) S FDA(1,LRFILE,"+1,"_LRIDT_","_LRDFN_",",.07)=$P(LRY,"^",3)
"RTN","LRWLST12",147,0)
 . I LRSS="CY" D
"RTN","LRWLST12",148,0)
 . . S LRCYWKLD=$$CYWKLD($P(LRY,"^"),$P(LRY,"^",2),$P(LRY,"^",3),LRAA)
"RTN","LRWLST12",149,0)
 . . I LRCYWKLD S FDA(1,LRFILE,"+1,"_LRIDT_","_LRDFN_",",.02)=LRCYWKLD
"RTN","LRWLST12",150,0)
 . I $D(FDA(1)) D UPDATE^DIE("","FDA(1)","","LRDIE(1)")
"RTN","LRWLST12",151,0)
 . K FDA(1),LRDIE(1)
"RTN","LRWLST12",152,0)
 ;
"RTN","LRWLST12",153,0)
 ; If no free text specimen and topography then create from top-level topography
"RTN","LRWLST12",154,0)
 I '$D(^LRO(69.6,LR696,61)) D
"RTN","LRWLST12",155,0)
 . N LRCYWKLD
"RTN","LRWLST12",156,0)
 . S LRX=$G(^LRO(69.6,LR696,0))
"RTN","LRWLST12",157,0)
 . I '$P(LRX,"^",7) Q
"RTN","LRWLST12",158,0)
 . S LRY=$$GET1^DIQ(61,$P(LRX,"^",7),.01),$P(LRY,"^",2,3)=$P(LRX,"^",7,8)
"RTN","LRWLST12",159,0)
 . S FDA(2,LRFILE,"+1,"_LRIDT_","_LRDFN_",",.01)=$P(LRY,"^")
"RTN","LRWLST12",160,0)
 . I $P(LRY,"^",2) S FDA(2,LRFILE,"+1,"_LRIDT_","_LRDFN_",",.06)=$P(LRY,"^",2)
"RTN","LRWLST12",161,0)
 . I $P(LRY,"^",3) S FDA(2,LRFILE,"+1,"_LRIDT_","_LRDFN_",",.07)=$P(LRY,"^",3)
"RTN","LRWLST12",162,0)
 . I LRSS="CY" D
"RTN","LRWLST12",163,0)
 . . S LRCYWKLD=$$CYWKLD($P(LRY,"^"),$P(LRY,"^",2),$P(LRY,"^",3),LRAA)
"RTN","LRWLST12",164,0)
 . . I LRCYWKLD S FDA(2,LRFILE,"+1,"_LRIDT_","_LRDFN_",",.02)=LRCYWKLD
"RTN","LRWLST12",165,0)
 . I $D(FDA(2)) D UPDATE^DIE("","FDA(2)","","LRDIE(2)")
"RTN","LRWLST12",166,0)
 . K FDA(2),LRDIE(2)
"RTN","LRWLST12",167,0)
 ;
"RTN","LRWLST12",168,0)
 ; Copy accompanying text to corresponding word-processing fields in file #63
"RTN","LRWLST12",169,0)
 ; If frozen section (1.3) and not SP subscript then store in microscopic description (1.1) - only SP supports frozen section.
"RTN","LRWLST12",170,0)
 S LRI=0,LRFILE=$S(LRSS="SP":63.08,LRSS="CY":63.09,LRSS="EM":63.02,1:0)
"RTN","LRWLST12",171,0)
 F  S LRI=$O(^LRO(69.6,LR696,63,LRI)) Q:'LRI  D
"RTN","LRWLST12",172,0)
 . S LRY=+$G(^LRO(69.6,LR696,63,LRI,0))
"RTN","LRWLST12",173,0)
 . I '$D(^LRO(69.6,LR696,63,LRI,1)) Q
"RTN","LRWLST12",174,0)
 . I LRI=1.3,LRSS'="SP" S LRI=1.1
"RTN","LRWLST12",175,0)
 . I LRFILE D WP^DIE(LRFILE,LRIDT_","_LRDFN_",",LRY,"A","^LRO(69.6,LR696,63,LRI,1)","LRDIE(LRFILE)")
"RTN","LRWLST12",176,0)
 ;
"RTN","LRWLST12",177,0)
 D CLEAN^DILF
"RTN","LRWLST12",178,0)
 Q
"RTN","LRWLST12",179,0)
 ;
"RTN","LRWLST12",180,0)
 ;
"RTN","LRWLST12",181,0)
MAILALRT(LRRNAME,LRFMERR) ;
"RTN","LRWLST12",182,0)
 ; Send mail message alert when FileMan DBS errors returned
"RTN","LRWLST12",183,0)
 ; Inputs
"RTN","LRWLST12",184,0)
 ;  LRRNAME: Routine name (TAG~RTN)
"RTN","LRWLST12",185,0)
 ;  LRFMERR:<byref><opt> FileMan error local array
"RTN","LRWLST12",186,0)
 ;
"RTN","LRWLST12",187,0)
 N J,LR68,LRCNT,LRMTXT,X,XMINSTR,XMSUB,XMTO,Y
"RTN","LRWLST12",188,0)
 ;
"RTN","LRWLST12",189,0)
 I $D(^LRO(68,LRAA,1,LRAD,1,LRAN)) M LR68=^LRO(68,LRAA,1,LRAD,1,LRAN)
"RTN","LRWLST12",190,0)
 ;
"RTN","LRWLST12",191,0)
 S LRMTXT(1)="The following debugging information is provided to assist"
"RTN","LRWLST12",192,0)
 S LRMTXT(2)="support staff in resolving error during accessioning."
"RTN","LRWLST12",193,0)
 S LRMTXT(3)=" ",LRCNT=3
"RTN","LRWLST12",194,0)
 ;
"RTN","LRWLST12",195,0)
 F J="DILOCKTM","DUZ","FDA","FDAIEN","LR68","LRAA","LRAD","LRAN","LRDFN","LRDIE","LRFDA","LRFDAIEN","LRFMERR","LRSAMP","LRSPEC","LRSS","LRTSTS","LRUNQ","LRWLC","XQY","XQY0" D
"RTN","LRWLST12",196,0)
 . S X=$G(@J)
"RTN","LRWLST12",197,0)
 . I X'="" S LRCNT=LRCNT+1,LRMTXT(LRCNT)=J_"="_X
"RTN","LRWLST12",198,0)
 . F  S J=$Q(@J) Q:J=""  S LRCNT=LRCNT+1,LRMTXT(LRCNT)=J_"="_@J
"RTN","LRWLST12",199,0)
 S LRCNT=LRCNT+1,LRMTXT(LRCNT)="Last Global Ref="_$$LGR^%ZOSV
"RTN","LRWLST12",200,0)
 S LRCNT=LRCNT+1,LRMTXT(LRCNT)="Version="_$$VERSION^%ZOSV(1)_" "_$$VERSION^%ZOSV
"RTN","LRWLST12",201,0)
 S LRCNT=LRCNT+1,LRMTXT(LRCNT)="Operating System="_$$OS^%ZOSV
"RTN","LRWLST12",202,0)
 D GETENV^%ZOSV
"RTN","LRWLST12",203,0)
 S LRCNT=LRCNT+1,LRMTXT(LRCNT)="Environment="_Y
"RTN","LRWLST12",204,0)
 ;
"RTN","LRWLST12",205,0)
 S XMSUB="FileMan DBS call failed during accessioning in routine "_$G(LRRNAME,"LRWLST1")
"RTN","LRWLST12",206,0)
 I $L(XMSUB)>65 S XMSUB="FileMan DBS failed during accessioning in "_$G(LRRNAME,"LRWLST1")
"RTN","LRWLST12",207,0)
 S XMTO("G.LMI")="",XMINSTR("FROM")=.5,XMINSTR("ADDR FLAGS")="R"
"RTN","LRWLST12",208,0)
 D SENDMSG^XMXAPI(DUZ,XMSUB,"LRMTXT",.XMTO,.XMINSTR)
"RTN","LRWLST12",209,0)
 Q
"RTN","LRWLST12",210,0)
CYWKLD(LR61NAME,LR61,LR62,LRAA) ;
"RTN","LRWLST12",211,0)
 ;
"RTN","LRWLST12",212,0)
 N LRCAPA,LRCYWKLD,DIR,DA,X,Y
"RTN","LRWLST12",213,0)
 ;
"RTN","LRWLST12",214,0)
 S LRCYWKLD=0
"RTN","LRWLST12",215,0)
 ;
"RTN","LRWLST12",216,0)
 S LRCAPA=$P(^LAB(69.9,1,0),"^",14)&($P(^LRO(68,LRAA,0),"^",16))
"RTN","LRWLST12",217,0)
 I 'LRCAPA Q LRCYWKLD
"RTN","LRWLST12",218,0)
 ;
"RTN","LRWLST12",219,0)
 W !
"RTN","LRWLST12",220,0)
 W !!,"CY Workload Profile For:"
"RTN","LRWLST12",221,0)
 W !
"RTN","LRWLST12",222,0)
 W !,"            SPECIMEN: ",LR61NAME
"RTN","LRWLST12",223,0)
 I LR61 W !," SPECIMEN TOPOGRAPHY: ",$$GET1^DIQ(61,LR61_",",.01)
"RTN","LRWLST12",224,0)
 I LR62 W !,"   COLLECTION SAMPLE: ",$$GET1^DIQ(62,LR62_",",.01)
"RTN","LRWLST12",225,0)
 W !
"RTN","LRWLST12",226,0)
 ;
"RTN","LRWLST12",227,0)
 S DIR(0)="63.902,.02"
"RTN","LRWLST12",228,0)
 D ^DIR
"RTN","LRWLST12",229,0)
 I $D(DIRUT) Q LRCYWKLD
"RTN","LRWLST12",230,0)
 S LRCYWKLD=+Y
"RTN","LRWLST12",231,0)
 ;
"RTN","LRWLST12",232,0)
 Q LRCYWKLD
"RTN","LRWU9")
0^11^B186695104
"RTN","LRWU9",1,0)
LRWU9 ;DALOI/CKA - TOOL TO DETECT, FIX, AND REPORT BAD DATA NAMES ;05/02/13
"RTN","LRWU9",2,0)
 ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
"RTN","LRWU9",3,0)
 ;
"RTN","LRWU9",4,0)
 ;Reference to ^PXRMINDX supported by ICR# 4290
"RTN","LRWU9",5,0)
 ;
"RTN","LRWU9",6,0)
EN ; Interactive entry point.
"RTN","LRWU9",7,0)
 ;
"RTN","LRWU9",8,0)
 D DT^DICRW
"RTN","LRWU9",9,0)
 N INSTALL,LRFIX,LRNUM,LRSITE,LRSPACE,LRSUPFLG,XMDUZ,XMY
"RTN","LRWU9",10,0)
 ;
"RTN","LRWU9",11,0)
 D INIT
"RTN","LRWU9",12,0)
 S LRFIX=$$ASK(),XMY(DUZ)="",XMDUZ=DUZ,INSTALL=0
"RTN","LRWU9",13,0)
 S $P(LRSPACE," ",80)=""
"RTN","LRWU9",14,0)
 I 'LRFIX Q
"RTN","LRWU9",15,0)
 S LRFIX=LRFIX-1
"RTN","LRWU9",16,0)
 D DES^XMA21    ; call to get the email recipients list.
"RTN","LRWU9",17,0)
 D PREP^XGF     ; setup screen
"RTN","LRWU9",18,0)
 D CHKDD
"RTN","LRWU9",19,0)
 D CHK63
"RTN","LRWU9",20,0)
 D SENDMM,CLEAN^XGF
"RTN","LRWU9",21,0)
 K ^TMP("LR",$J)
"RTN","LRWU9",22,0)
 ;
"RTN","LRWU9",23,0)
 Q
"RTN","LRWU9",24,0)
 ;-------------------------------------------------------
"RTN","LRWU9",25,0)
KIDS ; Entry point for post install run.
"RTN","LRWU9",26,0)
 ;
"RTN","LRWU9",27,0)
 N INSTALL,LRFIX,LRNUM,LRSITE,LRSUPFLG,XMY
"RTN","LRWU9",28,0)
 ;
"RTN","LRWU9",29,0)
 I $G(^XMB("NETNAME"))["DOMAIN.EXT",$$PROD^XUPROD() S XMY("G.LAB DEV IRMFO@DOMAIN.EXT")="",XMY("G.CSCLIN4@DOMAIN.EXT")=""
"RTN","LRWU9",30,0)
 S XMY(DUZ)="",XMY("G.LMI")="",INSTALL=1
"RTN","LRWU9",31,0)
 D INIT
"RTN","LRWU9",32,0)
 ;S LRFIX=1   ; [ccr-8167] - LRFIX is set to 0 in INIT subroutine.
"RTN","LRWU9",33,0)
 D CHKDD,CHK63,SENDMM
"RTN","LRWU9",34,0)
 ;
"RTN","LRWU9",35,0)
 K ^TMP("LR",$J)
"RTN","LRWU9",36,0)
 ;
"RTN","LRWU9",37,0)
 Q
"RTN","LRWU9",38,0)
 ;-------------------------------------------------------
"RTN","LRWU9",39,0)
LRNIGHT ; Entry point for ^LRNIGHT run.
"RTN","LRWU9",40,0)
 ;
"RTN","LRWU9",41,0)
 N INSTALL,LRFIX,LRNUM,LRSITE,LRSUPFLG,XMY
"RTN","LRWU9",42,0)
 ;
"RTN","LRWU9",43,0)
 S INSTALL=1
"RTN","LRWU9",44,0)
 D INIT,CHKDD,CHK63
"RTN","LRWU9",45,0)
 S (XMY(DUZ),XMY("G.LMI"))=""
"RTN","LRWU9",46,0)
 I $G(^XMB("NETNAME"))["DOMAIN.EXT",$$PROD^XUPROD() S XMY("G.LAB DEV IRMFO@DOMAIN.EXT")="",XMY("G.CSCLIN4@DOMAIN.EXT")=""
"RTN","LRWU9",47,0)
 I $O(^TMP("LR",$J,"DD63.04",5))]"" D SENDMM
"RTN","LRWU9",48,0)
 ;
"RTN","LRWU9",49,0)
 K ^TMP("LR",$J)
"RTN","LRWU9",50,0)
 ;
"RTN","LRWU9",51,0)
 Q
"RTN","LRWU9",52,0)
 ;-------------------------------------------------------
"RTN","LRWU9",53,0)
INIT ; Initialize variables.
"RTN","LRWU9",54,0)
 ;
"RTN","LRWU9",55,0)
 K ^TMP("LR",$J)
"RTN","LRWU9",56,0)
 D DT^DICRW
"RTN","LRWU9",57,0)
 S LRSITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))
"RTN","LRWU9",58,0)
 S LRFIX=0
"RTN","LRWU9",59,0)
 ;
"RTN","LRWU9",60,0)
 Q
"RTN","LRWU9",61,0)
 ;-------------------------------------------------------
"RTN","LRWU9",62,0)
CHKDD ; CHECK DD FOR BAD DATA NAMES.
"RTN","LRWU9",63,0)
 ;First check for DDs with the same subscript
"RTN","LRWU9",64,0)
 N CNT,DA,DIK,LR60CNT,LR60IEN,LRLOC,LRDATA,LRD0,LRPC,LRSUB,LRX,LRDD,LRDDA,LRNOTEST,LRNOFIX,LRSUBCNT
"RTN","LRWU9",65,0)
 K ^TMP("LR",$J)
"RTN","LRWU9",66,0)
 S LRNUM=1
"RTN","LRWU9",67,0)
 ;
"RTN","LRWU9",68,0)
 S ^TMP("LR",$J,"DD63.04",LRNUM)=$$NAME^XUAF4($$KSP^XUPARAM("INST"))_" ("_$$KSP^XUPARAM("WHERE")_")      "_$$FMTE^XLFDT(DT)
"RTN","LRWU9",69,0)
 S LRNUM=LRNUM+1
"RTN","LRWU9",70,0)
 S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
"RTN","LRWU9",71,0)
 S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
"RTN","LRWU9",72,0)
 S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
"RTN","LRWU9",73,0)
 S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
"RTN","LRWU9",74,0)
 ;
"RTN","LRWU9",75,0)
 S LRD0=1,LRDD=0,LRDDA=0
"RTN","LRWU9",76,0)
 F CNT=0:1 S LRD0=$O(^DD(63.04,LRD0)) Q:LRD0=""  D:$D(^DD(63.04,LRD0,0))
"RTN","LRWU9",77,0)
 . S LRDATA=$G(^DD(63.04,LRD0,0)) Q:LRDATA=""
"RTN","LRWU9",78,0)
 . S LRSUB=$P($P(LRDATA,U,4),";")
"RTN","LRWU9",79,0)
 . S LRPC=$P($P(LRDATA,U,4),";",2)
"RTN","LRWU9",80,0)
 . S LR60IEN="",LR60CNT=0
"RTN","LRWU9",81,0)
 . S LRX=0 F  S LRX=$O(^LAB(60,"C","CH;"_LRSUB_";"_LRPC,LRX)) Q:'LRX  D
"RTN","LRWU9",82,0)
 . . I $P($G(^LAB(60,LRX,.2)),U,1)=LRD0 D
"RTN","LRWU9",83,0)
 . . . S LR60IEN=LRX
"RTN","LRWU9",84,0)
 . . . S ^TMP("LR",$J,"SORT","LD",LRD0,LR60IEN)=""
"RTN","LRWU9",85,0)
 . . . S LR60CNT=LR60CNT+1
"RTN","LRWU9",86,0)
 . S LRSUBCNT=$G(^TMP("LR",$J,"SORT",1,LRSUB))+1
"RTN","LRWU9",87,0)
 . S ^TMP("LR",$J,"SORT",1,LRSUB)=LRSUBCNT
"RTN","LRWU9",88,0)
 . S ^TMP("LR",$J,"SORT",1,LRSUB,LRD0)=$P(LRDATA,U,1)_U_$P(LRDATA,U,4)_U_LR60IEN
"RTN","LRWU9",89,0)
 . I 'LR60IEN S ^TMP("LR",$J,"SORT","L",LRSUB,LRD0)=LRSUB ; L subscript used when Data name is not linked to a test
"RTN","LRWU9",90,0)
 . I LRPC'=1!(LRSUB'=LRD0) S ^TMP("LR",$J,"SORT","C",LRD0)=LRSUB ; C subscript used when Data name has wrong subscript location
"RTN","LRWU9",91,0)
 . I LRSUBCNT>1 S ^TMP("LR",$J,"SORT","D",LRSUB)="" ; D subscript used when more than one Data name has the same subscript
"RTN","LRWU9",92,0)
 . I LR60CNT=1 K ^TMP("LR",$J,"SORT","LD",LRD0) ; LD subscript used when there are multiple tests linked to a data name
"RTN","LRWU9",93,0)
 ;
"RTN","LRWU9",94,0)
 ; Report issues with duplicate subscript locations
"RTN","LRWU9",95,0)
 S LRSUB="" F  S LRSUB=$O(^TMP("LR",$J,"SORT","D",LRSUB)) Q:LRSUB=""  D
"RTN","LRWU9",96,0)
 . S LRSUPFLG=1
"RTN","LRWU9",97,0)
 . S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
"RTN","LRWU9",98,0)
 . S ^TMP("LR",$J,"DD63.04",LRNUM)="*WARNING* THE FOLLOWING DATA NAMES ARE ASSIGNED THE SAME SUBSCRIPT #"_LRSUB,LRNUM=LRNUM+1
"RTN","LRWU9",99,0)
 . S LRD0=0 F  S LRD0=$O(^TMP("LR",$J,"SORT",1,LRSUB,LRD0)) Q:LRD0=""  D
"RTN","LRWU9",100,0)
 . . S LRDATA=$G(^TMP("LR",$J,"SORT",1,LRSUB,LRD0))
"RTN","LRWU9",101,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)="   - Data Name '"_$P(LRDATA,U,1)_"' (#"_LRD0_") is assigned location: "_$P(LRDATA,U,2),LRNUM=LRNUM+1
"RTN","LRWU9",102,0)
 . . I $P(LRDATA,U,3) D
"RTN","LRWU9",103,0)
 . . . S ^TMP("LR",$J,"DD63.04",LRNUM)="     (This Data Name is linked to Lab test #"_$P(LRDATA,U,3)_" "_$P(^LAB(60,$P(LRDATA,U,3),0),U)_")",LRNUM=LRNUM+1
"RTN","LRWU9",104,0)
 . . I '$P(LRDATA,U,3) D
"RTN","LRWU9",105,0)
 . . . S ^TMP("LR",$J,"DD63.04",LRNUM)="     (This Data Name is not linked to a Lab test)",LRNUM=LRNUM+1
"RTN","LRWU9",106,0)
 ;
"RTN","LRWU9",107,0)
 ; Report issues with multiple tests with the same data name
"RTN","LRWU9",108,0)
 S LRD0=0 F  S LRD0=$O(^TMP("LR",$J,"SORT","LD",LRD0)) Q:'LRD0  D
"RTN","LRWU9",109,0)
 . S LRSUPFLG=1
"RTN","LRWU9",110,0)
 . S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
"RTN","LRWU9",111,0)
 . S ^TMP("LR",$J,"DD63.04",LRNUM)="*WARNING* THE DATA NAME '"_$P(^DD(63.04,LRD0,0),U)_"' (#"_LRD0_") IS LINKED TO MORE THAN ONE LAB TEST:",LRNUM=LRNUM+1
"RTN","LRWU9",112,0)
 . N LRCNT
"RTN","LRWU9",113,0)
 . S LR60IEN=0 F  S LR60IEN=$O(^TMP("LR",$J,"SORT","LD",LRD0,LR60IEN)) Q:'LR60IEN  D
"RTN","LRWU9",114,0)
 . . S LRCNT=$G(LRCNT)+1
"RTN","LRWU9",115,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)="   "_LRCNT_". "_$P($G(^LAB(60,LR60IEN,0)),U,1)_" (#"_LR60IEN_")"
"RTN","LRWU9",116,0)
 . . S LRNUM=LRNUM+1
"RTN","LRWU9",117,0)
 ;
"RTN","LRWU9",118,0)
 ;Check - SUBSCRIPT'=FIELD #
"RTN","LRWU9",119,0)
 ;        NOT IN FIRST PIECE
"RTN","LRWU9",120,0)
 ;        OR BOTH
"RTN","LRWU9",121,0)
 ;
"RTN","LRWU9",122,0)
 ;
"RTN","LRWU9",123,0)
 I 'INSTALL D SAY^XGF(24,1,LRSPACE),SAY^XGF(24,1,"LRD0=")
"RTN","LRWU9",124,0)
 S LRD0=1
"RTN","LRWU9",125,0)
 F CNT=0:1 S LRD0=$O(^TMP("LR",$J,"SORT","C",LRD0)) Q:LRD0=""  D
"RTN","LRWU9",126,0)
 . S LRDATA=$G(^DD(63.04,LRD0,0)) Q:LRDATA=""
"RTN","LRWU9",127,0)
 . S LRSUB=$P($P(LRDATA,U,4),";")
"RTN","LRWU9",128,0)
 . S LRPC=$P($P(LRDATA,U,4),";",2)
"RTN","LRWU9",129,0)
 . I $D(^TMP("LR",$J,"SORT","D",LRSUB)) Q
"RTN","LRWU9",130,0)
 . S LR60IEN=$P($G(^TMP("LR",$J,"SORT",1,LRSUB,LRD0)),U,3)
"RTN","LRWU9",131,0)
 . I 'INSTALL,'(CNT#100) D SAY^XGF(24,1,"LRD0="_LRD0)
"RTN","LRWU9",132,0)
 . I LRPC'=1!(LRSUB'=LRD0) D
"RTN","LRWU9",133,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
"RTN","LRWU9",134,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Data Name Location "_$P(^DD(63.04,LRD0,0),U)_" CH;"_LRSUB_";"_LRPC_" should be CH;"_LRD0_";1"
"RTN","LRWU9",135,0)
 . . I LRFIX,LR60IEN,'$D(^TMP("LR",$J,"SORT","LD",LRD0)) D FIXDD D
"RTN","LRWU9",136,0)
 . . . S ^(LRNUM)=^TMP("LR",$J,"DD63.04",LRNUM)_" ***FIXED***"
"RTN","LRWU9",137,0)
 . . I LRFIX,('LR60IEN!($D(^TMP("LR",$J,"SORT","LD",LRD0)))) D
"RTN","LRWU9",138,0)
 . . . S ^(LRNUM)=^TMP("LR",$J,"DD63.04",LRNUM)_" ***NOT FIXED***"
"RTN","LRWU9",139,0)
 . . . S LRSUPFLG=1
"RTN","LRWU9",140,0)
 . . S LRNUM=LRNUM+1
"RTN","LRWU9",141,0)
 . . I LR60IEN,$G(^TMP("LR",$J,"DDFIXED",LRSUB)) D
"RTN","LRWU9",142,0)
 . . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Lab test # "_LR60IEN_" "_$P(^LAB(60,LR60IEN,0),U)_" DATA NAME (LOCATION) SUBSCRIPT  **** FIXED ****"
"RTN","LRWU9",143,0)
 . . . S LRNUM=LRNUM+1
"RTN","LRWU9",144,0)
 . . . S ^TMP("LR",$J,"DD63.04",LRNUM)="    OLD SUBSCRIPT="_LRSUB_" NEW SUBSCRIPT="_LRD0
"RTN","LRWU9",145,0)
 . . . S LRNUM=LRNUM+1
"RTN","LRWU9",146,0)
 . . I 'LR60IEN D
"RTN","LRWU9",147,0)
 . . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Data Name is not linked to a File #60 Laboratory Test"
"RTN","LRWU9",148,0)
 . . . I LRFIX S ^(LRNUM)=^TMP("LR",$J,"DD63.04",LRNUM)_" ***NOT FIXED***",LRSUPFLG=1
"RTN","LRWU9",149,0)
 . . . S LRNUM=LRNUM+1
"RTN","LRWU9",150,0)
 . . I $D(^TMP("LR",$J,"SORT","LD",LRD0)) D
"RTN","LRWU9",151,0)
 . . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Data Name is linked to more than one File #60 Laboratory Test"
"RTN","LRWU9",152,0)
 . . . I LRFIX S ^(LRNUM)=^TMP("LR",$J,"DD63.04",LRNUM)_" ***NOT FIXED***",LRSUPFLG=1
"RTN","LRWU9",153,0)
 . . . S LRNUM=LRNUM+1
"RTN","LRWU9",154,0)
 ;
"RTN","LRWU9",155,0)
 Q
"RTN","LRWU9",156,0)
 ;-------------------------------------------------------
"RTN","LRWU9",157,0)
CHK63 ;CHECK FILE 63 FOR TEST DATA WITH NO DATA NAME
"RTN","LRWU9",158,0)
 ;
"RTN","LRWU9",159,0)
 N CNT,DATANUM,LRDFN,LRIDT,LRD0,LRNUM1,LRNUM2
"RTN","LRWU9",160,0)
 I 'INSTALL D SAY^XGF(24,1,LRSPACE),SAY^XGF(24,1,"LRDFN=")
"RTN","LRWU9",161,0)
 S (LRDFN,LRIDT,LRD0)=0
"RTN","LRWU9",162,0)
 S LRNUM1=1,LRNUM2=1
"RTN","LRWU9",163,0)
 F CNT=0:1 S LRDFN=$O(^LR(LRDFN)) Q:'LRDFN  D
"RTN","LRWU9",164,0)
 . S LRIDT=0
"RTN","LRWU9",165,0)
 . F  S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:'LRIDT  D
"RTN","LRWU9",166,0)
 . . N LRREPAIR
"RTN","LRWU9",167,0)
 . . S LRD0=1
"RTN","LRWU9",168,0)
 . . F  S LRD0=$O(^LR(LRDFN,"CH",LRIDT,LRD0)) Q:LRD0'>0  D
"RTN","LRWU9",169,0)
 . . . I $D(LRREPAIR(LRD0)) Q  ;Used to prevent issues when two Data Names use each others subscripts
"RTN","LRWU9",170,0)
 . . . I 'INSTALL,'(CNT#100) D SAY^XGF(24,1,"LRDFN="_LRDFN)
"RTN","LRWU9",171,0)
 . . . I '$D(^DD(63.04,LRD0,0)),'$D(^TMP("LR",$J,"SORT",1,LRD0)) D
"RTN","LRWU9",172,0)
 . . . . S ^TMP("LR",$J,"SORT","W",LRD0,LRNUM2)="^LR("_LRDFN_",""CH"","_LRIDT_","_LRD0_")"
"RTN","LRWU9",173,0)
 . . . . S LRNUM2=LRNUM2+1
"RTN","LRWU9",174,0)
 . . . ; Check if there are results that belong to a Data Name that is not linked to a test.
"RTN","LRWU9",175,0)
 . . . S DATANUM=$O(^TMP("LR",$J,"SORT","L",LRD0,0))
"RTN","LRWU9",176,0)
 . . . I DATANUM,'$D(^TMP("LR",$J,"SORT","D",LRD0)) D
"RTN","LRWU9",177,0)
 . . . . ;SORT BY DATA NAME
"RTN","LRWU9",178,0)
 . . . . S ^TMP("LR",$J,"SORT","T",DATANUM,LRNUM1)="^LR("_LRDFN_",""CH"","_LRIDT_","_LRD0_")"
"RTN","LRWU9",179,0)
 . . . . S LRNUM1=LRNUM1+1
"RTN","LRWU9",180,0)
 . . . I LRFIX D FIX63
"RTN","LRWU9",181,0)
 S LRNUM2=0,DATANUM=0
"RTN","LRWU9",182,0)
 I $D(^TMP("LR",$J,"SORT","W")) D
"RTN","LRWU9",183,0)
 . F  S DATANUM=$O(^TMP("LR",$J,"SORT","W",DATANUM)) Q:DATANUM'>0  D
"RTN","LRWU9",184,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
"RTN","LRWU9",185,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Results in subscript '"_DATANUM_"' without a Data Name at: "
"RTN","LRWU9",186,0)
 . . S LRNUM=LRNUM+1
"RTN","LRWU9",187,0)
 . . F  S LRNUM2=$O(^TMP("LR",$J,"SORT","W",DATANUM,LRNUM2)) Q:LRNUM2'>0  D
"RTN","LRWU9",188,0)
 . . . S ^TMP("LR",$J,"DD63.04",LRNUM)="     "_^TMP("LR",$J,"SORT","W",DATANUM,LRNUM2)
"RTN","LRWU9",189,0)
 . . . S LRNUM=LRNUM+1
"RTN","LRWU9",190,0)
 . . . S LRSUPFLG=1
"RTN","LRWU9",191,0)
 S LRNUM1=0,DATANUM=0
"RTN","LRWU9",192,0)
 I $D(^TMP("LR",$J,"SORT","T")) D
"RTN","LRWU9",193,0)
 . F  S DATANUM=$O(^TMP("LR",$J,"SORT","T",DATANUM)) Q:DATANUM'>0  D
"RTN","LRWU9",194,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
"RTN","LRWU9",195,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Results in Data Name "_$P(^DD(63.04,DATANUM,0),U,1)_" without a test in file 60 at: "
"RTN","LRWU9",196,0)
 . . S LRNUM=LRNUM+1
"RTN","LRWU9",197,0)
 . . F  S LRNUM1=$O(^TMP("LR",$J,"SORT","T",DATANUM,LRNUM1)) Q:LRNUM1'>0  D
"RTN","LRWU9",198,0)
 . . . S ^TMP("LR",$J,"DD63.04",LRNUM)="     "_^TMP("LR",$J,"SORT","T",DATANUM,LRNUM1)
"RTN","LRWU9",199,0)
 . . . S LRNUM=LRNUM+1
"RTN","LRWU9",200,0)
 . . . S LRSUPFLG=1
"RTN","LRWU9",201,0)
 ;
"RTN","LRWU9",202,0)
 Q
"RTN","LRWU9",203,0)
 ;-------------------------------------------------------
"RTN","LRWU9",204,0)
FIXDD ; FIX DD FOR BAD DATA NAMES.
"RTN","LRWU9",205,0)
 ;
"RTN","LRWU9",206,0)
 N DDFIELD,LRNAME,LRTYPE
"RTN","LRWU9",207,0)
 ;
"RTN","LRWU9",208,0)
 D FIELD^DID(63.04,LRD0,"","LABEL;TYPE","DDFIELD")
"RTN","LRWU9",209,0)
 S LRNAME=DDFIELD("LABEL")
"RTN","LRWU9",210,0)
 S LRTYPE=DDFIELD("TYPE")
"RTN","LRWU9",211,0)
 S DA=LRD0
"RTN","LRWU9",212,0)
 D DDFIX^LRWU6
"RTN","LRWU9",213,0)
 I LR60IEN D
"RTN","LRWU9",214,0)
 . I $P(^LAB(60,LR60IEN,0),U,5)'="CH;"_LRD0_";1"!($P(^LAB(60,LR60IEN,0),U,12)'="DD(63.04,"_LRD0_",")!(^LAB(60,LR60IEN,.2)'=LRD0) D
"RTN","LRWU9",215,0)
 . . N LRFDA,LRDIE
"RTN","LRWU9",216,0)
 . . S LRFDA(1,60,LR60IEN_",",400)=LRD0
"RTN","LRWU9",217,0)
 . . S LRFDA(1,60,LR60IEN_",",5)="CH;"_LRD0_";1"
"RTN","LRWU9",218,0)
 . . S LRFDA(1,60,LR60IEN_",",13)="DD(63.04,"_LRD0_","
"RTN","LRWU9",219,0)
 . . D FILE^DIE("","LRFDA(1)","LRDIE(1)")
"RTN","LRWU9",220,0)
 . . S ^TMP("LR",$J,"DDFIXED",LRSUB)=LRD0_U_LRPC_U_LR60IEN
"RTN","LRWU9",221,0)
UPD624 . . N LR624,LR6243
"RTN","LRWU9",222,0)
 . . S LR624=0 F  S LR624=$O(^LAB(62.4,LR624)) Q:'LR624  D
"RTN","LRWU9",223,0)
 . . . S LR6243=0 F  S LR6243=$O(^LAB(62.4,LR624,3,LR6243)) Q:'LR6243  D
"RTN","LRWU9",224,0)
 . . . .I $P(^LAB(62.4,LR624,3,LR6243,0),U)=LR60IEN D
"RTN","LRWU9",225,0)
 . . . . . N LRFDA,LRIENS
"RTN","LRWU9",226,0)
 . . . . . S LRIENS=LR6243_","_LR624_","
"RTN","LRWU9",227,0)
 . . . . . S LRFDA(62.41,LRIENS,11)="TV("_LRD0_",1)"
"RTN","LRWU9",228,0)
 . . . . . D FILE^DIE("","LRFDA")
"RTN","LRWU9",229,0)
 ;
"RTN","LRWU9",230,0)
 Q
"RTN","LRWU9",231,0)
 ;-------------------------------------------------------
"RTN","LRWU9",232,0)
FIX63 ;FIX DATA NODES IN FILE 63
"RTN","LRWU9",233,0)
 ;
"RTN","LRWU9",234,0)
 Q:$D(^TMP("LR",$J,"SORT","D",LRD0))
"RTN","LRWU9",235,0)
 Q:'$D(^TMP("LR",$J,"DDFIXED",LRD0))
"RTN","LRWU9",236,0)
 Q:($P(^TMP("LR",$J,"DDFIXED",LRD0),U,2)'=1)
"RTN","LRWU9",237,0)
 S LRLOC=$P(^TMP("LR",$J,"DDFIXED",LRD0),U)
"RTN","LRWU9",238,0)
 I $D(^DD(63.04,LRD0,0))!($D(^TMP("LR",$J,"SORT",1,LRD0))) S ^TMP("LR",$J,"DD63.04",LRNUM)=" ",LRNUM=LRNUM+1
"RTN","LRWU9",239,0)
 I $D(^LR(LRDFN,"CH",LRIDT,LRLOC)) D  Q
"RTN","LRWU9",240,0)
 . S ^TMP("LR",$J,"DD63.04",LRNUM)="*ERROR* MOVING OVER ^LR("_LRDFN_",CH,"_LRIDT_","_LRD0_") TO ^LR("_LRDFN_",CH,"_LRIDT_","_LRLOC_")"
"RTN","LRWU9",241,0)
 . S LRNUM=LRNUM+1
"RTN","LRWU9",242,0)
 . S ^TMP("LR",$J,"DD63.04",LRNUM)="Data already exists in ^LR("_LRDFN_",CH,"_LRIDT_","_LRLOC_")"
"RTN","LRWU9",243,0)
 . S LRNUM=LRNUM+1
"RTN","LRWU9",244,0)
 . S LRSUPFLG=1
"RTN","LRWU9",245,0)
 D CHKILLPX(LRDFN,LRIDT,LRD0) ;Kill Clinical Reminders Index
"RTN","LRWU9",246,0)
 S ^LR(LRDFN,"CH",LRIDT,LRLOC)=^LR(LRDFN,"CH",LRIDT,LRD0)
"RTN","LRWU9",247,0)
 K ^LR(LRDFN,"CH",LRIDT,LRD0)
"RTN","LRWU9",248,0)
 S LRREPAIR(LRLOC)=""
"RTN","LRWU9",249,0)
 D CHSET^LRPX(LRDFN,LRIDT) ;Set Clinical Reminders Index
"RTN","LRWU9",250,0)
 S ^TMP("LR",$J,"DD63.04",LRNUM)="DATA LOCATION FIXED IN LAB DATA FILE ^LR"
"RTN","LRWU9",251,0)
 S LRNUM=LRNUM+1
"RTN","LRWU9",252,0)
 S ^TMP("LR",$J,"DD63.04",LRNUM)="^LR("_LRDFN_",CH,"_LRIDT_","_LRD0_") NOW MOVED TO ^LR("_LRDFN_",CH,"_LRIDT_","_LRLOC_")"
"RTN","LRWU9",253,0)
 S LRNUM=LRNUM+1
"RTN","LRWU9",254,0)
 ;
"RTN","LRWU9",255,0)
 Q
"RTN","LRWU9",256,0)
 ;-------------------------------------------------------
"RTN","LRWU9",257,0)
CHKILLPX(LRDFN,LRIDT,LRD0) ;Kill Clinical Reminders Index
"RTN","LRWU9",258,0)
 N LR60IEN,DFN,DATE,OK,DAS,LRDBLCHK
"RTN","LRWU9",259,0)
 S LR60IEN=$P(^TMP("LR",$J,"DDFIXED",LRD0),U,3)
"RTN","LRWU9",260,0)
 I 'LR60IEN D
"RTN","LRWU9",261,0)
 . N DATA
"RTN","LRWU9",262,0)
 . S DATA=^LR(LRDFN,"CH",LRIDT,LRD0)
"RTN","LRWU9",263,0)
 . S LR60IEN=+$P($P(DATA,U,3),"!",7)
"RTN","LRWU9",264,0)
 I 'LR60IEN Q
"RTN","LRWU9",265,0)
 I '$L($G(^LR(+$G(LRDFN),"CH",+$G(LRIDT),0))) Q
"RTN","LRWU9",266,0)
 D PATIENT^LRPX(LRDFN,.DFN,.OK) I 'OK Q
"RTN","LRWU9",267,0)
 S DATE=9999999-LRIDT
"RTN","LRWU9",268,0)
 S DAS=LRDFN_";CH;"_LRIDT_";"_LRD0
"RTN","LRWU9",269,0)
 S LRDBLCHK=0
"RTN","LRWU9",270,0)
 I '$D(^PXRMINDX(63,"PI",DFN,LR60IEN,DATE,DAS)) S LRDBLCHK=1
"RTN","LRWU9",271,0)
 D KLAB^LRPX(DFN,DATE,LR60IEN,DAS)
"RTN","LRWU9",272,0)
 ;
"RTN","LRWU9",273,0)
 I LRDBLCHK D
"RTN","LRWU9",274,0)
 . N ITEM,FLAG
"RTN","LRWU9",275,0)
 . S ITEM=0 F  S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:'ITEM!($D(FLAG))  D
"RTN","LRWU9",276,0)
 . . I $D(^PXRMINDX(63,"PI",DFN,ITEM,DATE,DAS)) D
"RTN","LRWU9",277,0)
 . . . D KLAB^LRPX(DFN,DATE,ITEM,DAS)
"RTN","LRWU9",278,0)
 . . . S FLAG=1
"RTN","LRWU9",279,0)
 Q
"RTN","LRWU9",280,0)
 ;-------------------------------------------------------
"RTN","LRWU9",281,0)
SENDMM ;SEND MAIL MESSAGE OF ERRORS FOUND AND/OR FIXED.
"RTN","LRWU9",282,0)
 ;
"RTN","LRWU9",283,0)
 N XMSUB,DIFROM,XMINSTR
"RTN","LRWU9",284,0)
 ;
"RTN","LRWU9",285,0)
 S LRNUM=3
"RTN","LRWU9",286,0)
 I $O(^TMP("LR",$J,"DD63.04",5)) D  ;Errors were found
"RTN","LRWU9",287,0)
 . ;
"RTN","LRWU9",288,0)
 . I 'LRFIX!(LRFIX&($G(LRSUPFLG))) D  ;not all errors were auto-repaired
"RTN","LRWU9",289,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Contact the National Service Desk to request assistance from the Clin 4",LRNUM=LRNUM+1
"RTN","LRWU9",290,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)="Product Support team in resolving the following errors identified in the",LRNUM=LRNUM+1
"RTN","LRWU9",291,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)="VistA Laboratory package:",LRNUM=LRNUM+1
"RTN","LRWU9",292,0)
 . ;
"RTN","LRWU9",293,0)
 . I LRFIX,'$G(LRSUPFLG) D  ;all errors were auto-repaired
"RTN","LRWU9",294,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)="The LAB DATA file (#63) cleanup process has found and repaired the",LRNUM=LRNUM+1
"RTN","LRWU9",295,0)
 . . S ^TMP("LR",$J,"DD63.04",LRNUM)="following errors:",LRNUM=LRNUM+1
"RTN","LRWU9",296,0)
 ;
"RTN","LRWU9",297,0)
 I '$O(^TMP("LR",$J,"DD63.04",5)) D  ;No errors were found
"RTN","LRWU9",298,0)
 . S ^TMP("LR",$J,"DD63.04",LRNUM)=""
"RTN","LRWU9",299,0)
 . S ^TMP("LR",$J,"DD63.04",(LRNUM+1))="*** NO ERRORS FOUND ***"
"RTN","LRWU9",300,0)
 ;
"RTN","LRWU9",301,0)
 S XMSUB="DATA DICTIONARY ^DD(63.04 CHECK REPORT "
"RTN","LRWU9",302,0)
 S XMSUB=XMSUB_$$FMTE^XLFDT($$NOW^XLFDT,"1S")
"RTN","LRWU9",303,0)
 S XMINSTR("ADDR FLAGS")="R"
"RTN","LRWU9",304,0)
 D SENDMSG^XMXAPI(DUZ,XMSUB,"^TMP(""LR"",$J,""DD63.04"")",.XMY,.XMINSTR)
"RTN","LRWU9",305,0)
 ;
"RTN","LRWU9",306,0)
 Q
"RTN","LRWU9",307,0)
 ;-------------------------------------------------------
"RTN","LRWU9",308,0)
ASK() ; Run analyze/repair query
"RTN","LRWU9",309,0)
 ;
"RTN","LRWU9",310,0)
 N Y,DIR,DIRUT,DTOUT,DUOUT,FIX
"RTN","LRWU9",311,0)
 ;
"RTN","LRWU9",312,0)
 S FIX=0
"RTN","LRWU9",313,0)
 ;
"RTN","LRWU9",314,0)
 W !,"This process will check the CHEM, HEM, TOX, RIA, SER, etc."
"RTN","LRWU9",315,0)
 W !,"Sub-file (#63.04) of the LAB DATA file (#63) looking for"
"RTN","LRWU9",316,0)
 W !,"possible discrepancies in the Data Dictionary.  Once the"
"RTN","LRWU9",317,0)
 W !,"process has completed, a MailMan message will be sent to the"
"RTN","LRWU9",318,0)
 W !,"user that started this process and any other user selected."
"RTN","LRWU9",319,0)
 W !!
"RTN","LRWU9",320,0)
 W !,"The two modes in which this process can be run are ANALYZE"
"RTN","LRWU9",321,0)
 W !,"and REPAIR.  If the ANALYZE option is chosen, the process will"
"RTN","LRWU9",322,0)
 W !,"only look for discrepancies and report the findings via a"
"RTN","LRWU9",323,0)
 W !,"MailMan message.  If the ANALYZE,REPAIR option is chosen the"
"RTN","LRWU9",324,0)
 W !,"process will ANALYZE and REPAIR any discrepancies found that"
"RTN","LRWU9",325,0)
 W !,"can be fixed programmatically and list all those that could"
"RTN","LRWU9",326,0)
 W !,"not be fixed but need attention."
"RTN","LRWU9",327,0)
 W !!
"RTN","LRWU9",328,0)
 ;
"RTN","LRWU9",329,0)
 S DIR("A")="Do you want to continue with this process",DIR("B")="NO"
"RTN","LRWU9",330,0)
 S DIR(0)="Y"
"RTN","LRWU9",331,0)
 D ^DIR
"RTN","LRWU9",332,0)
 I 'Y Q FIX
"RTN","LRWU9",333,0)
 ;
"RTN","LRWU9",334,0)
 K DIR,Y
"RTN","LRWU9",335,0)
 ;
"RTN","LRWU9",336,0)
 S DIR(0)="NAO^1:3",DIR("B")=3
"RTN","LRWU9",337,0)
 S DIR("A",1)="Select the action you wish to take:"
"RTN","LRWU9",338,0)
 S DIR("A",2)=""
"RTN","LRWU9",339,0)
 S DIR("A",3)="1. Analyze and Report."
"RTN","LRWU9",340,0)
 S DIR("A",4)="2. Analyze, Repair, and Report."
"RTN","LRWU9",341,0)
 S DIR("A",5)="3. Quit - No Action."
"RTN","LRWU9",342,0)
 S DIR("A",6)=""
"RTN","LRWU9",343,0)
 S DIR("A")="Enter a number 1 thru 3: "
"RTN","LRWU9",344,0)
 S DIR("?")="Select a number 1 thru 3 or press <Return> to exit"
"RTN","LRWU9",345,0)
 ;
"RTN","LRWU9",346,0)
 D ^DIR
"RTN","LRWU9",347,0)
 I Y=1 S FIX=1
"RTN","LRWU9",348,0)
 I Y=2 S FIX=2
"RTN","LRWU9",349,0)
 I Y=3!(Y=-1)!('Y) S FIX=0 Q FIX
"RTN","LRWU9",350,0)
 ;
"RTN","LRWU9",351,0)
 K DIR,Y
"RTN","LRWU9",352,0)
 S DIR("A")="Are you sure you want to proceed",DIR("B")="NO"
"RTN","LRWU9",353,0)
 S DIR(0)="Y"
"RTN","LRWU9",354,0)
 D ^DIR
"RTN","LRWU9",355,0)
 I 'Y S FIX=0
"RTN","LRWU9",356,0)
 ;
"RTN","LRWU9",357,0)
 Q FIX
"UP",63,63.37,-2)
63^MI
"UP",63,63.37,-1)
63.05^9
"UP",63,63.37,0)
63.37
"VER")
8.0^22.0
"^DD",61,61,.01,0)
NAME^RFX^^0;1^K:$L(X)>80!($L(X)<2)!'(X'?1P.E)!(X'?.ANP) X I $D(X),X?1"T"1N.E!(X?1"T-".E) K X D EN^DDIOL("Enter SNOMED CODE without T or T-",,"$C(7),!") Q
"^DD",61,61,.01,1,0)
^.1
"^DD",61,61,.01,1,1,0)
61^B
"^DD",61,61,.01,1,1,1)
S ^LAB(61,"B",$E(X,1,80),DA)=""
"^DD",61,61,.01,1,1,2)
K ^LAB(61,"B",$E(X,1,80),DA)
"^DD",61,61,.01,3)
Answer must be 2-80 characters in length.
"^DD",61,61,.01,21,0)
^.001^1^1^3070828^^^^
"^DD",61,61,.01,21,1,0)
The name of the specimen or source.
"^DD",61,61,.01,23,0)
^^3^3^3070828^
"^DD",61,61,.01,23,1,0)
When this field is modified by non-interactive means, the variable 
"^DD",61,61,.01,23,2,0)
LRFMERTS should be defined.  LRFMERTS is used by the AERT xref to 
"^DD",61,61,.01,23,3,0)
determine if the field is being edited by a user or by a process.
"^DD",61,61,.01,"DEL",1,0)
I '$D(^XUSEC("LRLIASON",DUZ))
"^DD",61,61,.01,"DT")
3130221
"^DD",61.2,61.2,.01,0)
NAME^RF^^0;1^K:X[""""!($A(X)=45) X I $D(X) K:$L(X)>80!($L(X)<2)!'(X'?1P.E)!(X'?.ANP) X
"^DD",61.2,61.2,.01,1,0)
^.1
"^DD",61.2,61.2,.01,1,1,0)
61.2^B
"^DD",61.2,61.2,.01,1,1,1)
S ^LAB(61.2,"B",$E(X,1,30),DA)=""
"^DD",61.2,61.2,.01,1,1,2)
K ^LAB(61.2,"B",$E(X,1,30),DA)
"^DD",61.2,61.2,.01,3)
Answer must be 2-80 characters in length.
"^DD",61.2,61.2,.01,21,0)
^.001^1^1^3120731^^^^
"^DD",61.2,61.2,.01,21,1,0)
The name of the etiologic (causative) agent.
"^DD",61.2,61.2,.01,23,0)
^.001^3^3^3120731^^
"^DD",61.2,61.2,.01,23,1,0)
When this field is modified by non-interactive means, the variable 
"^DD",61.2,61.2,.01,23,2,0)
LRFMERTS should be defined.  LRFMERTS is used by the AERT xref to 
"^DD",61.2,61.2,.01,23,3,0)
determine if the field is being edited by a user or by a process.
"^DD",61.2,61.2,.01,"DEL",1,0)
I '$D(^XUSEC("LRLIASON",DUZ))
"^DD",61.2,61.2,.01,"DT")
3130221
"^DD",62,62,.01,0)
NAME^RF^^0;1^K:$L(X)>30!($L(X)<3)!'(X'?1P.E)!(X'?.ANP) X
"^DD",62,62,.01,1,0)
^.1
"^DD",62,62,.01,1,1,0)
62^B
"^DD",62,62,.01,1,1,1)
S ^LAB(62,"B",$E(X,1,30),DA)=""
"^DD",62,62,.01,1,1,2)
K ^LAB(62,"B",$E(X,1,30),DA)
"^DD",62,62,.01,3)
Answer must be 3-30 characters in length.
"^DD",62,62,.01,21,0)
^.001^1^1^3070828^^
"^DD",62,62,.01,21,1,0)
The name of the collection sample.
"^DD",62,62,.01,23,0)
^^3^3^3070828^
"^DD",62,62,.01,23,1,0)
When this field is modified by non-interactive means, the variable 
"^DD",62,62,.01,23,2,0)
LRFMERTS should be defined.  LRFMERTS is used by the AERT xref to 
"^DD",62,62,.01,23,3,0)
determine if the field is being edited by a user or by a process.
"^DD",62,62,.01,"DEL",1,0)
I '$D(^XUSEC("LRLIASON",DUZ))
"^DD",62,62,.01,"DT")
3130221
"^DD",63,63.05,20,0)
FUNGUS/YEAST^63.37PA^^9;0
"^DD",63,63.05,20,12)
ALLOW ONLY FUNGI TO BE EDITED
"^DD",63,63.05,20,12.1)
S DIC("S")="I $P(^(0),U,5)=""F"""
"^DD",63,63.05,20,21,0)
^.001^1^1^3130212^^^^
"^DD",63,63.05,20,21,1,0)
These are the fungus/yeast reported on this specimen.
"^DD",63,63.37,0)
FUNGUS/YEAST SUB-FIELD^NL^.1^5
"^DD",63,63.37,0,"NM","FUNGUS/YEAST")

"^DD",63,63.37,.01,0)
FUNGUS/YEAST^M*P61.2'X^LAB(61.2,^0;1^S DIC("S")="I $P(^(0),U,5)=""F""" D ^DIC K DIC S DIC=$G(DIE),X=+Y K:Y<0 X
"^DD",63,63.37,.01,1,0)
^.1
"^DD",63,63.37,.01,1,1,0)
63.37^B
"^DD",63,63.37,.01,1,1,1)
S ^LR(DA(2),"MI",DA(1),9,"B",$E(X,1,30),DA)=""
"^DD",63,63.37,.01,1,1,2)
K ^LR(DA(2),"MI",DA(1),9,"B",$E(X,1,30),DA)
"^DD",63,63.37,.01,1,2,0)
63.37^AC^MUMPS
"^DD",63,63.37,.01,1,2,1)
I $P($G(^LAB(61.2,+X,0)),"^",9) S ^LR("AD",DT,+X,$P(^LR(DA(2),"MI",DA(1),0),"^",6)_" ")=DA(2)
"^DD",63,63.37,.01,1,2,2)
I $P($G(^LAB(61.2,+X,0)),"^",9) K ^LR("AD",DT,+X,$P(^LR(DA(2),"MI",DA(1),0),"^",6)_" ")
"^DD",63,63.37,.01,1,3,0)
63.05^AD^MUMPS
"^DD",63,63.37,.01,1,3,1)
D ENDIY^LRCAPV1
"^DD",63,63.37,.01,1,3,2)
Q
"^DD",63,63.37,.01,1,3,3)
To trigger WKLD routine.
"^DD",63,63.37,.01,1,3,"%D",0)
^^1^1^2930720^
"^DD",63,63.37,.01,1,3,"%D",1,0)
Lookup any WKLD codes for this organism and record.
"^DD",63,63.37,.01,1,3,"DT")
2930720
"^DD",63,63.37,.01,3)
Select the fungus/yeast identified on this specimen.
"^DD",63,63.37,.01,12)
Only entities with an Identifier of Fungus are selectable.
"^DD",63,63.37,.01,12.1)
S DIC("S")="I $P(^(0),U,5)=""F"""
"^DD",63,63.37,.01,21,0)
^^1^1^3130221^
"^DD",63,63.37,.01,21,1,0)
The fungus/yeast identified on this specimen.
"^DD",63,63.37,.01,"DT")
3130221
**INSTALL NAME**
LA*5.2*80
"BLD",7489,0)
LA*5.2*80^AUTOMATED LAB INSTRUMENTS^0^3130819^y
"BLD",7489,4,0)
^9.64PA^62.48^2
"BLD",7489,4,62.47,0)
62.47
"BLD",7489,4,62.47,2,0)
^9.641^62.4701^2
"BLD",7489,4,62.47,2,62.47,0)
LAB CODE MAPPING  (File-top level)
"BLD",7489,4,62.47,2,62.47,1,0)
^9.6411^.04^3
"BLD",7489,4,62.47,2,62.47,1,.001,0)
SEQUENCE
"BLD",7489,4,62.47,2,62.47,1,.01,0)
CONCEPT
"BLD",7489,4,62.47,2,62.47,1,.04,0)
ALTERNATE CONCEPT
"BLD",7489,4,62.47,2,62.4701,0)
IDENTIFIER  (sub-file)
"BLD",7489,4,62.47,2,62.4701,1,0)
^9.6411^2.2^5
"BLD",7489,4,62.47,2,62.4701,1,.01,0)
IDENTIFIER
"BLD",7489,4,62.47,2,62.4701,1,.02,0)
CODING SYSTEM
"BLD",7489,4,62.47,2,62.4701,1,.05,0)
NATIONAL STANDARD
"BLD",7489,4,62.47,2,62.4701,1,2.1,0)
RELATED ENTRY
"BLD",7489,4,62.47,2,62.4701,1,2.2,0)
MESSAGE CONFIGURATION
"BLD",7489,4,62.47,222)
y^n^p^^^^n^^n
"BLD",7489,4,62.47,224)

"BLD",7489,4,62.48,0)
62.48
"BLD",7489,4,62.48,2,0)
^9.641^62.482^1
"BLD",7489,4,62.48,2,62.482,0)
NON-VA ORDER SNOMED CODES  (sub-file)
"BLD",7489,4,62.48,2,62.482,1,0)
^9.6411^^
"BLD",7489,4,62.48,222)
y^n^p^^^^n^^n
"BLD",7489,4,62.48,224)

"BLD",7489,4,"APDD",62.47,62.47)

"BLD",7489,4,"APDD",62.47,62.47,.001)

"BLD",7489,4,"APDD",62.47,62.47,.01)

"BLD",7489,4,"APDD",62.47,62.47,.04)

"BLD",7489,4,"APDD",62.47,62.4701)

"BLD",7489,4,"APDD",62.47,62.4701,.01)

"BLD",7489,4,"APDD",62.47,62.4701,.02)

"BLD",7489,4,"APDD",62.47,62.4701,.05)

"BLD",7489,4,"APDD",62.47,62.4701,2.1)

"BLD",7489,4,"APDD",62.47,62.4701,2.2)

"BLD",7489,4,"APDD",62.48,62.482)

"BLD",7489,4,"B",62.47,62.47)

"BLD",7489,4,"B",62.48,62.48)

"BLD",7489,6.3)
19
"BLD",7489,"INID")
^y
"BLD",7489,"INIT")
POST^LA80
"BLD",7489,"KRN",0)
^9.67PA^779.2^20
"BLD",7489,"KRN",.4,0)
.4
"BLD",7489,"KRN",.401,0)
.401
"BLD",7489,"KRN",.402,0)
.402
"BLD",7489,"KRN",.403,0)
.403
"BLD",7489,"KRN",.5,0)
.5
"BLD",7489,"KRN",.84,0)
.84
"BLD",7489,"KRN",3.6,0)
3.6
"BLD",7489,"KRN",3.8,0)
3.8
"BLD",7489,"KRN",9.2,0)
9.2
"BLD",7489,"KRN",9.8,0)
9.8
"BLD",7489,"KRN",9.8,"NM",0)
^9.68A^12^12
"BLD",7489,"KRN",9.8,"NM",1,0)
LA7SMU2A^^0^B11988192
"BLD",7489,"KRN",9.8,"NM",2,0)
LAMIAUT4^^0^B18820439
"BLD",7489,"KRN",9.8,"NM",3,0)
LA7CHKF1^^0^B91962013
"BLD",7489,"KRN",9.8,"NM",4,0)
LA7SMU2^^0^B27930322
"BLD",7489,"KRN",9.8,"NM",5,0)
LA80^^0^B5891361
"BLD",7489,"KRN",9.8,"NM",6,0)
LA7VORUB^^0^B55537548
"BLD",7489,"KRN",9.8,"NM",7,0)
LA7UIO^^0^B9916746
"BLD",7489,"KRN",9.8,"NM",8,0)
LA7VORU2^^0^B30167256
"BLD",7489,"KRN",9.8,"NM",9,0)
LA7VIN4A^^0^B19473776
"BLD",7489,"KRN",9.8,"NM",10,0)
LA7VMSG^^0^B45543754
"BLD",7489,"KRN",9.8,"NM",11,0)
LA7VIN7C^^0^B42479147
"BLD",7489,"KRN",9.8,"NM",12,0)
LA7VIN71^^0^B21704396
"BLD",7489,"KRN",9.8,"NM","B","LA7CHKF1",3)

"BLD",7489,"KRN",9.8,"NM","B","LA7SMU2",4)

"BLD",7489,"KRN",9.8,"NM","B","LA7SMU2A",1)

"BLD",7489,"KRN",9.8,"NM","B","LA7UIO",7)

"BLD",7489,"KRN",9.8,"NM","B","LA7VIN4A",9)

"BLD",7489,"KRN",9.8,"NM","B","LA7VIN71",12)

"BLD",7489,"KRN",9.8,"NM","B","LA7VIN7C",11)

"BLD",7489,"KRN",9.8,"NM","B","LA7VMSG",10)

"BLD",7489,"KRN",9.8,"NM","B","LA7VORU2",8)

"BLD",7489,"KRN",9.8,"NM","B","LA7VORUB",6)

"BLD",7489,"KRN",9.8,"NM","B","LA80",5)

"BLD",7489,"KRN",9.8,"NM","B","LAMIAUT4",2)

"BLD",7489,"KRN",19,0)
19
"BLD",7489,"KRN",19,"NM",0)
^9.68A^1^1
"BLD",7489,"KRN",19,"NM",1,0)
LA7TASK SCT MAPPINGS CHECK^^0
"BLD",7489,"KRN",19,"NM","B","LA7TASK SCT MAPPINGS CHECK",1)

"BLD",7489,"KRN",19.1,0)
19.1
"BLD",7489,"KRN",101,0)
101
"BLD",7489,"KRN",409.61,0)
409.61
"BLD",7489,"KRN",771,0)
771
"BLD",7489,"KRN",779.2,0)
779.2
"BLD",7489,"KRN",870,0)
870
"BLD",7489,"KRN",8989.51,0)
8989.51
"BLD",7489,"KRN",8989.51,"NM",0)
^9.68A^2^2
"BLD",7489,"KRN",8989.51,"NM",1,0)
LA LEDI ORM HL7 STATUS^^0
"BLD",7489,"KRN",8989.51,"NM",2,0)
LA LEDI ORU HL7 STATUS^^0
"BLD",7489,"KRN",8989.51,"NM","B","LA LEDI ORM HL7 STATUS",1)

"BLD",7489,"KRN",8989.51,"NM","B","LA LEDI ORU HL7 STATUS",2)

"BLD",7489,"KRN",8989.52,0)
8989.52
"BLD",7489,"KRN",8994,0)
8994
"BLD",7489,"KRN","B",.4,.4)

"BLD",7489,"KRN","B",.401,.401)

"BLD",7489,"KRN","B",.402,.402)

"BLD",7489,"KRN","B",.403,.403)

"BLD",7489,"KRN","B",.5,.5)

"BLD",7489,"KRN","B",.84,.84)

"BLD",7489,"KRN","B",3.6,3.6)

"BLD",7489,"KRN","B",3.8,3.8)

"BLD",7489,"KRN","B",9.2,9.2)

"BLD",7489,"KRN","B",9.8,9.8)

"BLD",7489,"KRN","B",19,19)

"BLD",7489,"KRN","B",19.1,19.1)

"BLD",7489,"KRN","B",101,101)

"BLD",7489,"KRN","B",409.61,409.61)

"BLD",7489,"KRN","B",771,771)

"BLD",7489,"KRN","B",779.2,779.2)

"BLD",7489,"KRN","B",870,870)

"BLD",7489,"KRN","B",8989.51,8989.51)

"BLD",7489,"KRN","B",8989.52,8989.52)

"BLD",7489,"KRN","B",8994,8994)

"BLD",7489,"QUES",0)
^9.62^^
"BLD",7489,"REQB",0)
^9.611^1^1
"BLD",7489,"REQB",1,0)
LA*5.2*74^2
"BLD",7489,"REQB","B","LA*5.2*74",1)

"FIA",62.47)
LAB CODE MAPPING
"FIA",62.47,0)
^LAB(62.47,
"FIA",62.47,0,0)
62.47
"FIA",62.47,0,1)
y^n^p^^^^n^^n
"FIA",62.47,0,10)

"FIA",62.47,0,11)

"FIA",62.47,0,"RLRO")

"FIA",62.47,0,"VR")
5.2^LA
"FIA",62.47,62.47)
1
"FIA",62.47,62.47,.001)

"FIA",62.47,62.47,.01)

"FIA",62.47,62.47,.04)

"FIA",62.47,62.47,1)

"FIA",62.47,62.4701)
1
"FIA",62.47,62.4701,.01)

"FIA",62.47,62.4701,.02)

"FIA",62.47,62.4701,.05)

"FIA",62.47,62.4701,2.1)

"FIA",62.47,62.4701,2.2)

"FIA",62.48)
LA7 MESSAGE PARAMETER
"FIA",62.48,0)
^LAHM(62.48,
"FIA",62.48,0,0)
62.48
"FIA",62.48,0,1)
y^n^p^^^^n^^n
"FIA",62.48,0,10)

"FIA",62.48,0,11)

"FIA",62.48,0,"RLRO")

"FIA",62.48,0,"VR")
5.2^LA
"FIA",62.48,62.48)
1
"FIA",62.48,62.48,30)

"FIA",62.48,62.482)
0
"INIT")
POST^LA80
"IX",62.47,62.47,"AC",0)
62.47^AC^Cross-reference used to lookup code/system for 'result' role.^MU^^R^IR^W^62.4701^^^^^S
"IX",62.47,62.47,"AC",.1,0)
^^1^1^3060125^
"IX",62.47,62.47,"AC",.1,1,0)

"IX",62.47,62.47,"AC",1)
S ^LAB(62.47,"AC",X(1),X(2),X(3),DA(1),DA)=""
"IX",62.47,62.47,"AC",1.4)
S X=$S(X(4)=1:1,1:0)
"IX",62.47,62.47,"AC",2)
K ^LAB(62.47,"AC",X(1),X(2),X(3),DA(1),DA)
"IX",62.47,62.47,"AC",2.5)
K ^LAB(62.47,"AC")
"IX",62.47,62.47,"AC",11.1,0)
^.114IA^4^4
"IX",62.47,62.47,"AC",11.1,1,0)
1^F^62.4701^.02^^1^F
"IX",62.47,62.47,"AC",11.1,2,0)
2^F^62.4701^.01^^2^F
"IX",62.47,62.47,"AC",11.1,3,0)
3^C^^^^3
"IX",62.47,62.47,"AC",11.1,3,1.5)
S X=$P($G(^LAB(62.47,DA(1),0)),U,3)
"IX",62.47,62.47,"AC",11.1,4,0)
4^F^62.4701^.03^^^F
"IX",62.47,62.47,"AC1",0)
62.47^AC1^Cross-reference used to lookup local, 'result' codes specific to an interface.^MU^^R^IR^W^62.4701^^^^^S
"IX",62.47,62.47,"AC1",.1,0)
^^2^2^3060207^^
"IX",62.47,62.47,"AC1",.1,1,0)

"IX",62.47,62.47,"AC1",.1,2,0)

"IX",62.47,62.47,"AC1",1)
S ^LAB(62.47,"AC1",X(1),X(2),X(3),X(4),DA(1),DA)=""
"IX",62.47,62.47,"AC1",1.4)
S X=$S((X(5)=1&(+X(6)=0)):1,1:0)
"IX",62.47,62.47,"AC1",2)
K ^LAB(62.47,"AC1",X(1),X(2),X(3),X(4),DA(1),DA)
"IX",62.47,62.47,"AC1",2.5)
K ^LAB(62.47,"AC1")
"IX",62.47,62.47,"AC1",11.1,0)
^.114IA^6^6
"IX",62.47,62.47,"AC1",11.1,1,0)
1^F^62.4701^2.2^^1^F
"IX",62.47,62.47,"AC1",11.1,2,0)
2^F^62.4701^.02^^2^F
"IX",62.47,62.47,"AC1",11.1,3,0)
3^F^62.4701^.01^^3^F
"IX",62.47,62.47,"AC1",11.1,4,0)
4^C^^^^4
"IX",62.47,62.47,"AC1",11.1,4,1.5)
S X=$P($G(^LAB(62.47,DA(1),0)),U,3)
"IX",62.47,62.47,"AC1",11.1,5,0)
5^F^62.4701^.03^^^F
"IX",62.47,62.47,"AC1",11.1,6,0)
6^F^62.4701^.05^^^F
"IX",62.47,62.47,"AC2",0)
62.47^AC2^Cross-reference used to lookup code/system for national, 'result' codes.^MU^^R^IR^W^62.4701^^^^^S
"IX",62.47,62.47,"AC2",1)
S ^LAB(62.47,"AC2",X(1),X(2),X(3),X(4),DA(1),DA)=""
"IX",62.47,62.47,"AC2",1.4)
S X=$S((X(5)=1&(X(6)=1)):1,1:0)
"IX",62.47,62.47,"AC2",2)
K ^LAB(62.47,"AC2",X(1),X(2),X(3),X(4),DA(1),DA)
"IX",62.47,62.47,"AC2",2.4)
Q
"IX",62.47,62.47,"AC2",2.5)
K ^LAB(62.47,"AC2")
"IX",62.47,62.47,"AC2",11.1,0)
^.114IA^6^6
"IX",62.47,62.47,"AC2",11.1,1,0)
1^C^^^^1^F
"IX",62.47,62.47,"AC2",11.1,1,1.5)
S X=$P($G(^LAB(62.47,DA(1),0)),U,2)
"IX",62.47,62.47,"AC2",11.1,2,0)
2^F^62.4701^.02^^2^F
"IX",62.47,62.47,"AC2",11.1,3,0)
3^F^62.4701^.01^^3^F
"IX",62.47,62.47,"AC2",11.1,4,0)
4^C^^^^4
"IX",62.47,62.47,"AC2",11.1,4,1.5)
S X=$P($G(^LAB(62.47,DA(1),0)),U,3)
"IX",62.47,62.47,"AC2",11.1,5,0)
5^F^62.4701^.03^^^F
"IX",62.47,62.47,"AC2",11.1,6,0)
6^F^62.4701^.05^^^F
"IX",62.47,62.47,"AD",0)
62.47^AD^Cross-reference to lookup codes used for 'answer' role.^MU^^R^IR^W^62.4701^^^^^S
"IX",62.47,62.47,"AD",1)
S ^LAB(62.47,"AD",DA(1),X(1),X(2),X(3),DA)=""
"IX",62.47,62.47,"AD",1.4)
S X=$S(X(4)=2:1,1:0)
"IX",62.47,62.47,"AD",2)
K ^LAB(62.47,"AD",DA(1),X(1),X(2),X(3),DA)
"IX",62.47,62.47,"AD",2.5)
K ^LAB(62.47,"AD")
"IX",62.47,62.47,"AD",11.1,0)
^.114IA^4^4
"IX",62.47,62.47,"AD",11.1,1,0)
1^F^62.4701^.02^^1^F
"IX",62.47,62.47,"AD",11.1,2,0)
2^F^62.4701^.01^^2^F
"IX",62.47,62.47,"AD",11.1,3,0)
3^F^62.4701^.04^^3^F
"IX",62.47,62.47,"AD",11.1,4,0)
4^F^62.4701^.03^^^F
"IX",62.47,62.47,"AD1",0)
62.47^AD1^Cross-reference used to lookup local, 'answer' codes specific to an interface.^MU^^R^IR^W^62.4701^^^^^S
"IX",62.47,62.47,"AD1",.1,0)
^^1^1^3060207^
"IX",62.47,62.47,"AD1",.1,1,0)

"IX",62.47,62.47,"AD1",1)
S ^LAB(62.47,"AD1",DA(1),X(1),X(2),X(3),X(4),DA)=""
"IX",62.47,62.47,"AD1",1.4)
S X=$S((X(5)=2&(X(6)=0)):1,1:0)
"IX",62.47,62.47,"AD1",2)
K ^LAB(62.47,"AD1",DA(1),X(1),X(2),X(3),X(4),DA)
"IX",62.47,62.47,"AD1",2.5)
K ^LAB(62.47,"AD1")
"IX",62.47,62.47,"AD1",11.1,0)
^.114IA^6^6
"IX",62.47,62.47,"AD1",11.1,1,0)
1^F^62.4701^2.2^^1^F
"IX",62.47,62.47,"AD1",11.1,2,0)
2^F^62.4701^.02^^2^F
"IX",62.47,62.47,"AD1",11.1,3,0)
3^F^62.4701^.01^^3^F
"IX",62.47,62.47,"AD1",11.1,4,0)
4^C^^^^4
"IX",62.47,62.47,"AD1",11.1,4,1.5)
S X=$P($G(^LAB(62.47,DA(1),0)),U,3)
"IX",62.47,62.47,"AD1",11.1,5,0)
5^F^62.4701^.03^^^F
"IX",62.47,62.47,"AD1",11.1,6,0)
6^F^62.4701^.05^^^F
"IX",62.47,62.47,"AF",0)
62.47^AF^CODING SYSTEM used.^R^^R^IR^W^62.4701^^^^^S
"IX",62.47,62.47,"AF",.1,0)
^^6^6^3060429^
"IX",62.47,62.47,"AF",.1,1,0)
^LAB(62.47,"AF",CODING SYSTEM,IDENTIFIER,DA(1),DA)
"IX",62.47,62.47,"AF",.1,2,0)
 
"IX",62.47,62.47,"AF",.1,3,0)
All CODING SYSTEMs and IDENTIFIERs in the file.  This is used primarily to
"IX",62.47,62.47,"AF",.1,4,0)
flag entries in File #61.2 that have their SNOMED CT ID mapped in this
"IX",62.47,62.47,"AF",.1,5,0)
file.  This alerts the user that the #61.2 entry is in use for their LEDI
"IX",62.47,62.47,"AF",.1,6,0)
system and should not be changed without updating file #62.47.
"IX",62.47,62.47,"AF",1)
S ^LAB(62.47,"AF",$E(X(1),1,30),$E(X(2),1,30),DA(1),DA)=""
"IX",62.47,62.47,"AF",1.4)

"IX",62.47,62.47,"AF",2)
K ^LAB(62.47,"AF",$E(X(1),1,30),$E(X(2),1,30),DA(1),DA)
"IX",62.47,62.47,"AF",2.4)

"IX",62.47,62.47,"AF",2.5)
K ^LAB(62.47,"AF")
"IX",62.47,62.47,"AF",11.1,0)
^.114IA^2^2
"IX",62.47,62.47,"AF",11.1,1,0)
1^F^62.4701^.02^30^1^F
"IX",62.47,62.47,"AF",11.1,2,0)
2^F^62.4701^.01^30^2^F
"IX",62.47,62.47,"AH",0)
62.47^AH^Whole file IDENTIFIER index^R^^F^IR^W^62.4701^^^^^S
"IX",62.47,62.47,"AH",.1,0)
^^2^2^3061011^
"IX",62.47,62.47,"AH",.1,1,0)
Used primarily with Option LA7V 62.47 FIND IDENTIFIER that allows the 
"IX",62.47,62.47,"AH",.1,2,0)
user to display all #62.47 entries for a specific Identifier.
"IX",62.47,62.47,"AH",1)
S ^LAB(62.47,"AH",$E(X,1,30),DA(1),DA)=""
"IX",62.47,62.47,"AH",2)
K ^LAB(62.47,"AH",$E(X,1,30),DA(1),DA)
"IX",62.47,62.47,"AH",2.5)
K ^LAB(62.47,"AH")
"IX",62.47,62.47,"AH",11.1,0)
^.114IA^1^1
"IX",62.47,62.47,"AH",11.1,1,0)
1^F^62.4701^.01^30^1^F
"IX",62.48,62.482,"AC",0)
62.482^AC^Cross-reference by file type and SNOMED CT ID.^R^^R^IR^I^62.482^^^^^S
"IX",62.48,62.482,"AC",1)
S ^LAHM(62.48,DA(1),"SCT","AC",X(1),X(2),DA)=""
"IX",62.48,62.482,"AC",2)
K ^LAHM(62.48,DA(1),"SCT","AC",X(1),X(2),DA)
"IX",62.48,62.482,"AC",2.5)
K ^LAHM(62.48,DA(1),"SCT","AC")
"IX",62.48,62.482,"AC",11.1,0)
^.114IA^2^2
"IX",62.48,62.482,"AC",11.1,1,0)
1^F^62.482^.01^^1^F
"IX",62.48,62.482,"AC",11.1,2,0)
2^F^62.482^.02^^2^F
"IX",62.48,62.482,"AD",0)
62.482^AD^Cross-reference by SNOMED CT ID and file type.^R^^R^IR^I^62.482^^^^^S
"IX",62.48,62.482,"AD",1)
S ^LAHM(62.48,DA(1),"SCT","AD",X(1),X(2),DA)=""
"IX",62.48,62.482,"AD",2)
K ^LAHM(62.48,DA(1),"SCT","AD",X(1),X(2),DA)
"IX",62.48,62.482,"AD",2.5)
K ^LAHM(62.48,DA(1),"SCT","AD")
"IX",62.48,62.482,"AD",11.1,0)
^.114IA^2^2
"IX",62.48,62.482,"AD",11.1,1,0)
1^F^62.482^.02^^1^F
"IX",62.48,62.482,"AD",11.1,2,0)
2^F^62.482^.01^^2^F
"IX",62.48,62.482,"AD1",0)
62.482^AD1^Cross-reference by SNOMED CT ID and file type for file #61 entries.^R^^R^IR^I^62.482^^^^^S
"IX",62.48,62.482,"AD1",1)
S ^LAHM(62.48,DA(1),"SCT","AD1",X(1),X(2),DA)=""
"IX",62.48,62.482,"AD1",1.4)
S X=$S($P(X(2),";",2)="LAB(61,":1,1:0)
"IX",62.48,62.482,"AD1",2)
K ^LAHM(62.48,DA(1),"SCT","AD1",X(1),X(2),DA)
"IX",62.48,62.482,"AD1",2.5)
K ^LAHM(62.48,DA(1),"SCT","AD1")
"IX",62.48,62.482,"AD1",11.1,0)
^.114IA^2^2
"IX",62.48,62.482,"AD1",11.1,1,0)
1^F^62.482^.02^^1^F
"IX",62.48,62.482,"AD1",11.1,2,0)
2^F^62.482^.01^^2^F
"IX",62.48,62.482,"AD2",0)
62.482^AD2^Cross-reference by SNOMED CT ID and file type for file #62 entries.^R^^R^IR^I^62.482^^^^^S
"IX",62.48,62.482,"AD2",1)
S ^LAHM(62.48,DA(1),"SCT","AD2",X(1),X(2),DA)=""
"IX",62.48,62.482,"AD2",1.4)
S X=$S($P(X(2),";",2)="LAB(62,":1,1:0)
"IX",62.48,62.482,"AD2",2)
K ^LAHM(62.48,DA(1),"SCT","AD2",X(1),X(2),DA)
"IX",62.48,62.482,"AD2",2.5)
K ^LAHM(62.48,DA(1),"SCT","AD2")
"IX",62.48,62.482,"AD2",11.1,0)
^.114IA^2^2
"IX",62.48,62.482,"AD2",11.1,1,0)
1^F^62.482^.02^^1^F
"IX",62.48,62.482,"AD2",11.1,2,0)
2^F^62.482^.01^^2^F
"KRN",19,14869,-1)
0^1
"KRN",19,14869,0)
LA7TASK SCT MAPPINGS CHECK^Check SNOMED CT Mappings Against the Lexicon^^R^^^^^^^^LAB MESSAGING
"KRN",19,14869,1,0)
^^12^12^3121231^
"KRN",19,14869,1,1,0)
This option checks the SNOMED CT mappings against the Lexicon for 
"KRN",19,14869,1,2,0)
exceptions (e.g., a code is inactive). It checks the following files:
"KRN",19,14869,1,3,0)
 - TOPOGRAPHY FIELD (#61)
"KRN",19,14869,1,4,0)
 - ETIOLOGY FIELD (#61.2)
"KRN",19,14869,1,5,0)
 - COLLECTION SAMPLE (#62)
"KRN",19,14869,1,6,0)
 
"KRN",19,14869,1,7,0)
If any exceptions are found:
"KRN",19,14869,1,8,0)
 - The SCT CODE STATUS field (#21) for the entry will be updated to 
"KRN",19,14869,1,9,0)
   'Error'.
"KRN",19,14869,1,10,0)
 - A HDI exception alert will be sent to Standards & Terminology Services.
"KRN",19,14869,1,11,0)
 - A MailMan message will be sent to the G.LMI and G.LAB MESSAGING Mail
"KRN",19,14869,1,12,0)
   Groups with a list of the exceptions found.
"KRN",19,14869,25)
EN^LA7CHKF1
"KRN",19,14869,200.9)
y
"KRN",19,14869,"U")
CHECK SNOMED CT MAPPINGS AGAIN
"KRN",8989.5,3849,0)
53;DIC(9.4,^LA LEDI ORU HL7 STATUS^1
"KRN",8989.5,3849,1)
5
"KRN",8989.5,3850,0)
53;DIC(9.4,^LA LEDI ORU HL7 STATUS^2
"KRN",8989.5,3850,1)
5
"KRN",8989.5,3851,0)
53;DIC(9.4,^LA LEDI ORU HL7 STATUS^3
"KRN",8989.5,3851,1)
5
"KRN",8989.5,3852,0)
53;DIC(9.4,^LA LEDI ORU HL7 STATUS^4
"KRN",8989.5,3852,1)
5
"KRN",8989.5,3853,0)
53;DIC(9.4,^LA LEDI ORU HL7 STATUS^5
"KRN",8989.5,3853,1)
5
"KRN",8989.5,3854,0)
53;DIC(9.4,^LA LEDI ORU HL7 STATUS^6
"KRN",8989.5,3854,1)
5
"KRN",8989.5,3855,0)
53;DIC(9.4,^LA LEDI ORU HL7 STATUS^7
"KRN",8989.5,3855,1)
5
"KRN",8989.5,3856,0)
53;DIC(9.4,^LA LEDI ORU HL7 STATUS^8
"KRN",8989.5,3856,1)
5
"KRN",8989.5,3857,0)
53;DIC(9.4,^LA LEDI ORM HL7 STATUS^1
"KRN",8989.5,3857,1)
1
"KRN",8989.5,3858,0)
53;DIC(9.4,^LA LEDI ORM HL7 STATUS^2
"KRN",8989.5,3858,1)
1
"KRN",8989.5,3859,0)
53;DIC(9.4,^LA LEDI ORM HL7 STATUS^3
"KRN",8989.5,3859,1)
1
"KRN",8989.5,3860,0)
53;DIC(9.4,^LA LEDI ORM HL7 STATUS^4
"KRN",8989.5,3860,1)
1
"KRN",8989.5,3861,0)
53;DIC(9.4,^LA LEDI ORM HL7 STATUS^5
"KRN",8989.5,3861,1)
1
"KRN",8989.5,3862,0)
53;DIC(9.4,^LA LEDI ORM HL7 STATUS^6
"KRN",8989.5,3862,1)
1
"KRN",8989.5,3863,0)
53;DIC(9.4,^LA LEDI ORM HL7 STATUS^7
"KRN",8989.5,3863,1)
1
"KRN",8989.5,3864,0)
53;DIC(9.4,^LA LEDI ORM HL7 STATUS^8
"KRN",8989.5,3864,1)
1
"KRN",8989.51,533,-1)
0^2
"KRN",8989.51,533,0)
LA LEDI ORU HL7 STATUS^LEDI HL7 Result Messaging Status^1^LEDI Result Messaging Status For Agency^Interface Status^1
"KRN",8989.51,533,1)
S^0:Disabled;1:Enabled;2:CH Only;3:MI Only;4:AP Only;5:CH/MI;6:CH/AP;7:MI/AP^Specify the areas of Laboratory which LEDI supports.
"KRN",8989.51,533,4,0)
^8989.514^1^1
"KRN",8989.51,533,4,1,0)
LEDI
"KRN",8989.51,533,4,"B","LEDI",1)

"KRN",8989.51,533,6)
P^4.11
"KRN",8989.51,533,20,0)
^^17^17^3120622^
"KRN",8989.51,533,20,1,0)
This parameter is used to control the building of LEDI HL7 result messages
"KRN",8989.51,533,20,2,0)
on an interface basis for specific messaging partners based on the AGENCY
"KRN",8989.51,533,20,3,0)
associated with the interface. It allows for the selective
"KRN",8989.51,533,20,4,0)
enabling/disabling of either all result messaging or just result messaging
"KRN",8989.51,533,20,5,0)
in support of specific areas of VistA Laboratory.
"KRN",8989.51,533,20,6,0)
 
"KRN",8989.51,533,20,7,0)
It currently allows for control of the main laboratory areas, also 
"KRN",8989.51,533,20,8,0)
referred to as subscripts or a combination.
"KRN",8989.51,533,20,9,0)
 
"KRN",8989.51,533,20,10,0)
The areas are:
"KRN",8989.51,533,20,11,0)
 'CH' = laboratory tests within the "CH" subscript of LAB DATA file (#63).
"KRN",8989.51,533,20,12,0)
 'MI' = laboratory tests within the "MI" subscript of LAB DATA file (#63).
"KRN",8989.51,533,20,13,0)
 'AP' = laboratory tests within the "SP", "CY", and "EM" subscript of LAB
"KRN",8989.51,533,20,14,0)
        DATA file (#63).
"KRN",8989.51,533,20,15,0)
 
"KRN",8989.51,533,20,16,0)
Selecting "Disabled" disables all sections of laboratory.
"KRN",8989.51,533,20,17,0)
Selecting "Enabled" enables all three main sections ("CH", "MI", and "AP")
"KRN",8989.51,533,30,0)
^8989.513I^1^1
"KRN",8989.51,533,30,1,0)
1^9.4
"KRN",8989.51,534,-1)
0^1
"KRN",8989.51,534,0)
LA LEDI ORM HL7 STATUS^LEDI HL7 Order Messaging Status^1^LEDI Order Messaging Status For Agency^Interface Status^1
"KRN",8989.51,534,1)
S^0:Disabled;1:Enabled;2:CH Only;3:MI Only;4:AP Only;5:CH/MI;6:CH/AP;7:MI/AP^Specify the areas of Laboratory which LEDI supports.
"KRN",8989.51,534,4,0)
^8989.514^1^1
"KRN",8989.51,534,4,1,0)
LEDI
"KRN",8989.51,534,4,"B","LEDI",1)

"KRN",8989.51,534,6)
P^4.11
"KRN",8989.51,534,20,0)
^^17^17^3120622^
"KRN",8989.51,534,20,1,0)
This parameter is used to control the building of LEDI HL7 order messages
"KRN",8989.51,534,20,2,0)
on an interface basis for specific messaging partners based on the AGENCY
"KRN",8989.51,534,20,3,0)
associated with the interface. It allows for the selective
"KRN",8989.51,534,20,4,0)
enabling/disabling of either all order messaging or just order messaging
"KRN",8989.51,534,20,5,0)
in support of specific areas of VistA Laboratory.
"KRN",8989.51,534,20,6,0)
 
"KRN",8989.51,534,20,7,0)
It currently allows for control of the main laboratory areas, also 
"KRN",8989.51,534,20,8,0)
referred to as subscripts or a combination.
"KRN",8989.51,534,20,9,0)
 
"KRN",8989.51,534,20,10,0)
The areas are:
"KRN",8989.51,534,20,11,0)
 'CH' = laboratory tests within the "CH" subscript of LAB DATA file (#63).
"KRN",8989.51,534,20,12,0)
 'MI' = laboratory tests within the "MI" subscript of LAB DATA file (#63).
"KRN",8989.51,534,20,13,0)
 'AP' = laboratory tests within the "SP", "CY", and "EM" subscript of LAB
"KRN",8989.51,534,20,14,0)
        DATA file (#63).
"KRN",8989.51,534,20,15,0)
 
"KRN",8989.51,534,20,16,0)
Selecting "Disabled" disables all sections of laboratory.
"KRN",8989.51,534,20,17,0)
Selecting "Enabled" enables all three main sections ("CH", "MI", and "AP")
"KRN",8989.51,534,30,0)
^8989.513I^1^1
"KRN",8989.51,534,30,1,0)
1^9.4
"MBREQ")
0
"ORD",18,19)
19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA
"ORD",18,19,0)
OPTION
"ORD",20,8989.51)
8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%)
"ORD",20,8989.51,0)
PARAMETER DEFINITION
"PKG",53,-1)
1^1
"PKG",53,0)
AUTOMATED LAB INSTRUMENTS^LA^Lab Auto-Instrument Package
"PKG",53,20,0)
^9.402P^^
"PKG",53,22,0)
^9.49I^1^1
"PKG",53,22,1,0)
5.2^2940927^2950125
"PKG",53,22,1,"PAH",1,0)
80^3130819
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
12
"RTN","LA7CHKF1")
0^3^B91962013
"RTN","LA7CHKF1",1,0)
LA7CHKF1 ;DALOI/LMT - Check SNOMED CT mappings against Lexicon for exceptions ;01/10/13  08:56
"RTN","LA7CHKF1",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**80**;Sep 27, 1994;Build 19
"RTN","LA7CHKF1",3,0)
 ;
"RTN","LA7CHKF1",4,0)
 ;
"RTN","LA7CHKF1",5,0)
 ; This routine checks the SNOMED CT mappings against the Lexicon for exceptions.
"RTN","LA7CHKF1",6,0)
 ; It checks the following files:
"RTN","LA7CHKF1",7,0)
 ;   - Topography Field (#61)
"RTN","LA7CHKF1",8,0)
 ;   - Etiology Field (#61.2)
"RTN","LA7CHKF1",9,0)
 ;   - Collection Sample (#62)
"RTN","LA7CHKF1",10,0)
 ;
"RTN","LA7CHKF1",11,0)
 ; If any exceptions are found:
"RTN","LA7CHKF1",12,0)
 ;    - the SCT CODE STATUS field for the entry will be updated to 'Error'
"RTN","LA7CHKF1",13,0)
 ;    - an HDI exception alert will be sent to STS
"RTN","LA7CHKF1",14,0)
 ;    - a MailMan message will be sent to the local staff with a list of all the exceptions found
"RTN","LA7CHKF1",15,0)
 ;
"RTN","LA7CHKF1",16,0)
 ; ZEXCEPT is used to identify variables which are external to a specific TAG
"RTN","LA7CHKF1",17,0)
 ;         used in conjunction with Eclipse M-editor.
"RTN","LA7CHKF1",18,0)
 ;
"RTN","LA7CHKF1",19,0)
 ;
"RTN","LA7CHKF1",20,0)
EN ; Entry point
"RTN","LA7CHKF1",21,0)
 ;
"RTN","LA7CHKF1",22,0)
 ;ZEXCEPT: ZTQUEUED
"RTN","LA7CHKF1",23,0)
 ;
"RTN","LA7CHKF1",24,0)
 N LACNT,LAFIEN,LAFILE,LALINE,LASCT,X
"RTN","LA7CHKF1",25,0)
 ;
"RTN","LA7CHKF1",26,0)
 D CLEAN ;kill TMP global
"RTN","LA7CHKF1",27,0)
 ;
"RTN","LA7CHKF1",28,0)
 S LACNT=0
"RTN","LA7CHKF1",29,0)
 ;
"RTN","LA7CHKF1",30,0)
 ;loop through "F" x-ref on files 61,61.2,62
"RTN","LA7CHKF1",31,0)
 F LAFILE=61,61.2,62 D
"RTN","LA7CHKF1",32,0)
 . S LASCT=""
"RTN","LA7CHKF1",33,0)
 . F  S LASCT=$O(^LAB(LAFILE,"F",LASCT)) Q:LASCT=""  D
"RTN","LA7CHKF1",34,0)
 . . ;
"RTN","LA7CHKF1",35,0)
 . . S LAFIEN=0
"RTN","LA7CHKF1",36,0)
 . . F  S LAFIEN=$O(^LAB(LAFILE,"F",LASCT,LAFIEN)) Q:'LAFIEN  D
"RTN","LA7CHKF1",37,0)
 . . . ;
"RTN","LA7CHKF1",38,0)
 . . . S LACNT=LACNT+1
"RTN","LA7CHKF1",39,0)
 . . . I '(LACNT#100) H 1 ; take a "rest" - allow OS to swap out process
"RTN","LA7CHKF1",40,0)
 . . . I '$D(ZTQUEUED) W:'(LACNT#50) "."
"RTN","LA7CHKF1",41,0)
 . . . ;
"RTN","LA7CHKF1",42,0)
 . . . D CHECK(LAFILE,LAFIEN,LASCT) ; Check entry against lexicon
"RTN","LA7CHKF1",43,0)
 ;
"RTN","LA7CHKF1",44,0)
 ; Send MailMan message to local staff if any exceptions were found.
"RTN","LA7CHKF1",45,0)
 I $D(^TMP("LA7CHK",$J,"MSG"))!($D(^TMP("LA7CHK",$J,"ERR"))) S X=$$SENDMSG
"RTN","LA7CHKF1",46,0)
 ;
"RTN","LA7CHKF1",47,0)
 D CLEAN
"RTN","LA7CHKF1",48,0)
 ;
"RTN","LA7CHKF1",49,0)
 Q
"RTN","LA7CHKF1",50,0)
 ;
"RTN","LA7CHKF1",51,0)
CHECK(LAFILE,LAFIEN,LASCT) ; Check Entry against Lexicon
"RTN","LA7CHKF1",52,0)
 ;
"RTN","LA7CHKF1",53,0)
 N LAALRTST,LACODEINFO,LALEX,LALEXERR,LALEXSTAT,LANAME,LASCTSTAT
"RTN","LA7CHKF1",54,0)
 ;
"RTN","LA7CHKF1",55,0)
 S LANAME=$P($G(^LAB(LAFILE,LAFIEN,0)),U,1)
"RTN","LA7CHKF1",56,0)
 ;
"RTN","LA7CHKF1",57,0)
 S LACODEINFO=$$CODE^LRSCT(LASCT,"SCT",DT,"LALEX")
"RTN","LA7CHKF1",58,0)
 S LALEXSTAT=$P(LACODEINFO,U,1)
"RTN","LA7CHKF1",59,0)
 S LALEXERR=""
"RTN","LA7CHKF1",60,0)
 I LALEXSTAT<0 S LALEXERR=$P(LACODEINFO,U,2)
"RTN","LA7CHKF1",61,0)
 I $P($G(LALEX(0)),U,1)="" S $P(LALEX(0),U,1)=LASCT
"RTN","LA7CHKF1",62,0)
 ;
"RTN","LA7CHKF1",63,0)
 S LASCTSTAT=$$GET1^DIQ(LAFILE,LAFIEN_",",21,"I")
"RTN","LA7CHKF1",64,0)
 I LASCTSTAT="E" Q  ; Alert was already sent - don't send duplicate alert
"RTN","LA7CHKF1",65,0)
 ;
"RTN","LA7CHKF1",66,0)
 I LASCTSTAT="LN",LALEXSTAT=-1 Q  ; Code still does not exist in Lexicon. Don't send duplicate alert.
"RTN","LA7CHKF1",67,0)
 I LASCTSTAT="LN",LALEXSTAT=1 D  Q  ; Code now exists in the Lexicon. Update SCT CODE STATUS field and Quit.
"RTN","LA7CHKF1",68,0)
 . N LASTATUS
"RTN","LA7CHKF1",69,0)
 . ;
"RTN","LA7CHKF1",70,0)
 . S LASTATUS="L" ; Default [L] = The spelling is not standard
"RTN","LA7CHKF1",71,0)
 . I $$UP^XLFSTR(LANAME)=$$UP^XLFSTR($G(LALEX("P"))) S LASTATUS="P" ; preferred term
"RTN","LA7CHKF1",72,0)
 . I $$UP^XLFSTR(LANAME)=$$UP^XLFSTR($G(LALEX("F"))) S LASTATUS="P" ; preferred term
"RTN","LA7CHKF1",73,0)
 . I LASTATUS'="P",$O(LALEX("S",0)) D  ; Check to see if term is a synonym
"RTN","LA7CHKF1",74,0)
 . . N I
"RTN","LA7CHKF1",75,0)
 . . S I=0
"RTN","LA7CHKF1",76,0)
 . . F  S I=$O(LALEX("S",I)) Q:I<1  I $$UP^XLFSTR(LANAME)=$$UP^XLFSTR(LALEX("S",I)) S LASTATUS="S" Q
"RTN","LA7CHKF1",77,0)
 . . ;
"RTN","LA7CHKF1",78,0)
 . D UPDSTAT(LAFILE,LAFIEN,LASTATUS,"")
"RTN","LA7CHKF1",79,0)
 ;
"RTN","LA7CHKF1",80,0)
 I LALEXSTAT<0 D
"RTN","LA7CHKF1",81,0)
 . S LAALRTST=$$SNDALERT(LAFILE,LAFIEN,LANAME,LASCT,LACODEINFO) ; Send HDI alert to STS
"RTN","LA7CHKF1",82,0)
 . D BLDMSG(LAFILE,LAFIEN,LANAME,.LALEX,LACODEINFO,LAALRTST) ; build mailman message
"RTN","LA7CHKF1",83,0)
 . D UPDSTAT(LAFILE,LAFIEN,"E",LALEXERR,$P(LAALRTST,U,4)) ; update SCT CODE STATUS to 'Error'
"RTN","LA7CHKF1",84,0)
 ;
"RTN","LA7CHKF1",85,0)
 Q
"RTN","LA7CHKF1",86,0)
 ;
"RTN","LA7CHKF1",87,0)
SNDALERT(LAFILE,LAFIEN,LANAME,LASCT,LACODEINFO) ; Build alert that will be sent to STS. Return alert status.
"RTN","LA7CHKF1",88,0)
 ;
"RTN","LA7CHKF1",89,0)
 N EXCDATA,LAALRTST,LADATA,TNUM,X
"RTN","LA7CHKF1",90,0)
 ;
"RTN","LA7CHKF1",91,0)
 ; Lab mapping exception
"RTN","LA7CHKF1",92,0)
 S EXCDATA("TXT")=$P(LACODEINFO,U,2)
"RTN","LA7CHKF1",93,0)
 ;
"RTN","LA7CHKF1",94,0)
 S LAALRTST=$$NOTIFY^LRSCTF1(LANAME,LAFILE,LAFIEN,LASCT,.EXCDATA,0)
"RTN","LA7CHKF1",95,0)
 S TNUM=$G(EXCDATA("TNUM"))
"RTN","LA7CHKF1",96,0)
 S $P(LAALRTST,U,4)=TNUM
"RTN","LA7CHKF1",97,0)
 ;
"RTN","LA7CHKF1",98,0)
 Q LAALRTST
"RTN","LA7CHKF1",99,0)
 ;
"RTN","LA7CHKF1",100,0)
BLDMSG(LAFILE,LAFIEN,LANAME,LALEX,LACODEINFO,LAALRTST) ; Build additional message text
"RTN","LA7CHKF1",101,0)
 ;
"RTN","LA7CHKF1",102,0)
 N I,LACODETXT,LAERROR,LAMSGSUB
"RTN","LA7CHKF1",103,0)
 ;
"RTN","LA7CHKF1",104,0)
 S LAMSGSUB="MSG"
"RTN","LA7CHKF1",105,0)
 ;
"RTN","LA7CHKF1",106,0)
 I $D(LAALRTST),'LAALRTST,$P(LAALRTST,U,2)=5 S LAERROR=1,LAMSGSUB="ERR"
"RTN","LA7CHKF1",107,0)
 ;
"RTN","LA7CHKF1",108,0)
 ; Format 'Code Text' to display nicely on multiple lines
"RTN","LA7CHKF1",109,0)
 D FRMTTXT($G(LALEX("F")),1,60,.LACODETXT)
"RTN","LA7CHKF1",110,0)
 ;
"RTN","LA7CHKF1",111,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))=""
"RTN","LA7CHKF1",112,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="  "_$$REPEAT^XLFSTR("-",76)
"RTN","LA7CHKF1",113,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))=""
"RTN","LA7CHKF1",114,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="            File #: "_LAFILE
"RTN","LA7CHKF1",115,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="             IEN #: "_LAFIEN
"RTN","LA7CHKF1",116,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="        Entry Name: "_LANAME
"RTN","LA7CHKF1",117,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="      SNOMED CT ID: "_$P(LALEX(0),U,1)
"RTN","LA7CHKF1",118,0)
 I $G(LALEX("F"))'="" D
"RTN","LA7CHKF1",119,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="    SNOMED CT Term: "_$G(LACODETXT(1,0))
"RTN","LA7CHKF1",120,0)
 . S I=1
"RTN","LA7CHKF1",121,0)
 . F  S I=$O(LACODETXT(I)) Q:'I  D
"RTN","LA7CHKF1",122,0)
 . . I $G(LACODETXT(I,0))'="" D
"RTN","LA7CHKF1",123,0)
 . . . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="                    "_$G(LACODETXT(I,0))
"RTN","LA7CHKF1",124,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="             Error: "_$P(LACODEINFO,U,2)
"RTN","LA7CHKF1",125,0)
 I $G(LAERROR) D
"RTN","LA7CHKF1",126,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="  STS Alert Failed: "_$P(LAALRTST,"^",3)
"RTN","LA7CHKF1",127,0)
 I '$G(LAERROR),$P($G(LAALRTST),U,4)'="" D
"RTN","LA7CHKF1",128,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))=" STS Transaction #: "_$P(LAALRTST,U,4)
"RTN","LA7CHKF1",129,0)
 ;
"RTN","LA7CHKF1",130,0)
 Q
"RTN","LA7CHKF1",131,0)
 ;
"RTN","LA7CHKF1",132,0)
UPDSTAT(LAFILE,LAFIEN,LASTATUS,LALEXERR,LATNUM) ; Update SCT CODE STATUS field
"RTN","LA7CHKF1",133,0)
 ;
"RTN","LA7CHKF1",134,0)
 N LAERR,LAFDA,LRFMERTS
"RTN","LA7CHKF1",135,0)
 ;
"RTN","LA7CHKF1",136,0)
 I $G(LASTATUS)="" Q
"RTN","LA7CHKF1",137,0)
 ; Lock file entry prior to updating
"RTN","LA7CHKF1",138,0)
 F  L +^LAB(LAFILE,LAFIEN):DILOCKTM+15 Q:$T
"RTN","LA7CHKF1",139,0)
 ;
"RTN","LA7CHKF1",140,0)
 ; Stop AERT xref from triggering alert (from ^LRERT1)
"RTN","LA7CHKF1",141,0)
 S LRFMERTS=1
"RTN","LA7CHKF1",142,0)
 S LRFMERTS("STS","STAT")="OK"
"RTN","LA7CHKF1",143,0)
 S LRFMERTS("STS","PROC")="CHECK"
"RTN","LA7CHKF1",144,0)
 ;
"RTN","LA7CHKF1",145,0)
 ; Update Status
"RTN","LA7CHKF1",146,0)
 S LAFDA(1,LAFILE,LAFIEN_",",21)=LASTATUS
"RTN","LA7CHKF1",147,0)
 D FILE^DIE("","LAFDA(1)","LAERR(1)")
"RTN","LA7CHKF1",148,0)
 ;
"RTN","LA7CHKF1",149,0)
 ; Update SCT STATUS DATE multiple
"RTN","LA7CHKF1",150,0)
 D SCTUPD(LAFILE,LAFIEN,LASTATUS,$G(LALEXERR),$G(LATNUM))
"RTN","LA7CHKF1",151,0)
 ;
"RTN","LA7CHKF1",152,0)
 L -^LAB(LAFILE,LAFIEN)
"RTN","LA7CHKF1",153,0)
 ;
"RTN","LA7CHKF1",154,0)
 Q
"RTN","LA7CHKF1",155,0)
 ;
"RTN","LA7CHKF1",156,0)
SCTUPD(LAFILE,LAFIEN,LASTATUS,LALEXERR,LATNUM) ; Update SCT STATUS DATE multiple
"RTN","LA7CHKF1",157,0)
 ;
"RTN","LA7CHKF1",158,0)
 N LACNT,LAERR,LAFDA,LASUBFILE,LAWP
"RTN","LA7CHKF1",159,0)
 ;
"RTN","LA7CHKF1",160,0)
 S LASUBFILE=$S(LAFILE=61:61.023,LAFILE=61.2:61.223,LAFILE=62:62.023,1:"")
"RTN","LA7CHKF1",161,0)
 I LASUBFILE="" Q
"RTN","LA7CHKF1",162,0)
 ;
"RTN","LA7CHKF1",163,0)
 ; Store date/time, user and new status
"RTN","LA7CHKF1",164,0)
 S LAFDA(2,LASUBFILE,"+2,"_LAFIEN_",",.01)=$$NOW^XLFDT
"RTN","LA7CHKF1",165,0)
 S LAFDA(2,LASUBFILE,"+2,"_LAFIEN_",",1)=LASTATUS
"RTN","LA7CHKF1",166,0)
 S LAFDA(2,LASUBFILE,"+2,"_LAFIEN_",",3)=DUZ
"RTN","LA7CHKF1",167,0)
 ; Store transaction number
"RTN","LA7CHKF1",168,0)
 I $G(LATNUM)'="" S LAFDA(2,LASUBFILE,"+2,"_LAFIEN_",",2)=LATNUM
"RTN","LA7CHKF1",169,0)
 ;
"RTN","LA7CHKF1",170,0)
 D UPDATE^DIE("","LAFDA(2)","LAFIEN","LAERR(2)")
"RTN","LA7CHKF1",171,0)
 ;
"RTN","LA7CHKF1",172,0)
 I '$G(LAFIEN(2)) Q
"RTN","LA7CHKF1",173,0)
 ;
"RTN","LA7CHKF1",174,0)
 S LACNT=1
"RTN","LA7CHKF1",175,0)
 S LAWP(LACNT)="SCT CODE STATUS updated by system due to current status in the Lexicon."
"RTN","LA7CHKF1",176,0)
 S LACNT=LACNT+1
"RTN","LA7CHKF1",177,0)
 ; Record any reported Lexicon API error
"RTN","LA7CHKF1",178,0)
 I $G(LALEXERR)'="" D
"RTN","LA7CHKF1",179,0)
 . S LAWP(LACNT)=" "
"RTN","LA7CHKF1",180,0)
 . S LACNT=LACNT+1
"RTN","LA7CHKF1",181,0)
 . S LAWP(LACNT)="Lexicon API: "_LALEXERR
"RTN","LA7CHKF1",182,0)
 . S LACNT=LACNT+1
"RTN","LA7CHKF1",183,0)
 ;
"RTN","LA7CHKF1",184,0)
 I $D(LAWP) D WP^DIE(LASUBFILE,LAFIEN(2)_","_LAFIEN_",",4,"A","LAWP","LAERR(3)")
"RTN","LA7CHKF1",185,0)
 ;
"RTN","LA7CHKF1",186,0)
 Q
"RTN","LA7CHKF1",187,0)
 ;
"RTN","LA7CHKF1",188,0)
SENDMSG() ; Send MailMan message. Return message ID.
"RTN","LA7CHKF1",189,0)
 ;
"RTN","LA7CHKF1",190,0)
 N I,LABODY,LAMSGSUB,LASUB,XMERR,XMINSTR,XMSUBJ,XMTO,XMZ
"RTN","LA7CHKF1",191,0)
 ;
"RTN","LA7CHKF1",192,0)
 S LAMSGSUB="MSGFINAL"
"RTN","LA7CHKF1",193,0)
 ;
"RTN","LA7CHKF1",194,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="Due to a recent Lexicon patch that updated the SNOMED CT (SCT) code set at"
"RTN","LA7CHKF1",195,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="your facility, some of the Lab entries in the TOPOGRAPHY FIELD file (#61),"
"RTN","LA7CHKF1",196,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="COLLECTION SAMPLE file (#62), and ETIOLOGY FIELD file (#61.2) are mapped to"
"RTN","LA7CHKF1",197,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="SCT codes that have been deprecated or have other exceptions."
"RTN","LA7CHKF1",198,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))=""
"RTN","LA7CHKF1",199,0)
 ;
"RTN","LA7CHKF1",200,0)
 ; if failed to send alert to STS, use this verbiage:
"RTN","LA7CHKF1",201,0)
 I $D(^TMP("LA7CHK",$J,"ERR")) D
"RTN","LA7CHKF1",202,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="An STS alert failed to be generated for some of these exceptions."
"RTN","LA7CHKF1",203,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="Please contact Standards & Terminology Services (STS) to have those SNOMED"
"RTN","LA7CHKF1",204,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="CT mappings updated."
"RTN","LA7CHKF1",205,0)
 ;
"RTN","LA7CHKF1",206,0)
 ; if alert was sent to STS, use this verbiage:
"RTN","LA7CHKF1",207,0)
 I '$D(^TMP("LA7CHK",$J,"ERR")) D
"RTN","LA7CHKF1",208,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="Standards & Terminology Services (STS) has received notification of these"
"RTN","LA7CHKF1",209,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="SNOMED CT exceptions and will provide your site with a new SCT mapping file"
"RTN","LA7CHKF1",210,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="within several weeks or less."
"RTN","LA7CHKF1",211,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))=""
"RTN","LA7CHKF1",212,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="-----------------------------------------------------------------------------"
"RTN","LA7CHKF1",213,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))=" NOTE: YOU DO NOT NEED TO DO ANYTHING UNTIL YOU GET THE UPDATED MAPPING FILE"
"RTN","LA7CHKF1",214,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="       FROM STS"
"RTN","LA7CHKF1",215,0)
 . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="-----------------------------------------------------------------------------"
"RTN","LA7CHKF1",216,0)
 ;
"RTN","LA7CHKF1",217,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))=""
"RTN","LA7CHKF1",218,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))="The following SNOMED CT exceptions have been found at:"
"RTN","LA7CHKF1",219,0)
 S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))=$$NAME^XUAF4($$KSP^XUPARAM("INST"))_" ("_$$KSP^XUPARAM("WHERE")_")."
"RTN","LA7CHKF1",220,0)
 ;
"RTN","LA7CHKF1",221,0)
 F LASUB="ERR","MSG" D
"RTN","LA7CHKF1",222,0)
 . S I=0
"RTN","LA7CHKF1",223,0)
 . F  S I=$O(^TMP("LA7CHK",$J,LASUB,I)) Q:'I  D
"RTN","LA7CHKF1",224,0)
 . . S ^TMP("LA7CHK",$J,LAMSGSUB,$$LN(LAMSGSUB))=$G(^TMP("LA7CHK",$J,LASUB,I))
"RTN","LA7CHKF1",225,0)
 ;
"RTN","LA7CHKF1",226,0)
 S XMSUBJ="SNOMED CT MAPPING ERRORS"
"RTN","LA7CHKF1",227,0)
 S LABODY="^TMP(""LA7CHK"",$J,"""_LAMSGSUB_""")"
"RTN","LA7CHKF1",228,0)
 S XMINSTR("ADDR FLAGS")="R"
"RTN","LA7CHKF1",229,0)
 S XMINSTR("FROM")="LAB PACKAGE"
"RTN","LA7CHKF1",230,0)
 ;
"RTN","LA7CHKF1",231,0)
 I $$GOTLOCAL^XMXAPIG("LAB MESSAGING") S XMTO("G.LAB MESSAGING")=""
"RTN","LA7CHKF1",232,0)
 I $$GOTLOCAL^XMXAPIG("LMI") S XMTO("G.LMI")=""
"RTN","LA7CHKF1",233,0)
 I '$D(XMTO) M XMTO=^XUSEC("LRLIASON") ; File ^XUSEC/10076
"RTN","LA7CHKF1",234,0)
 ;
"RTN","LA7CHKF1",235,0)
 D SENDMSG^XMXAPI(DUZ,XMSUBJ,LABODY,.XMTO,.XMINSTR,.XMZ)
"RTN","LA7CHKF1",236,0)
 ;
"RTN","LA7CHKF1",237,0)
 K ^TMP("XMERR",$J)
"RTN","LA7CHKF1",238,0)
 ;
"RTN","LA7CHKF1",239,0)
 Q $G(XMZ)
"RTN","LA7CHKF1",240,0)
 ;
"RTN","LA7CHKF1",241,0)
FRMTTXT(TEXT,LMARGIN,RMARGIN,LARSLT) ;Format Text
"RTN","LA7CHKF1",242,0)
 ;
"RTN","LA7CHKF1",243,0)
 ; Format text
"RTN","LA7CHKF1",244,0)
 ;
"RTN","LA7CHKF1",245,0)
 ; Input:
"RTN","LA7CHKF1",246,0)
 ;   TEXT = The text to format
"RTN","LA7CHKF1",247,0)
 ;   LMARGIN (optional) = The left margin for the text
"RTN","LA7CHKF1",248,0)
 ;                        Defaults to 1
"RTN","LA7CHKF1",249,0)
 ;   RMARGIN (optional) = The right margin for the text
"RTN","LA7CHKF1",250,0)
 ;                        Defaults to 80
"RTN","LA7CHKF1",251,0)
 ;   LARSLT = The resulting array
"RTN","LA7CHKF1",252,0)
 ;
"RTN","LA7CHKF1",253,0)
 N DIWF,DIWL,DIWR,X
"RTN","LA7CHKF1",254,0)
 ;
"RTN","LA7CHKF1",255,0)
 K ^UTILITY($J,"W")
"RTN","LA7CHKF1",256,0)
 S DIWL=$G(LMARGIN)
"RTN","LA7CHKF1",257,0)
 S DIWR=$G(RMARGIN)
"RTN","LA7CHKF1",258,0)
 I DIWL="" S DIWL=1
"RTN","LA7CHKF1",259,0)
 I DIWR="" S DIWR=80
"RTN","LA7CHKF1",260,0)
 S DIWF=""
"RTN","LA7CHKF1",261,0)
 S X=TEXT
"RTN","LA7CHKF1",262,0)
 D ^DIWP
"RTN","LA7CHKF1",263,0)
 M LARSLT=^UTILITY($J,"W",DIWL)
"RTN","LA7CHKF1",264,0)
 K ^UTILITY($J,"W")
"RTN","LA7CHKF1",265,0)
 ;
"RTN","LA7CHKF1",266,0)
 Q
"RTN","LA7CHKF1",267,0)
 ;
"RTN","LA7CHKF1",268,0)
LN(SUB) ; Increment the line counter.
"RTN","LA7CHKF1",269,0)
 ;
"RTN","LA7CHKF1",270,0)
 ;ZEXCEPT: LALINE
"RTN","LA7CHKF1",271,0)
 ;
"RTN","LA7CHKF1",272,0)
 S LALINE(SUB)=$G(LALINE(SUB))+1
"RTN","LA7CHKF1",273,0)
 Q LALINE(SUB)
"RTN","LA7CHKF1",274,0)
 ;
"RTN","LA7CHKF1",275,0)
CLEAN ; Clean up tmp global(s)
"RTN","LA7CHKF1",276,0)
 ;
"RTN","LA7CHKF1",277,0)
 K ^TMP("LA7CHK",$J)
"RTN","LA7CHKF1",278,0)
 Q
"RTN","LA7SMU2")
0^4^B27930322
"RTN","LA7SMU2",1,0)
LA7SMU2 ;DALOI/JMC - Shipping Manifest Utility (Cont'd) ;01/07/13  17:10
"RTN","LA7SMU2",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,74,80**;Sep 27, 1994;Build 19
"RTN","LA7SMU2",3,0)
 ;
"RTN","LA7SMU2",4,0)
 Q
"RTN","LA7SMU2",5,0)
 ;
"RTN","LA7SMU2",6,0)
 ; ZEXCEPT is used to identify variables which are external to a specific TAG
"RTN","LA7SMU2",7,0)
 ;         used in conjunction with Eclipse M-editor.
"RTN","LA7SMU2",8,0)
 ;
"RTN","LA7SMU2",9,0)
DTTO(LA7SCFG,LA7VNLT,LA7HLSC,LA7HLPRI,LA7HLCSC) ; Determine test to order
"RTN","LA7SMU2",10,0)
 ; Call with LA7SCFG = ien of Shipping Configuration file #62.9
"RTN","LA7SMU2",11,0)
 ;           LA7VNLT = NLT code or non-VA test code (pass by reference)
"RTN","LA7SMU2",12,0)
 ;           LA7HLSC = Specimen Code (pass by reference)
"RTN","LA7SMU2",13,0)
 ;          LA7HLPRI = HL7 Priority Code
"RTN","LA7SMU2",14,0)
 ;          LA7HLCSC = Collection sample (pass by reference)
"RTN","LA7SMU2",15,0)
 ;
"RTN","LA7SMU2",16,0)
 ; Returns      LA7X = 0^0^0^0^^^ (if unsuccessful)
"RTN","LA7SMU2",17,0)
 ;                     LABORATORY TEST (ien file #60)^TOPOGRAPHY (ien file #61)^COLLECTION SAMPLE (ien file #62)^URGENCY (ien file #62.05)^NLT TEST CODE^NLT TEST NAME
"RTN","LA7SMU2",18,0)
 ;
"RTN","LA7SMU2",19,0)
 N I,J,K,L,LA760,LA7X,X,Y,Z
"RTN","LA7SMU2",20,0)
 ;
"RTN","LA7SMU2",21,0)
 ; Make sure variables initialized.
"RTN","LA7SMU2",22,0)
 S LA7X="0^0^0^0^^^"
"RTN","LA7SMU2",23,0)
 I LA7VNLT="" Q LA7X
"RTN","LA7SMU2",24,0)
 S LA7SCFG=+$G(LA7SCFG)
"RTN","LA7SMU2",25,0)
 I LA7HLPRI="" S LA7HLPRI="R"
"RTN","LA7SMU2",26,0)
 ;
"RTN","LA7SMU2",27,0)
 ; If coding systems not defined then assume HL7 Table 0070 and VA NLT file
"RTN","LA7SMU2",28,0)
 F I=1,4 D
"RTN","LA7SMU2",29,0)
 . I $G(LA7HLSC(I))'="",$G(LA7HLSC(I+2))="" S LA7HLSC(I+2)="HL70070"
"RTN","LA7SMU2",30,0)
 . I $G(LA7VNLT(I))'="" D
"RTN","LA7SMU2",31,0)
 . . I $G(LA7VNLT(I+2))="" S LA7VNLT(I+2)="L"
"RTN","LA7SMU2",32,0)
 . . I $G(LA7VNLT(I+2))="L",$P(^LAHM(62.9,LA7SCFG,0),"^",15)=0 S LA7VNLT(I+2)="99VA64"
"RTN","LA7SMU2",33,0)
 . I $G(LA7HLCSC(I))'="",$G(LA7HLCSC(I+2))="" S LA7HLCSC(I+2)="L"
"RTN","LA7SMU2",34,0)
 ;
"RTN","LA7SMU2",35,0)
 ; Build index of tests if not previously done for this session.
"RTN","LA7SMU2",36,0)
 I '$D(^TMP("LA7TC",$J,LA7SCFG)) D BINDX^LA7SMU2A
"RTN","LA7SMU2",37,0)
 ;
"RTN","LA7SMU2",38,0)
 ; Lookup test/specimen/priority/collection sample mapping
"RTN","LA7SMU2",39,0)
 F I=1,4 D  Q:LA7X
"RTN","LA7SMU2",40,0)
 . I $G(LA7VNLT(I))="" Q
"RTN","LA7SMU2",41,0)
 . F J=1,4 D  Q:LA7X
"RTN","LA7SMU2",42,0)
 . . I $G(LA7HLSC(J))="" Q
"RTN","LA7SMU2",43,0)
 . . F K=1,4 D  Q:LA7X
"RTN","LA7SMU2",44,0)
 . . . F L=LA7HLPRI,0 D  Q:LA7X
"RTN","LA7SMU2",45,0)
 . . . . I $G(LA7HLCSC(K))="" Q
"RTN","LA7SMU2",46,0)
 . . . . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT(I+2),LA7VNLT(I),LA7HLSC(J+2),LA7HLSC(J),L,LA7HLCSC(K+2),LA7HLCSC(K)))
"RTN","LA7SMU2",47,0)
 . . . . I X S LA7X=X
"RTN","LA7SMU2",48,0)
 . . . I LA7X Q
"RTN","LA7SMU2",49,0)
 . . . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT(I+2),LA7VNLT(I),LA7HLSC(J+2),LA7HLSC(J),LA7HLPRI))
"RTN","LA7SMU2",50,0)
 . . . I X S LA7X=X
"RTN","LA7SMU2",51,0)
 . . I LA7X Q
"RTN","LA7SMU2",52,0)
 . . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT(I+2),LA7VNLT(I),LA7HLSC(J+2),LA7HLSC(J)))
"RTN","LA7SMU2",53,0)
 . . I X S LA7X=X
"RTN","LA7SMU2",54,0)
 . I LA7X Q
"RTN","LA7SMU2",55,0)
 . F K=1,4 D  Q:LA7X
"RTN","LA7SMU2",56,0)
 . . F L=LA7HLPRI,0 D  Q:LA7X
"RTN","LA7SMU2",57,0)
 . . . I $G(LA7HLCSC(K))="" Q
"RTN","LA7SMU2",58,0)
 . . . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT(I+2),LA7VNLT(I),0,0,L,LA7HLCSC(K+2),LA7HLCSC(K)))
"RTN","LA7SMU2",59,0)
 . . . I X,$P(^LAB(60,$P(X,"^"),0),"^",4)="MI" S LA7X=X Q
"RTN","LA7SMU2",60,0)
 . . . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT(I+2),LA7VNLT(I),"HL70070","XXX",L,LA7HLCSC(K+2),LA7HLCSC(K)))
"RTN","LA7SMU2",61,0)
 . . . I X,"SPCYEM"[$P(^LAB(60,$P(X,"^"),0),"^",4) S LA7X=X
"RTN","LA7SMU2",62,0)
 . I LA7X Q
"RTN","LA7SMU2",63,0)
 . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT(I+2),LA7VNLT(I),0,0,0,0,0))
"RTN","LA7SMU2",64,0)
 . I X S LA7X=X
"RTN","LA7SMU2",65,0)
 ;
"RTN","LA7SMU2",66,0)
 ; If SCT specimen from message does not match SCT assigned to specimen from above
"RTN","LA7SMU2",67,0)
 ;  then set specimen to 0.
"RTN","LA7SMU2",68,0)
 I $P(LA7X,"^"),$P(LA7X,"^",2) D
"RTN","LA7SMU2",69,0)
 . F J=1,4 I $G(LA7HLSC(J+2))="SCT" D  Q
"RTN","LA7SMU2",70,0)
 . . N LA7SCTID
"RTN","LA7SMU2",71,0)
 . . S LA7SCTID=$$GET1^DIQ(61,$P(LA7X,"^",2)_",",20,"I")
"RTN","LA7SMU2",72,0)
 . . I LA7SCTID'="",LA7SCTID'=LA7HLSC(J) D
"RTN","LA7SMU2",73,0)
 . . . S $P(LA7X,"^",2)=0
"RTN","LA7SMU2",74,0)
 ;
"RTN","LA7SMU2",75,0)
 ; If SCT collection sample from message does not match SCT assigned to collection sample from above
"RTN","LA7SMU2",76,0)
 ;  then set collection sample to 0.
"RTN","LA7SMU2",77,0)
 I $P(LA7X,"^"),$P(LA7X,"^",3) D
"RTN","LA7SMU2",78,0)
 . F J=1,4 I $G(LA7HLCSC(J+2))="SCT" D  Q
"RTN","LA7SMU2",79,0)
 . . N LA7SCTID
"RTN","LA7SMU2",80,0)
 . . S LA7SCTID=$$GET1^DIQ(62,$P(LA7X,"^",3)_",",20,"I")
"RTN","LA7SMU2",81,0)
 . . I LA7SCTID'="",LA7SCTID'=LA7HLCSC(J) D
"RTN","LA7SMU2",82,0)
 . . . S $P(LA7X,"^",3)=0
"RTN","LA7SMU2",83,0)
 ;
"RTN","LA7SMU2",84,0)
 ; For MI, SP, CY and EM find first specimen when collection sample is not mapped to a specific topography.
"RTN","LA7SMU2",85,0)
 ; For SP, CY and EM if no specimen then find first specimen mapped to HL7 0070 "XXX".
"RTN","LA7SMU2",86,0)
 I $P(LA7X,"^"),'$P(LA7X,"^",2),$P(^LAB(60,$P(LA7X,"^"),0),"^",4)?1(1"MI",1"SP",1"CY",1"EM") D
"RTN","LA7SMU2",87,0)
 . S X=""
"RTN","LA7SMU2",88,0)
 . F J=1,4 D  Q:$P(LA7X,"^",2)
"RTN","LA7SMU2",89,0)
 . . I $G(LA7HLSC(J+2))="SCT" D
"RTN","LA7SMU2",90,0)
 . . . S X=$O(^LAB(61,"F",LA7HLSC(J),""))
"RTN","LA7SMU2",91,0)
 . . . I 'X S X=+$$FINDSCT(61,LA7HLSC(J),LA7HLSC(J+1))
"RTN","LA7SMU2",92,0)
 . . I $G(LA7HLSC(J+2))="HL70070" S X=$O(^LAB(61,"HL7",LA7HLSC(J),0))
"RTN","LA7SMU2",93,0)
 . . I X>0 S $P(LA7X,"^",2)=X
"RTN","LA7SMU2",94,0)
 . I '$P(LA7X,"^",2),$P(^LAB(60,$P(LA7X,"^"),0),"^",4)?1(1"SP",1"CY",1"EM") D
"RTN","LA7SMU2",95,0)
 . . S X=$O(^LAB(61,"HL7","XXX",0))
"RTN","LA7SMU2",96,0)
 . . I X>0 S $P(LA7X,"^",2)=X
"RTN","LA7SMU2",97,0)
 ;
"RTN","LA7SMU2",98,0)
 ; For MI, SP, CY, and EM find first collection sample when no collection sample.
"RTN","LA7SMU2",99,0)
 I $P(LA7X,"^"),'$P(LA7X,"^",3),$P(^LAB(60,$P(LA7X,"^"),0),"^",4)?1(1"MI",1"SP",1"CY",1"EM") D
"RTN","LA7SMU2",100,0)
 . S X=""
"RTN","LA7SMU2",101,0)
 . F J=1,4 D  Q:$P(LA7X,"^",3)
"RTN","LA7SMU2",102,0)
 . . I $G(LA7HLCSC(J+2))="SCT" D
"RTN","LA7SMU2",103,0)
 . . . S X=$O(^LAB(62,"F",LA7HLCSC(J),""))
"RTN","LA7SMU2",104,0)
 . . . I 'X S X=+$$FINDSCT(62,LA7HLCSC(J),LA7HLCSC(J+1))
"RTN","LA7SMU2",105,0)
 . . I X>0 S $P(LA7X,"^",3)=X
"RTN","LA7SMU2",106,0)
 ;
"RTN","LA7SMU2",107,0)
 ; No urgency mapping, get last using this HL7 code or site's default urgency from #69.9
"RTN","LA7SMU2",108,0)
 ; Find highest non-workload urgency using this priority code else use site's default
"RTN","LA7SMU2",109,0)
 I '$P(LA7X,"^",4) D
"RTN","LA7SMU2",110,0)
 . S X=$O(^LAB(62.05,"HL7",LA7HLPRI,50),-1)
"RTN","LA7SMU2",111,0)
 . I X S $P(LA7X,"^",4)=X
"RTN","LA7SMU2",112,0)
 . E  S $P(LA7X,"^",4)=+$P($G(^LAB(69.9,1,3)),"^",2)
"RTN","LA7SMU2",113,0)
 ;
"RTN","LA7SMU2",114,0)
 ; Check file #60 forced and highest urgency.
"RTN","LA7SMU2",115,0)
 I $P(LA7X,"^"),$P(LA7X,"^",4) D
"RTN","LA7SMU2",116,0)
 . S X=$G(^LAB(60,$P(LA7X,"^"),0))
"RTN","LA7SMU2",117,0)
 . I $P(X,"^",18) S $P(LA7X,"^",4)=$P(X,"^",18) Q
"RTN","LA7SMU2",118,0)
 . I $P(X,"^",16),$P(LA7X,"^",4)<$P(X,"^",16) S $P(LA7X,"^",4)=$P(X,"^",16)
"RTN","LA7SMU2",119,0)
 ;
"RTN","LA7SMU2",120,0)
 Q LA7X
"RTN","LA7SMU2",121,0)
 ;
"RTN","LA7SMU2",122,0)
 ;
"RTN","LA7SMU2",123,0)
CHKCDSYS(LA7SRC,LA7DEST,LA7CSET,LA7CS) ; Check coding system order on CE/CNE/CWE data types
"RTN","LA7SMU2",124,0)
 ; Call with LA7SRC = source array by reference
"RTN","LA7SMU2",125,0)
 ;          LA7DEST = destination array by reference
"RTN","LA7SMU2",126,0)
 ;          LA7CSET = code set to move to primary
"RTN","LA7SMU2",127,0)
 ;            LA7CS = component separator
"RTN","LA7SMU2",128,0)
 ;
"RTN","LA7SMU2",129,0)
 ; Returns by reference array LA7DEST
"RTN","LA7SMU2",130,0)
 ;
"RTN","LA7SMU2",131,0)
 ; If code set in alternate then switch primary and alternate
"RTN","LA7SMU2",132,0)
 ;
"RTN","LA7SMU2",133,0)
 K LA7DEST
"RTN","LA7SMU2",134,0)
 ;
"RTN","LA7SMU2",135,0)
 I $G(LA7SRC(6))'=LA7CSET M LA7DEST=LA7SRC Q
"RTN","LA7SMU2",136,0)
 ;
"RTN","LA7SMU2",137,0)
 N J
"RTN","LA7SMU2",138,0)
 F J=1,2,3 D
"RTN","LA7SMU2",139,0)
 . S LA7DEST(J)=$G(LA7SRC(J+3)),LA7DEST(J+3)=$G(LA7SRC(J))
"RTN","LA7SMU2",140,0)
 . I LA7SRC'="" S $P(LA7DEST,LA7CS,J)=$P(LA7SRC,LA7CS,J+3),$P(LA7DEST,LA7CS,J+3)=$P(LA7SRC,LA7CS,J)
"RTN","LA7SMU2",141,0)
 S LA7DEST(7)=$G(LA7SRC(8)),LA7DEST(8)=$G(LA7SRC(7)),LA7DEST(9)=$G(LA7SRC(9))
"RTN","LA7SMU2",142,0)
 I $G(LA7SRC)'="" S $P(LA7DEST,LA7CS,7)=$P(LA7SRC,LA7CS,8),$P(LA7DEST,LA7CS,8)=$P(LA7SRC,LA7CS,7),$P(LA7DEST,LA7CS,9)=$P(LA7SRC,LA7CS,9)
"RTN","LA7SMU2",143,0)
 ;
"RTN","LA7SMU2",144,0)
 Q
"RTN","LA7SMU2",145,0)
 ;
"RTN","LA7SMU2",146,0)
 ;
"RTN","LA7SMU2",147,0)
FINDSCT(LA7FILE,LA7CODE,LA7TXT) ; Lookup SCT term in Lexicon and if possible add to target file.
"RTN","LA7SMU2",148,0)
 ; Call with LA7FILE = file number of target file (61/62)
"RTN","LA7SMU2",149,0)
 ;           LA7CODE = SCT ID
"RTN","LA7SMU2",150,0)
 ;            LA7TXT = SCT text
"RTN","LA7SMU2",151,0)
 ;
"RTN","LA7SMU2",152,0)
 N LA74,LA7ERROR,LAHLSEGS,LA7IEN,X,Y
"RTN","LA7SMU2",153,0)
 ;
"RTN","LA7SMU2",154,0)
 ;ZEXCEPT: LA76247,LA7CS,LA7ECH,LA7FS,LA7MID,LA7RAP,LA7RFAC,LA7SAP,LA7SFAC
"RTN","LA7SMU2",155,0)
 ;
"RTN","LA7SMU2",156,0)
 ;
"RTN","LA7SMU2",157,0)
 S LA74=$$RESFID^LA7VHLU2(LA7SFAC,LA7SFAC,LA7CS)
"RTN","LA7SMU2",158,0)
 S LAHLSEGS("R4")=LA74
"RTN","LA7SMU2",159,0)
 S LAHLSEGS("R6247")=$G(LA76247)
"RTN","LA7SMU2",160,0)
 S LAHLSEGS("FSEC")=LA7FS_LA7ECH
"RTN","LA7SMU2",161,0)
 S LAHLSEGS("MSH",3)=LA7SAP
"RTN","LA7SMU2",162,0)
 S LAHLSEGS("MSH",4)=LA7SFAC
"RTN","LA7SMU2",163,0)
 S LAHLSEGS("MSH",5)=LA7RAP
"RTN","LA7SMU2",164,0)
 S LAHLSEGS("MSH",6)=LA7RFAC
"RTN","LA7SMU2",165,0)
 S LAHLSEGS("MSH",11)=$G(LA7MID)
"RTN","LA7SMU2",166,0)
 S LAHLSEGS("OBX",3)=LA7CODE_LA7CS_LA7TXT_LA7CS_"SCT"
"RTN","LA7SMU2",167,0)
 ;
"RTN","LA7SMU2",168,0)
 S LA7IEN=$$EN^LRSCTX(LA7FILE,LA7TXT,LA7CODE,.LAHLSEGS,.LA7ERROR,0)
"RTN","LA7SMU2",169,0)
 ;
"RTN","LA7SMU2",170,0)
 Q LA7IEN
"RTN","LA7SMU2A")
0^1^B11988192
"RTN","LA7SMU2A",1,0)
LA7SMU2A ;DALOI/JMC - Shipping Manifest Utility (Cont'd) ;10/23/12  11:08
"RTN","LA7SMU2A",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74,80**;Sep 27, 1994;Build 19
"RTN","LA7SMU2A",3,0)
 ;
"RTN","LA7SMU2A",4,0)
 Q
"RTN","LA7SMU2A",5,0)
 ;
"RTN","LA7SMU2A",6,0)
 ;
"RTN","LA7SMU2A",7,0)
BINDX ; Build index of tests for a shipping configuration.
"RTN","LA7SMU2A",8,0)
 ; Called from LA7SMU2.
"RTN","LA7SMU2A",9,0)
 ;
"RTN","LA7SMU2A",10,0)
 N I,J,K,LA760,LA761,LA762,LA76205,LA764,LA7HL,LA7NLT,LA7NLTN,LA7TC,LA7X,LA7Y,LA7Z,LRSS
"RTN","LA7SMU2A",11,0)
 S LA7X=0
"RTN","LA7SMU2A",12,0)
 F  S LA7X=$O(^LAHM(62.9,LA7SCFG,60,LA7X)) Q:'LA7X  D BLD
"RTN","LA7SMU2A",13,0)
 Q
"RTN","LA7SMU2A",14,0)
 ;
"RTN","LA7SMU2A",15,0)
 ;
"RTN","LA7SMU2A",16,0)
BLD ; Build TMP global for a test
"RTN","LA7SMU2A",17,0)
 ; Called from above
"RTN","LA7SMU2A",18,0)
 ;
"RTN","LA7SMU2A",19,0)
 K LA761,LA762,LA76205,LA764,LA7NLT,LA7NLTN,LA7TC,LA7Y,LA7Z
"RTN","LA7SMU2A",20,0)
 ;
"RTN","LA7SMU2A",21,0)
 S LA7X(0)=$G(^LAHM(62.9,LA7SCFG,60,LA7X,0))
"RTN","LA7SMU2A",22,0)
 S LA7X(5)=$G(^LAHM(62.9,LA7SCFG,60,LA7X,5))
"RTN","LA7SMU2A",23,0)
 ;
"RTN","LA7SMU2A",24,0)
 ; Laboratory test/collection sample.
"RTN","LA7SMU2A",25,0)
 S LA760=$P(LA7X(0),"^"),LA761=+$P(LA7X(0),"^",3),LA762=+$P(LA7X(0),"^",9),LRSS=$P(^LAB(60,LA760,0),"^",4)
"RTN","LA7SMU2A",26,0)
 I 'LA761 S LA761=$$GET1^DIQ(62,LA762_",",2,"I")
"RTN","LA7SMU2A",27,0)
 I LA761,'LA762 S LA762=+$$GET1^DIQ(61,LA761_",",4.1,"I")
"RTN","LA7SMU2A",28,0)
 ; Incomplete entry if in CH or BB subscript.
"RTN","LA7SMU2A",29,0)
 I 'LA762,"BBCH"[LRSS Q
"RTN","LA7SMU2A",30,0)
 I 'LA761,"BBCH"[LRSS Q
"RTN","LA7SMU2A",31,0)
 ;
"RTN","LA7SMU2A",32,0)
 ; Test urgency/HL7 priority code.
"RTN","LA7SMU2A",33,0)
 S LA76205=$P(LA7X(0),"^",4),LA76205("HL")=""
"RTN","LA7SMU2A",34,0)
 I LA76205 S LA76205("HL")=$$GET1^DIQ(62.05,LA76205_",","LEDI HL7:HL7 ABBR")
"RTN","LA7SMU2A",35,0)
 ;
"RTN","LA7SMU2A",36,0)
 ; Use HL7 specimen code if using table 0070, SNOMED if SCT and mapping in 62.9 for local.
"RTN","LA7SMU2A",37,0)
 S LA761("HL70070")=$$GET1^DIQ(61,LA761_",","LEDI HL7:HL7 ABBR")
"RTN","LA7SMU2A",38,0)
 S LA761("SCT")=$P($$IEN2SCT^LA7VHLU6(61,LA761,DT),"^")
"RTN","LA7SMU2A",39,0)
 I $P(LA7X(5),"^",3)'="" D
"RTN","LA7SMU2A",40,0)
 . I $P(LA7X(5),"^",6)="" S $P(LA7X(5),"^",6)="L"
"RTN","LA7SMU2A",41,0)
 . S LA761($P(LA7X(5),"^",6))=$P(LA7X(5),"^",3)
"RTN","LA7SMU2A",42,0)
 ;
"RTN","LA7SMU2A",43,0)
 ; Use SNOMED CT and local mapping in 62.9 for collection sample.
"RTN","LA7SMU2A",44,0)
 S LA762("SCT")=$P($$IEN2SCT^LA7VHLU6(62,LA762,DT),"^")
"RTN","LA7SMU2A",45,0)
 I $P(LA7X(5),"^",7)'="" D
"RTN","LA7SMU2A",46,0)
 . I $P(LA7X(5),"^",9)="" S $P(LA7X(5),"^",9)="L"
"RTN","LA7SMU2A",47,0)
 . S LA762($P(LA7X(5),"^",9))=$P(LA7X(5),"^",7)
"RTN","LA7SMU2A",48,0)
 ;
"RTN","LA7SMU2A",49,0)
 ; File #64 ien/NLT code/NLT code test name.
"RTN","LA7SMU2A",50,0)
 ; Use NLT code if using VA coding else use non-VA test order code.
"RTN","LA7SMU2A",51,0)
 S LA764=+$$GET1^DIQ(60,LA760_",",64,"I")
"RTN","LA7SMU2A",52,0)
 I 'LA764 Q
"RTN","LA7SMU2A",53,0)
 S LA7TC("99VA64")=$$GET1^DIQ(64,LA764_",",1,"I")
"RTN","LA7SMU2A",54,0)
 S LA7NLTN=$$GET1^DIQ(64,LA764_",",.01)
"RTN","LA7SMU2A",55,0)
 I $P(LA7X(5),"^")'="" D
"RTN","LA7SMU2A",56,0)
 . I $P(LA7X(5),"^",5)="" S $P(LA7X(5),"^",5)="L"
"RTN","LA7SMU2A",57,0)
 . S LA7TC($P(LA7X(5),"^",5))=$P(LA7X(5),"^")
"RTN","LA7SMU2A",58,0)
 ;
"RTN","LA7SMU2A",59,0)
 ; Set TMP global with information
"RTN","LA7SMU2A",60,0)
 S LA7Y=LA760_"^"_LA761_"^"_LA762_"^"_LA76205_"^"_LA7TC("99VA64")_"^"_LA7NLTN
"RTN","LA7SMU2A",61,0)
 S I=""
"RTN","LA7SMU2A",62,0)
 F  S I=$O(LA7TC(I)) Q:I=""  D
"RTN","LA7SMU2A",63,0)
 . S K=""
"RTN","LA7SMU2A",64,0)
 . F  S K=$O(LA762(K)) Q:K=""  I LA762(K)'=""  D
"RTN","LA7SMU2A",65,0)
 . . S J=""
"RTN","LA7SMU2A",66,0)
 . . F  S J=$O(LA761(J)) Q:J=""  I LA761(J)'="" D
"RTN","LA7SMU2A",67,0)
 . . . S ^TMP("LA7TC",$J,LA7SCFG,I,LA7TC(I),J,LA761(J),0,K,LA762(K))=LA7Y
"RTN","LA7SMU2A",68,0)
 . . . I LA76205("HL")'="" S ^TMP("LA7TC",$J,LA7SCFG,I,LA7TC(I),J,LA761(J),LA76205("HL"),K,LA762(K))=LA7Y
"RTN","LA7SMU2A",69,0)
 . . I 'LA761,LRSS="MI" D  Q
"RTN","LA7SMU2A",70,0)
 . . . S ^TMP("LA7TC",$J,LA7SCFG,I,LA7TC(I),0,0,0,K,LA762(K))=LA7Y
"RTN","LA7SMU2A",71,0)
 . . . I LA76205("HL")'="" S ^TMP("LA7TC",$J,LA7SCFG,I,LA7TC(I),0,0,LA76205("HL"),K,LA762(K))=LA7Y
"RTN","LA7SMU2A",72,0)
 . . I 'LA761,"SPCYEM"[LRSS D
"RTN","LA7SMU2A",73,0)
 . . . S ^TMP("LA7TC",$J,LA7SCFG,I,LA7TC(I),"HL70070","XXX",0,K,LA762(K))=LA7Y
"RTN","LA7SMU2A",74,0)
 . . . I LA76205("HL")'="" S ^TMP("LA7TC",$J,LA7SCFG,I,LA7TC(I),"HL70070","XXX",LA76205("HL"),K,LA762(K))=LA7Y
"RTN","LA7SMU2A",75,0)
 . I LRSS="MI" S LA7Z=LA7Y,$P(LA7Z,"^",2,4)="^^",^TMP("LA7TC",$J,LA7SCFG,I,LA7TC(I),0,0,0,0,0)=LA7Z
"RTN","LA7SMU2A",76,0)
 . S J=""
"RTN","LA7SMU2A",77,0)
 . F  S J=$O(LA761(J)) Q:J=""  I LA761(J)'="",LRSS?1(1"CH",1"MI") D
"RTN","LA7SMU2A",78,0)
 . . I LA76205("HL")'="" S ^TMP("LA7TC",$J,LA7SCFG,I,LA7TC(I),J,LA761(J),LA76205("HL"))=LA7Y
"RTN","LA7SMU2A",79,0)
 . . E  S ^TMP("LA7TC",$J,LA7SCFG,I,LA7TC(I),J,LA761(J))=LA7Y
"RTN","LA7SMU2A",80,0)
 ;
"RTN","LA7SMU2A",81,0)
 Q
"RTN","LA7UIO")
0^7^B9916746
"RTN","LA7UIO",1,0)
LA7UIO ;DALOI/JMC - Process Download Message for #62.48 ;05/30/13  15:59
"RTN","LA7UIO",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**66,80**;Sep 27, 1994;Build 19
"RTN","LA7UIO",3,0)
 ;
"RTN","LA7UIO",4,0)
 Q
"RTN","LA7UIO",5,0)
 ;
"RTN","LA7UIO",6,0)
EN ; Called from LA7UID
"RTN","LA7UIO",7,0)
 ; Converts the information for each test in the load list
"RTN","LA7UIO",8,0)
 ; into HL7 messages and hands them to the HL7 package for delivery.
"RTN","LA7UIO",9,0)
 ; LRLL= IEN in 68.2 Load Worklist file, from field in 62.4
"RTN","LA7UIO",10,0)
 ; LRINST= IEN IN 62.4 Auto Inst file
"RTN","LA7UIO",11,0)
 ; LRAUTO= zero node of 62.4 entry
"RTN","LA7UIO",12,0)
 ; LA76248= IEN in 62.48 Message Parameter file
"RTN","LA7UIO",13,0)
 ;
"RTN","LA7UIO",14,0)
 N LA76281,LA7,LA7CUP,LA7CUP1,LA7TRAY,LA7TRAY1
"RTN","LA7UIO",15,0)
 ;
"RTN","LA7UIO",16,0)
 ; Preparing automatic download.
"RTN","LA7UIO",17,0)
 I $G(LA7ADL) D ADL Q
"RTN","LA7UIO",18,0)
 ;
"RTN","LA7UIO",19,0)
 S LA7=^LRO(68.2,LRLL,2)
"RTN","LA7UIO",20,0)
 S LA7TRAY=$P(LA7,"^",2),LA7TRAY1=$P(LA7,"^",4)
"RTN","LA7UIO",21,0)
 S LA7CUP=$P(LA7,"^",3),LA7CUP1=$P(LA7,"^",5)
"RTN","LA7UIO",22,0)
 S:$G(LRTRAY1) LA7TRAY=LRTRAY1
"RTN","LA7UIO",23,0)
 S:$G(LRCUP1) LA7CUP=LRCUP1
"RTN","LA7UIO",24,0)
 ;
"RTN","LA7UIO",25,0)
 ; Process each tray on load list
"RTN","LA7UIO",26,0)
 S LA76821=LA7TRAY-1
"RTN","LA7UIO",27,0)
 F  S LA76821=$O(^LRO(68.2,LRLL,1,LA76821)) Q:'LA76821!(LA76821>LA7TRAY1)   D
"RTN","LA7UIO",28,0)
 . I '$D(ZTQUEUED) D
"RTN","LA7UIO",29,0)
 . . W !!,"Building download record for:"
"RTN","LA7UIO",30,0)
 . . I LRTYPE W " Tray: ",LA76821,!,"Cup: "
"RTN","LA7UIO",31,0)
 . . E  W !,"Seq: "
"RTN","LA7UIO",32,0)
 . D CUP
"RTN","LA7UIO",33,0)
 D EXIT
"RTN","LA7UIO",34,0)
 Q
"RTN","LA7UIO",35,0)
 ;
"RTN","LA7UIO",36,0)
 ;
"RTN","LA7UIO",37,0)
CUP ; Process each cup on load list
"RTN","LA7UIO",38,0)
 N LA761,LA76822,LA7QUIT,X
"RTN","LA7UIO",39,0)
 ;
"RTN","LA7UIO",40,0)
 S LA76822=LA7CUP-1,LA7QUIT=0
"RTN","LA7UIO",41,0)
 F  S LA76822=$O(^LRO(68.2,LRLL,1,LA76821,1,LA76822))  Q:'LA76822  D  Q:LA7QUIT
"RTN","LA7UIO",42,0)
 . I LA76821=LA7TRAY1,LA76822>LA7CUP1 S LA7QUIT=1 Q
"RTN","LA7UIO",43,0)
 . ; Kill array of tests for this accession
"RTN","LA7UIO",44,0)
 . K LA76249,LA7ACC
"RTN","LA7UIO",45,0)
 . S LA7ACC=^LRO(68.2,LRLL,1,LA76821,1,LA76822,0)
"RTN","LA7UIO",46,0)
 . ; Not requested loadlist profile.
"RTN","LA7UIO",47,0)
 . I 'LRPROF,($P(LRPROF,"^",2)'=$P(LA7ACC,"^",4)) Q
"RTN","LA7UIO",48,0)
 . ;
"RTN","LA7UIO",49,0)
 . S LRAA=+LA7ACC,LRAD=$P(LA7ACC,"^",2),LRAN=$P(LA7ACC,"^",3)
"RTN","LA7UIO",50,0)
 . S LA768=LRAA,LA76801=LRAD,LA76802=LRAN
"RTN","LA7UIO",51,0)
 . S LA7ACC0=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,0),0)
"RTN","LA7UIO",52,0)
 . ;
"RTN","LA7UIO",53,0)
 . S LA761=0
"RTN","LA7UIO",54,0)
 . S X=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
"RTN","LA7UIO",55,0)
 . I X>0 S LA761=+$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,5,X,0)),"^")
"RTN","LA7UIO",56,0)
 . ;
"RTN","LA7UIO",57,0)
 . ; Accession has been removed, skip.
"RTN","LA7UIO",58,0)
 . I 'LA7ACC0 D  Q
"RTN","LA7UIO",59,0)
 . . D CREATE^LA7LOG(24)
"RTN","LA7UIO",60,0)
 . ;
"RTN","LA7UIO",61,0)
 . D TEST
"RTN","LA7UIO",62,0)
 . S LA7INST=LRINST D CHKTEST^LA7ADL
"RTN","LA7UIO",63,0)
 . N LA7QUIT
"RTN","LA7UIO",64,0)
 . I $O(LA7ACC(0)) D BUILD^LA7UIO1
"RTN","LA7UIO",65,0)
 Q
"RTN","LA7UIO",66,0)
 ;
"RTN","LA7UIO",67,0)
 ;
"RTN","LA7UIO",68,0)
TEST ;
"RTN","LA7UIO",69,0)
 N LA7TST
"RTN","LA7UIO",70,0)
 ;
"RTN","LA7UIO",71,0)
 K LA7TREE
"RTN","LA7UIO",72,0)
 ;
"RTN","LA7UIO",73,0)
 S LA7TST=0
"RTN","LA7UIO",74,0)
 F  S LA7TST=$O(^LRO(68.2,LRLL,1,LA76821,1,LA76822,1,LA7TST)) Q:'LA7TST  D
"RTN","LA7UIO",75,0)
 . N LA7X,LA7PCNT
"RTN","LA7UIO",76,0)
 . S LA7X=$G(^LRO(68.2,LRLL,1,LA76821,1,LA76822,1,LA7TST,0))
"RTN","LA7UIO",77,0)
 . S LA7PCNT=0
"RTN","LA7UIO",78,0)
 . D UNWIND^LA7ADL1(+LA7X,$P(LA7X,"^",2),0)
"RTN","LA7UIO",79,0)
 Q
"RTN","LA7UIO",80,0)
 ;
"RTN","LA7UIO",81,0)
 ;
"RTN","LA7UIO",82,0)
ADL ; Process/build messages for automatic download, no loadlist.
"RTN","LA7UIO",83,0)
 ; Called from above by LA7ADL.
"RTN","LA7UIO",84,0)
 ;
"RTN","LA7UIO",85,0)
 S LRLL=0,LRAUTO=LA7AUTO(LA7INST)
"RTN","LA7UIO",86,0)
 ; Set tray/cup to null.
"RTN","LA7UIO",87,0)
 S (LA76821,LA76822)=""
"RTN","LA7UIO",88,0)
 ;
"RTN","LA7UIO",89,0)
 S LA768=LRAA,LA76801=LRAD,LA76802=LRAN
"RTN","LA7UIO",90,0)
 ; Zeroth node of accession.
"RTN","LA7UIO",91,0)
 ; Log error if accession has been removed, skip
"RTN","LA7UIO",92,0)
 S LA7ACC0=$G(^LRO(68,LA768,1,LA76801,1,LA76802,0),0)
"RTN","LA7UIO",93,0)
 I 'LA7ACC0 D  Q
"RTN","LA7UIO",94,0)
 . D CREATE^LA7LOG(24)
"RTN","LA7UIO",95,0)
 ;
"RTN","LA7UIO",96,0)
 D BUILD^LA7UIO1
"RTN","LA7UIO",97,0)
 D EXIT
"RTN","LA7UIO",98,0)
 K LRAUTO,LRINST,LRLL
"RTN","LA7UIO",99,0)
 Q
"RTN","LA7UIO",100,0)
 ;
"RTN","LA7UIO",101,0)
EXIT ;
"RTN","LA7UIO",102,0)
 D KVAR^LRX
"RTN","LA7UIO",103,0)
 K LA7,LA71,LA76249,LA768,LA76801,LA76802,LA76821,LA76822,LA7ACC,LA7ACC0
"RTN","LA7UIO",104,0)
 K LA7CNT,LA7CODE,LA7DATA,LA7DTIM,LA7MSH,LA7NVAF,LA7OBR,LA7ORC,LA7PID,LA7PIDSN,LA7PV1,LA7TMP,LRINFW
"RTN","LA7UIO",105,0)
 ;
"RTN","LA7UIO",106,0)
 Q
"RTN","LA7VIN4A")
0^9^B19473776
"RTN","LA7VIN4A",1,0)
LA7VIN4A ;DALOI/JMC - Process Incoming UI Msgs, continued ;08/12/13  10:54
"RTN","LA7VIN4A",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74,80**;Sep 27, 1994;Build 19
"RTN","LA7VIN4A",3,0)
 ;
"RTN","LA7VIN4A",4,0)
 ;This routine is a continuation of LA7VIN4 and is only called from there.
"RTN","LA7VIN4A",5,0)
 Q
"RTN","LA7VIN4A",6,0)
 ;
"RTN","LA7VIN4A",7,0)
 ;
"RTN","LA7VIN4A",8,0)
LAGEN ; Sets up variables for call to ^LAGEN,  build entry in LAH
"RTN","LA7VIN4A",9,0)
 ; requires LA7INST,LA7TRAY,LA7CUP,LA7AA,LA7AD,LA7AN,LA7LWL
"RTN","LA7VIN4A",10,0)
 ; returns LA7ISQN=subscript to store results in ^LAH global
"RTN","LA7VIN4A",11,0)
 ;
"RTN","LA7VIN4A",12,0)
 I LA7ENTRY="LOG" D
"RTN","LA7VIN4A",13,0)
 . I LA7INTYP>19,LA7INTYP<30 Q
"RTN","LA7VIN4A",14,0)
 . I '$D(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)) D CREATE^LA7LOG(13)
"RTN","LA7VIN4A",15,0)
 I LA7ENTRY="LLIST" S:'LA7CUP LA7CUP=LA7IDE ;cup=sequence number
"RTN","LA7VIN4A",16,0)
 ;
"RTN","LA7VIN4A",17,0)
 K LA7ISQN,LADT,LAGEN
"RTN","LA7VIN4A",18,0)
 K TRAY,CUP,LWL,WL,LROVER,METH,LOG,IDENT,ISQN
"RTN","LA7VIN4A",19,0)
 ;
"RTN","LA7VIN4A",20,0)
 S LA7ISQN=""
"RTN","LA7VIN4A",21,0)
 S TRAY=+$G(LA7TRAY) S:'TRAY TRAY=1
"RTN","LA7VIN4A",22,0)
 S CUP=+$G(LA7CUP) S:'CUP CUP=1
"RTN","LA7VIN4A",23,0)
 ;
"RTN","LA7VIN4A",24,0)
 S LWL=LA7LWL
"RTN","LA7VIN4A",25,0)
 I '$D(^LRO(68.2,+LWL,0)) D  Q
"RTN","LA7VIN4A",26,0)
 . D CREATE^LA7LOG(19)
"RTN","LA7VIN4A",27,0)
 ;
"RTN","LA7VIN4A",28,0)
 ; Set accession area to area of specimen, allow multiple areas on same instrument.
"RTN","LA7VIN4A",29,0)
 S WL=LA7AA
"RTN","LA7VIN4A",30,0)
 I '$D(^LRO(68,+WL,0)) D  Q
"RTN","LA7VIN4A",31,0)
 . D CREATE^LA7LOG(20)
"RTN","LA7VIN4A",32,0)
 S LROVER=$P(LA7624(0),"^",12)
"RTN","LA7VIN4A",33,0)
 ; LEDI(MI & AP) override #62.4 setting so results never overlay unless same message
"RTN","LA7VIN4A",34,0)
 I LA7INTYP=10 D
"RTN","LA7VIN4A",35,0)
 . I LA7SS'?1(1"MI",1"SP",1"CY",1"EM") Q
"RTN","LA7VIN4A",36,0)
 . ; Use same entry in LAH if handling multiple OBR within same message for same accession/test
"RTN","LA7VIN4A",37,0)
 . I $P($G(LA7INTYP("ISQN",LWL)),"^",1,3)=(LA76249_"^"_LA7UID_"^"_LA7ONLT) S ISQN=$P(LA7INTYP("ISQN",LWL),"^",4),LROVER=2 Q
"RTN","LA7VIN4A",38,0)
 . S LROVER=0
"RTN","LA7VIN4A",39,0)
 S METH=$P(LA7624(0),"^",10)
"RTN","LA7VIN4A",40,0)
 S LOG=LA7AN
"RTN","LA7VIN4A",41,0)
 S IDENT=$P($G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,0)),"^",6) ;identity field
"RTN","LA7VIN4A",42,0)
 S IDE=+LA7IDE
"RTN","LA7VIN4A",43,0)
 S LADT=LA7AD
"RTN","LA7VIN4A",44,0)
 ;
"RTN","LA7VIN4A",45,0)
 I LROVER<2 D
"RTN","LA7VIN4A",46,0)
 . N LRDFN ; Protect LRDFN - call into LAGEN can set to 0
"RTN","LA7VIN4A",47,0)
 . ;
"RTN","LA7VIN4A",48,0)
 . ; If POC interface call special entry point
"RTN","LA7VIN4A",49,0)
 . I LA7INTYP>19,LA7INTYP<30 S IDE=LA76249 D POC^LAGEN Q
"RTN","LA7VIN4A",50,0)
 . ;
"RTN","LA7VIN4A",51,0)
 . D @(LA7ENTRY_"^LAGEN") ;this disregards the CROSS LINK field in 62.4
"RTN","LA7VIN4A",52,0)
 ;
"RTN","LA7VIN4A",53,0)
 S LA7ISQN=$G(ISQN)
"RTN","LA7VIN4A",54,0)
 ;
"RTN","LA7VIN4A",55,0)
 I LA7ISQN<1 Q
"RTN","LA7VIN4A",56,0)
 ; Save entry made in LAH for this load list and message for this accession (UID)
"RTN","LA7VIN4A",57,0)
 I LA7INTYP=10 S LA7INTYP("ISQN",LWL)=LA76249_"^"_LA7UID_"^"_LA7ONLT_"^"_LA7ISQN
"RTN","LA7VIN4A",58,0)
 ;
"RTN","LA7VIN4A",59,0)
 ; Build/store patient demographics array
"RTN","LA7VIN4A",60,0)
 N I,J,LA7OBRA,LA7PIDA,X,Y
"RTN","LA7VIN4A",61,0)
 S J="DFN^DOB^ICN^LOC^LRDFN^LRTDFN^PNM^SEX^SSN"
"RTN","LA7VIN4A",62,0)
 S J(0)="DFN^LA7DOB^LA7ICN^LA7LOC^LRDFN^LRTDFN^LA7PNM^LA7SEX^LA7SSN"
"RTN","LA7VIN4A",63,0)
 F I=1:1 S X=$P(J,"^",I) Q:X=""  D
"RTN","LA7VIN4A",64,0)
 . S Y=$P(J(0),"^",I)
"RTN","LA7VIN4A",65,0)
 . I $G(@Y)'="" S LA7PIDA(X)=@Y
"RTN","LA7VIN4A",66,0)
 I $D(LA7PIDA) D POI^LAGEN(LA7LWL,LA7ISQN,"PID",.LA7PIDA)
"RTN","LA7VIN4A",67,0)
 ;
"RTN","LA7VIN4A",68,0)
 ; Build/store order info array
"RTN","LA7VIN4A",69,0)
 N LA7ONLTS
"RTN","LA7VIN4A",70,0)
 I LA7POP'="" S LA7POP=$P(LA7POP," [")
"RTN","LA7VIN4A",71,0)
 S X=$G(^LAH(LA7LWL,1,LA7ISQN,.1,"OBR","ORDNLT"))
"RTN","LA7VIN4A",72,0)
 I X'="",LA7ONLT'="",X'[LA7ONLT S LA7ONLTS=X_"^"_LA7ONLT
"RTN","LA7VIN4A",73,0)
 E  S LA7ONLTS=LA7ONLT
"RTN","LA7VIN4A",74,0)
 S J="EOL^FID^ORCDT^ORDNLT^ORDP^ORDSPEC^PON^SID^PEB^PVB^PRI^ARI^TECH"
"RTN","LA7VIN4A",75,0)
 S J(0)="LA7EOL^LA7FID^LA7CDT^LA7ONLTS^LA7POP^LA7SPEC^LA7PON^LA7SID^LA7PEB^LA7PVB^LA7PRI^LA7ARI^LA7TECH"
"RTN","LA7VIN4A",76,0)
 F I=1:1 S X=$P(J,"^",I) Q:X=""  D
"RTN","LA7VIN4A",77,0)
 . S Y=$P(J(0),"^",I)
"RTN","LA7VIN4A",78,0)
 . I $G(@Y)'="" S LA7OBRA(X)=@Y
"RTN","LA7VIN4A",79,0)
 I $D(LA7OBRA) D POI^LAGEN(LA7LWL,LA7ISQN,"OBR",.LA7OBRA)
"RTN","LA7VIN4A",80,0)
 ;
"RTN","LA7VIN4A",81,0)
 ; Save placer fields 1/2 and filler fields 1/2
"RTN","LA7VIN4A",82,0)
 I LA7SOBR>0 F I=18:1:21 S X=$P("PF1^PF2^FF1^FF2","^",I-17) S ^LAH(LA7LWL,1,LA7ISQN,.1,"OBR",X,LA7SOBR)=LA7OBR(I)
"RTN","LA7VIN4A",83,0)
 ;
"RTN","LA7VIN4A",84,0)
 ; Store interface type with results
"RTN","LA7VIN4A",85,0)
 D LATYP^LAGEN(LA7LWL,LA7ISQN,LA7INTYP)
"RTN","LA7VIN4A",86,0)
 ;
"RTN","LA7VIN4A",87,0)
 ; Store #62.49 ien with results
"RTN","LA7VIN4A",88,0)
 D LAMSGID^LAGEN(LA7LWL,LA7ISQN,LA76249)
"RTN","LA7VIN4A",89,0)
 ;
"RTN","LA7VIN4A",90,0)
 ; Store method name with LAH entry
"RTN","LA7VIN4A",91,0)
 D METH^LAGEN(LA7LWL,LA7ISQN,METH)
"RTN","LA7VIN4A",92,0)
 ;
"RTN","LA7VIN4A",93,0)
 ; Set flag if POC interface to start POC processing routine when
"RTN","LA7VIN4A",94,0)
 ; finished - tasked by LA7VIN before shutdown
"RTN","LA7VIN4A",95,0)
 I LA7INTYP>19,LA7INTYP<30 S LA7INTYP("LWL",LA7LWL)=""
"RTN","LA7VIN4A",96,0)
 ;
"RTN","LA7VIN4A",97,0)
 Q
"RTN","LA7VIN4A",98,0)
 ;
"RTN","LA7VIN4A",99,0)
 ;
"RTN","LA7VIN4A",100,0)
SMUPDT ; Update shipping manifest in shipping event file #62.85
"RTN","LA7VIN4A",101,0)
 N LA7DATA,LA7NCS,LA7TST,LA7USID
"RTN","LA7VIN4A",102,0)
 ;
"RTN","LA7VIN4A",103,0)
 S LA7USID=$$P^LA7VHLU(.LA7SEG,5,LA7FS) ; Universal Service ID (OBR-4)
"RTN","LA7VIN4A",104,0)
 S LA7TST=$P(LA7USID,LA7CS,1) ; Test code
"RTN","LA7VIN4A",105,0)
 S LA7NCS=$P(LA7USID,LA7CS,3) ; Name of coding system
"RTN","LA7VIN4A",106,0)
 S LA7TST(2)=$P(LA7USID,LA7CS,4) ; Alternate test code
"RTN","LA7VIN4A",107,0)
 S LA7NCS(2)=$P(LA7USID,LA7CS,6) ; Alternate coding system
"RTN","LA7VIN4A",108,0)
 ;
"RTN","LA7VIN4A",109,0)
 ; Determine ordered test, check primary and alternate
"RTN","LA7VIN4A",110,0)
 S LA7OTST=$$DOT^LA7SMU1(LA7TST,LA7NCS,LA7UID,$P(LA7SM,"^"))
"RTN","LA7VIN4A",111,0)
 I 'LA7OTST,LA7TST(2)'="" S LA7OTST=$$DOT^LA7SMU1(LA7TST(2),LA7NCS(2),LA7UID,$P(LA7SM,"^"))
"RTN","LA7VIN4A",112,0)
 ;
"RTN","LA7VIN4A",113,0)
 ; Flag the Results Received Event in #62.85
"RTN","LA7VIN4A",114,0)
 I LA7MTYP="ORU" D
"RTN","LA7VIN4A",115,0)
 . S LA7DATA="SM70"_"^"_LA7MEDT_"^"_$G(LA7OTST)_"^"_$P(LA7SM,"^",2)
"RTN","LA7VIN4A",116,0)
 . D SEUP^LA7SMU(LA7UID,"2",LA7DATA)
"RTN","LA7VIN4A",117,0)
 ;
"RTN","LA7VIN4A",118,0)
 ; Flag the Test Received Event in #62.85
"RTN","LA7VIN4A",119,0)
 I LA7MTYP="ORR" D
"RTN","LA7VIN4A",120,0)
 . S LA7DATA="SM55"_"^"_LA7MEDT_"^"_$G(LA7OTST)_"^"_$P(LA7SM,"^",2)
"RTN","LA7VIN4A",121,0)
 . D SEUP^LA7SMU(LA7UID,"2",LA7DATA)
"RTN","LA7VIN4A",122,0)
 Q
"RTN","LA7VIN71")
0^12^B21704396
"RTN","LA7VIN71",1,0)
LA7VIN71 ;DALOI/JDB - HANDLE ORU OBX FOR MICRO ;08/16/13  16:05
"RTN","LA7VIN71",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74,80**;Sep 27, 1994;Build 19
"RTN","LA7VIN71",3,0)
 ;
"RTN","LA7VIN71",4,0)
 ; Continuation of LA7VIN7 and is only called from there.
"RTN","LA7VIN71",5,0)
 ; Process OBX segments for "MI" subscript tests.
"RTN","LA7VIN71",6,0)
 Q
"RTN","LA7VIN71",7,0)
 ;
"RTN","LA7VIN71",8,0)
 ;
"RTN","LA7VIN71",9,0)
PROCESS ;
"RTN","LA7VIN71",10,0)
 ; File MI ^LAH for a given concept (LA76247)
"RTN","LA7VIN71",11,0)
 ; Called from OBX^LA7VIN7 for Micro data
"RTN","LA7VIN71",12,0)
 ; Major variables from LA7VIN7:
"RTN","LA7VIN71",13,0)
 ; DSOBX3,DSOBX5,LA76247,LA7SCT,OBX5,LA7612
"RTN","LA7VIN71",14,0)
 ;
"RTN","LA7VIN71",15,0)
 N SUBID,PSUBID,DDS,DDP,LA7DD,LAX,RMK,CNCPTOR
"RTN","LA7VIN71",16,0)
 S LA7DD=$$GET1^DID($P(DSOBX3,"^",3),$P($P(DSOBX3,"^",4),";"),"","GLOBAL SUBSCRIPT LOCATION")
"RTN","LA7VIN71",17,0)
 S LA7DD("LABEL")=$$GET1^DID($P(DSOBX3,"^",3),$P($P(DSOBX3,"^",4),";"),"","LABEL")
"RTN","LA7VIN71",18,0)
 S DDS=$P(LA7DD,";",1)  ;DD Subscript
"RTN","LA7VIN71",19,0)
 S DDP=$P(LA7DD,";",2)  ;DD Piece
"RTN","LA7VIN71",20,0)
 S:DDS="" DDS=-1
"RTN","LA7VIN71",21,0)
 S:DDP="" DDP=-1
"RTN","LA7VIN71",22,0)
 ;
"RTN","LA7VIN71",23,0)
 S SUBID=$G(OBX4)
"RTN","LA7VIN71",24,0)
 S SUBID=$$UNESC^LA7VHLU3(SUBID,LA7FS_LA7ECH)
"RTN","LA7VIN71",25,0)
 S SUBID=$$TRIM^XLFSTR(SUBID)
"RTN","LA7VIN71",26,0)
 S SUBID=$$MAKEISO^LRVRMI1(LA74,SUBID)
"RTN","LA7VIN71",27,0)
 S PSUBID=$$TRIM^XLFSTR($G(LAPSUBID))
"RTN","LA7VIN71",28,0)
 S PSUBID=$$MAKEISO^LRVRMI1(LA74,PSUBID)
"RTN","LA7VIN71",29,0)
 I SUBID="" S SUBID=PSUBID
"RTN","LA7VIN71",30,0)
 ;
"RTN","LA7VIN71",31,0)
 I 'LA7612 D  ; S LA7612=0 ;#61.2 IEN
"RTN","LA7VIN71",32,0)
 . S LAX=$P(DSOBX5,"^",1)
"RTN","LA7VIN71",33,0)
 . I $P(LAX,";",2)="LAB(61.2," S LA7612=$P(LAX,";",1)
"RTN","LA7VIN71",34,0)
 ;
"RTN","LA7VIN71",35,0)
 ; Need to override the concept?
"RTN","LA7VIN71",36,0)
 S CNCPTOR=0
"RTN","LA7VIN71",37,0)
 I OBX5[LA7CS,+DSOBX5=-1 D
"RTN","LA7VIN71",38,0)
 . S LAX=$P(DSOBX5,"^",5)
"RTN","LA7VIN71",39,0)
 . I LAX,LAX'=LA76247 S CNCPTOR=1,LA76247=LAX
"RTN","LA7VIN71",40,0)
 ;
"RTN","LA7VIN71",41,0)
 ;
"RTN","LA7VIN71",42,0)
 ; Override LOINC codes to handle fact that some generic codes can be applied to more than one storage location.
"RTN","LA7VIN71",43,0)
 ;
"RTN","LA7VIN71",44,0)
 ; Check if URINE or SPUTUM SCREEN and use VA NLT to find concept
"RTN","LA7VIN71",45,0)
 ;  - URINE and SPUTUM SCREEN uses same LOINC code for organsimn identified (positive/negative culture)
"RTN","LA7VIN71",46,0)
 I LA76247=3,$G(OBX3(6))="99VA64",$P(OBX3(4),".")?1(1"93948",1"93949") D
"RTN","LA7VIN71",47,0)
 . N X
"RTN","LA7VIN71",48,0)
 . S X=$$HL2LAH^LA7VHLU6(OBX3(4),OBX3(5),OBX3(6),OBX3(8),LA76248,"MI")
"RTN","LA7VIN71",49,0)
 . I X>0 S LA76247=+X
"RTN","LA7VIN71",50,0)
 ;
"RTN","LA7VIN71",51,0)
 ; COLONY COUNT used for ORGANISM(sub=3,6247=10), FUNGUS/YEAST(sub=9,6247=11) and MYCOBACTERIUM(sub=12,6247=20)
"RTN","LA7VIN71",52,0)
 ; Get previous ^LAH node used by using the whole record subid C xref
"RTN","LA7VIN71",53,0)
 I LA7RLNC="564-5" D
"RTN","LA7VIN71",54,0)
 . N SUB
"RTN","LA7VIN71",55,0)
 . S SUB=$O(^LAH(LWL,1,ISQN,"MI","C",SUBID,0))
"RTN","LA7VIN71",56,0)
 . I SUB>0 S LA76247=$S(SUB=3:10,SUB=9:11,SUB=12:20,1:LA76247)
"RTN","LA7VIN71",57,0)
 ;
"RTN","LA7VIN71",58,0)
 ; Check if VA AFB quantity and use VA NLT to find concept - AFB Stain and AFB Quantity use same LOINC code.
"RTN","LA7VIN71",59,0)
 I LA76247=79,$G(OBX3(6))="99VA64",$P(OBX3(4),".")="87583" D
"RTN","LA7VIN71",60,0)
 . N X
"RTN","LA7VIN71",61,0)
 . S X=$$HL2LAH^LA7VHLU6(OBX3(4),OBX3(5),OBX3(6),OBX3(8),LA76248,"MI")
"RTN","LA7VIN71",62,0)
 . I X>0 S LA76247=+X
"RTN","LA7VIN71",63,0)
 ;
"RTN","LA7VIN71",64,0)
 ; Check if Organism should be stored under Bacteriology section instead of MI section determined by OBX-3 mapping.
"RTN","LA7VIN71",65,0)
 ; Used in cases where a Parasite, Fungus, Mycobacterium, or Virus was reported on a Bacterial culture.
"RTN","LA7VIN71",66,0)
 S LA76247=$$BACTCHK^LA7VHLUB(LA7ONLT,LA7AA,LA7AD,LA7AN,LA76247)
"RTN","LA7VIN71",67,0)
 ;
"RTN","LA7VIN71",68,0)
 ;
"RTN","LA7VIN71",69,0)
 I LA76247=1 D 1^LA7VIN7A Q  ;subscr 2
"RTN","LA7VIN71",70,0)
 I LA76247=3 D 3^LA7VIN7A Q  ;subscr 3
"RTN","LA7VIN71",71,0)
 I LA76247=4 D 4^LA7VIN7B Q  ;subscr 12
"RTN","LA7VIN71",72,0)
 I LA76247=5 D 5^LA7VIN7C Q  ;subscr 17
"RTN","LA7VIN71",73,0)
 I LA76247=6 D  Q  ; subscr 4
"RTN","LA7VIN71",74,0)
 . I 'CNCPTOR D 6^LA7VIN7A()
"RTN","LA7VIN71",75,0)
 . I CNCPTOR D 6^LA7VIN7A($$BLDRMK())
"RTN","LA7VIN71",76,0)
 I LA76247=7 D 7^LA7VIN7A Q  ;subscr 3
"RTN","LA7VIN71",77,0)
 I LA76247=8 D 8^LA7VIN7D Q  ;subscr 6
"RTN","LA7VIN71",78,0)
 I LA76247=9 D 9^LA7VIN7B Q  ;subscr 9
"RTN","LA7VIN71",79,0)
 I LA76247=10 D 10^LA7VIN7A Q  ;subscr 3
"RTN","LA7VIN71",80,0)
 I LA76247=11 D 11^LA7VIN7B Q  ;subscr 9
"RTN","LA7VIN71",81,0)
 I LA76247=12 D 12^LA7VIN7D() Q  ;subscr 7
"RTN","LA7VIN71",82,0)
 I LA76247=13 D 13^LA7VIN7D Q  ;subscr 6
"RTN","LA7VIN71",83,0)
 I LA76247=14 D 14^LA7VIN7D Q  ;subscr 6
"RTN","LA7VIN71",84,0)
 I LA76247=15 D 15^LA7VIN7B() Q  ;subscr 10
"RTN","LA7VIN71",85,0)
 I LA76247=16 D 16^LA7VIN7A Q  ; subscr 1
"RTN","LA7VIN71",86,0)
 I LA76247=17 D 17^LA7VIN7A Q  ; subscr 1
"RTN","LA7VIN71",87,0)
 I LA76247=20 D 20^LA7VIN7B Q  ;subscr 12
"RTN","LA7VIN71",88,0)
 I LA76247=21 D 21^LA7VIN7B Q  ;subscr 12
"RTN","LA7VIN71",89,0)
 I LA76247=22 D 22^LA7VIN7C() Q  ;subscr 13
"RTN","LA7VIN71",90,0)
 I LA76247=30 D 30^LA7VIN7C() Q  ;subscr 18
"RTN","LA7VIN71",91,0)
 ;
"RTN","LA7VIN71",92,0)
 I LA76247>39,LA76247<48 D NODE^LA7VIN7C(LA76247,"") Q
"RTN","LA7VIN71",93,0)
 ;
"RTN","LA7VIN71",94,0)
 I LA76247=48 D 48^LA7VIN7C Q  ;subscr 31
"RTN","LA7VIN71",95,0)
 I LA76247=79 D 79^LA7VIN7B Q  ;subscr 11
"RTN","LA7VIN71",96,0)
 I LA76247=85 D 85^LA7VIN7B Q  ;subscr 11
"RTN","LA7VIN71",97,0)
 ;
"RTN","LA7VIN71",98,0)
 I LA76247>85,LA76247<91 D NODE^LA7VIN7C(LA76247,"") Q
"RTN","LA7VIN71",99,0)
 ;
"RTN","LA7VIN71",100,0)
 ;
"RTN","LA7VIN71",101,0)
 ; If we get this far then something went wrong
"RTN","LA7VIN71",102,0)
 ; Error: No filing method found for OBX
"RTN","LA7VIN71",103,0)
 D  ;
"RTN","LA7VIN71",104,0)
 . N LA7VOBX3
"RTN","LA7VIN71",105,0)
 . S LA7VOBX3=OBX3
"RTN","LA7VIN71",106,0)
 . D CREATE^LA7LOG(202)
"RTN","LA7VIN71",107,0)
 . S LA7KILAH=1 S LA7QUIT=2
"RTN","LA7VIN71",108,0)
 ;
"RTN","LA7VIN71",109,0)
 Q
"RTN","LA7VIN71",110,0)
 ;
"RTN","LA7VIN71",111,0)
 ;
"RTN","LA7VIN71",112,0)
BLDRMK() ;
"RTN","LA7VIN71",113,0)
 ; Constructs comment/remarks for special situations like
"RTN","LA7VIN71",114,0)
 ; processing an OBX5 with flora normal (which gets filed as a
"RTN","LA7VIN71",115,0)
 ; Bact RPT REMARK).
"RTN","LA7VIN71",116,0)
 ;
"RTN","LA7VIN71",117,0)
 ; If there's an SCT code:
"RTN","LA7VIN71",118,0)
 ;   [SUBID]SCT Text
"RTN","LA7VIN71",119,0)
 ;
"RTN","LA7VIN71",120,0)
 ; If no SCT code:
"RTN","LA7VIN71",121,0)
 ;    If OBX5 contains HL7 component sep, 2nd piece of first tuplet
"RTN","LA7VIN71",122,0)
 ;    else its the full OBX5 text
"RTN","LA7VIN71",123,0)
 ;    [SUBID]OBX5 text
"RTN","LA7VIN71",124,0)
 ;
"RTN","LA7VIN71",125,0)
 N X,TXT,SID
"RTN","LA7VIN71",126,0)
 S X=SUBID
"RTN","LA7VIN71",127,0)
 S:X="" X=$G(PSUBID)
"RTN","LA7VIN71",128,0)
 S:X'="" X="["_X_"]"
"RTN","LA7VIN71",129,0)
 S SID=X
"RTN","LA7VIN71",130,0)
 S TXT=""
"RTN","LA7VIN71",131,0)
 I LA7SCT'="" D  ;
"RTN","LA7VIN71",132,0)
 . N SCT
"RTN","LA7VIN71",133,0)
 . S X=$$CODE^LRSCT(LA7SCT,"SCT",,"SCT")
"RTN","LA7VIN71",134,0)
 . S TXT=$G(SCT("P"))
"RTN","LA7VIN71",135,0)
 . S:TXT="" TXT=$G(SCT("F"))
"RTN","LA7VIN71",136,0)
 . I TXT="" D  ;
"RTN","LA7VIN71",137,0)
 . . N DATA,CODSYS
"RTN","LA7VIN71",138,0)
 . . S DATA=OBX5
"RTN","LA7VIN71",139,0)
 . . D FLD2ARR^LA7VHLU7(.DATA)
"RTN","LA7VIN71",140,0)
 . . D CODSYS^LA7VHLU7(.DATA,.CODSYS,"SCT")
"RTN","LA7VIN71",141,0)
 . . S TXT=$G(CODSYS(2))
"RTN","LA7VIN71",142,0)
 . . K DATA,CODSYS
"RTN","LA7VIN71",143,0)
 . S:TXT="" TXT="SCT:"_LA7SCT
"RTN","LA7VIN71",144,0)
 I LA7SCT="" D  ;
"RTN","LA7VIN71",145,0)
 . I OBX5[LA7CS S TXT=$P(OBX5,LA7CS,2)
"RTN","LA7VIN71",146,0)
 . I TXT="" S TXT=OBX5
"RTN","LA7VIN71",147,0)
 . S TXT=$$UNESC^LA7VHLU3(TXT,LA7FS_LA7ECH)
"RTN","LA7VIN71",148,0)
 Q SID_TXT
"RTN","LA7VIN71",149,0)
 ;
"RTN","LA7VIN71",150,0)
 ;
"RTN","LA7VIN71",151,0)
STRSPLIT(STR,MAXLEN,OUT) ;
"RTN","LA7VIN71",152,0)
 ; Splits a string into substrings no more than MAXLEN long
"RTN","LA7VIN71",153,0)
 ; Useful when storing things such as COMMENT fields
"RTN","LA7VIN71",154,0)
 N I,Y,SUBS
"RTN","LA7VIN71",155,0)
 S SUBS=$L(STR)\MAXLEN
"RTN","LA7VIN71",156,0)
 S:($L(STR)#MAXLEN)>0 SUBS=SUBS+1
"RTN","LA7VIN71",157,0)
 F I=0:1:SUBS-1 S Y=(I*MAXLEN)+1 D  ;
"RTN","LA7VIN71",158,0)
 . S OUT(I+1)=$E(STR,Y,(Y+MAXLEN)-1)
"RTN","LA7VIN71",159,0)
 . S Y=Y+MAXLEN
"RTN","LA7VIN71",160,0)
 Q SUBS
"RTN","LA7VIN71",161,0)
 ;
"RTN","LA7VIN71",162,0)
 ;
"RTN","LA7VIN71",163,0)
NTE(R6247,I,PREFIX) ;
"RTN","LA7VIN71",164,0)
 ; Set variable for HL7 NTE processing
"RTN","LA7VIN71",165,0)
 ; Inputs
"RTN","LA7VIN71",166,0)
 ;   R6247  : #62.47 IEN (Concept)
"RTN","LA7VIN71",167,0)
 ;       I  : Usually either ISQN or ISQN2
"RTN","LA7VIN71",168,0)
 ;   PREFIX : text of prefix (optional)
"RTN","LA7VIN71",169,0)
 S LA7RMK(0,0)=R6247_"^"_I_"^"_$G(PREFIX)
"RTN","LA7VIN71",170,0)
 Q
"RTN","LA7VIN71",171,0)
 ;
"RTN","LA7VIN71",172,0)
 ;
"RTN","LA7VIN71",173,0)
SUBIDERR ;
"RTN","LA7VIN71",174,0)
 ; Error handler when subid (OBX4) is null or unknown
"RTN","LA7VIN71",175,0)
 N LA7VOBX3,LA7VOBX4
"RTN","LA7VIN71",176,0)
 S LA7VOBX3=OBX3
"RTN","LA7VIN71",177,0)
 S LA7VOBX4=OBX4
"RTN","LA7VIN71",178,0)
 D CREATE^LA7LOG(205)
"RTN","LA7VIN71",179,0)
 S LA7KILAH=1 S LA7QUIT=2
"RTN","LA7VIN71",180,0)
 Q
"RTN","LA7VIN7C")
0^11^B42479147
"RTN","LA7VIN7C",1,0)
LA7VIN7C ;DALOI/JDB - Process ORU's OBX for Micro ;08/16/13  16:09
"RTN","LA7VIN7C",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**74,80**;Sep 27, 1994;Build 19
"RTN","LA7VIN7C",3,0)
 ;
"RTN","LA7VIN7C",4,0)
 ; Continuation of LA7VIN7 and is only called from there.
"RTN","LA7VIN7C",5,0)
 ; Process OBX segments for "MI" subscript tests.
"RTN","LA7VIN7C",6,0)
 Q
"RTN","LA7VIN7C",7,0)
 ;
"RTN","LA7VIN7C",8,0)
 ;
"RTN","LA7VIN7C",9,0)
5 ; Process Virus (Subscript 17)
"RTN","LA7VIN7C",10,0)
 ;
"RTN","LA7VIN7C",11,0)
 N X,SUB,ISQN2
"RTN","LA7VIN7C",12,0)
 I DDS<0!(DDP<1) D DDERR^LA7VIN7A Q
"RTN","LA7VIN7C",13,0)
 I LA7612<1 D  Q  ;
"RTN","LA7VIN7C",14,0)
 . ; Unknown entity in OBX-5
"RTN","LA7VIN7C",15,0)
 . N LA7VOBX5
"RTN","LA7VIN7C",16,0)
 . S LA7VOBX5=OBX5 ;needed for log
"RTN","LA7VIN7C",17,0)
 . S LA7VOBX5=$$UNESC^LA7VHLU3(LA7VOBX5,LA7FS_LA7ECH)
"RTN","LA7VIN7C",18,0)
 . D CREATE^LA7LOG(204)
"RTN","LA7VIN7C",19,0)
 . S LA7KILAH=1 S LA7QUIT=2
"RTN","LA7VIN7C",20,0)
 ;
"RTN","LA7VIN7C",21,0)
 S ISQN2=0
"RTN","LA7VIN7C",22,0)
 I SUBID'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",17,SUBID)
"RTN","LA7VIN7C",23,0)
 I SUBID="" I $G(PSUBID)'="" S ISQN2=$$SUBID^LAGEN(LWL,LA7ISQN,"MI",17,PSUBID)
"RTN","LA7VIN7C",24,0)
 I 'ISQN2 D  Q  ;
"RTN","LA7VIN7C",25,0)
 . D SUBIDERR^LA7VIN71
"RTN","LA7VIN7C",26,0)
 ;
"RTN","LA7VIN7C",27,0)
 S SUB="17,"_ISQN2_",0"
"RTN","LA7VIN7C",28,0)
 D LAH(SUB,DDP,LA7612) ; organism #61.2 IEN
"RTN","LA7VIN7C",29,0)
 S SUB="17,"_ISQN2_",.1"
"RTN","LA7VIN7C",30,0)
 D LAH(SUB,1,SUBID) ; isolate id
"RTN","LA7VIN7C",31,0)
 S SUB="17,"_ISQN2_",.01"
"RTN","LA7VIN7C",32,0)
 D LAH(SUB,1,LA7RLNC) ; LOINC IEN
"RTN","LA7VIN7C",33,0)
 D LAH(SUB,2,LA7RNLT) ; NLT code
"RTN","LA7VIN7C",34,0)
 D LAH(SUB,3,LA7SCT) ; SCT Code
"RTN","LA7VIN7C",35,0)
 S SUB="17,"_ISQN2_",0,.01,0"
"RTN","LA7VIN7C",36,0)
 D LAH(SUB,1,OBX11) ;
"RTN","LA7VIN7C",37,0)
 S SUB="17,"_ISQN2_",0,.01,1"
"RTN","LA7VIN7C",38,0)
 D LAH(SUB,1,LA74)
"RTN","LA7VIN7C",39,0)
 S X=$P(LA7RO,"^",3)
"RTN","LA7VIN7C",40,0)
 D LAH(SUB,2,X)
"RTN","LA7VIN7C",41,0)
 D NTE
"RTN","LA7VIN7C",42,0)
 Q
"RTN","LA7VIN7C",43,0)
 ;
"RTN","LA7VIN7C",44,0)
 ;
"RTN","LA7VIN7C",45,0)
22(COM) ; Process TB Rpt Remark (Subscript 13)
"RTN","LA7VIN7C",46,0)
 ; Input
"RTN","LA7VIN7C",47,0)
 ;  COM : <opt> The text to use for the remark (comment)
"RTN","LA7VIN7C",48,0)
 ;      :  If empty OBX5 is used
"RTN","LA7VIN7C",49,0)
 ;
"RTN","LA7VIN7C",50,0)
 N X,SUB,ISQN2,TEXT,TEXT2,MAXLEN
"RTN","LA7VIN7C",51,0)
 ; Dont initialize COM
"RTN","LA7VIN7C",52,0)
 S SUB="13,0"
"RTN","LA7VIN7C",53,0)
 D LAH(SUB,1,LA74)
"RTN","LA7VIN7C",54,0)
 S X=$P(LA7RO,"^",3)
"RTN","LA7VIN7C",55,0)
 D LAH(SUB,2,X) ; resp obsv
"RTN","LA7VIN7C",56,0)
 D LAH(SUB,3,LA7RLNC) ; LOINC
"RTN","LA7VIN7C",57,0)
 D LAH(SUB,4,OBX11) ;obsv status
"RTN","LA7VIN7C",58,0)
 S ISQN2=$O(^LAH(LWL,1,LA7ISQN,"MI",13,"A"),-1)+1
"RTN","LA7VIN7C",59,0)
 ; pull comment from COM or OBX5
"RTN","LA7VIN7C",60,0)
 S TEXT="OBX5"
"RTN","LA7VIN7C",61,0)
 I $D(COM)=1 S TEXT="COM"
"RTN","LA7VIN7C",62,0)
 I TEXT="OBX5" S TEXT2=$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH)
"RTN","LA7VIN7C",63,0)
 I TEXT="COM" S TEXT2=$G(COM)
"RTN","LA7VIN7C",64,0)
 S MAXLEN=68 ; COMMENTS field size
"RTN","LA7VIN7C",65,0)
 S SUB="13,"_ISQN2_",0"
"RTN","LA7VIN7C",66,0)
 ; insert separator line if needed
"RTN","LA7VIN7C",67,0)
 I ISQN2>1 D LAH(SUB,1," ") S ISQN2=ISQN2+1 S SUB="13,"_ISQN2_",0"
"RTN","LA7VIN7C",68,0)
 ;
"RTN","LA7VIN7C",69,0)
 ; if this an override insert Original Concept name
"RTN","LA7VIN7C",70,0)
 I $P(DSOBX3,"^",6) I $P(DSOBX3,"^",1)'=$P(DSOBX3,"^",6) D  ;
"RTN","LA7VIN7C",71,0)
 . S X=$P(DSOBX3,"^",6) ;original concept
"RTN","LA7VIN7C",72,0)
 . S X=$G(^LAB(62.47,X,0))
"RTN","LA7VIN7C",73,0)
 . S X=$P(X,U,1)
"RTN","LA7VIN7C",74,0)
 . Q:X=""
"RTN","LA7VIN7C",75,0)
 . D LAH(SUB,1,"["_X_"]")
"RTN","LA7VIN7C",76,0)
 . S ISQN2=ISQN2+1 S SUB="13,"_ISQN2_",0"
"RTN","LA7VIN7C",77,0)
 ;
"RTN","LA7VIN7C",78,0)
 ; modify MAXLEN for prefixed Subid
"RTN","LA7VIN7C",79,0)
 I $L(TEXT2)'>MAXLEN D  ;
"RTN","LA7VIN7C",80,0)
 . D LAH(SUB,1,TEXT2)
"RTN","LA7VIN7C",81,0)
 ;
"RTN","LA7VIN7C",82,0)
 I $L(TEXT2)>MAXLEN D  ;
"RTN","LA7VIN7C",83,0)
 . N I,Y,PASS
"RTN","LA7VIN7C",84,0)
 . S PASS=$L(TEXT2)\MAXLEN
"RTN","LA7VIN7C",85,0)
 . S:($L(TEXT2)#MAXLEN)>0 PASS=PASS+1
"RTN","LA7VIN7C",86,0)
 . F I=0:1:PASS-1 S Y=(I*MAXLEN)+1 D  ;
"RTN","LA7VIN7C",87,0)
 . . D LAH(SUB,1,$E(TEXT2,Y,(Y+MAXLEN)-1))
"RTN","LA7VIN7C",88,0)
 . . S Y=Y+MAXLEN
"RTN","LA7VIN7C",89,0)
 . . S ISQN2=ISQN2+1
"RTN","LA7VIN7C",90,0)
 . . S SUB="13,"_ISQN2_",0"
"RTN","LA7VIN7C",91,0)
 . ;
"RTN","LA7VIN7C",92,0)
 D NTE^LA7VIN71(LA76247,ISQN)
"RTN","LA7VIN7C",93,0)
 Q
"RTN","LA7VIN7C",94,0)
 ;
"RTN","LA7VIN7C",95,0)
 ;
"RTN","LA7VIN7C",96,0)
30(COM) ; Process Virology Rpt Remark (Subscript 18)
"RTN","LA7VIN7C",97,0)
 ; Input
"RTN","LA7VIN7C",98,0)
 ;  COM : <opt> The text to use for the remark (comment)
"RTN","LA7VIN7C",99,0)
 ;      :  If empty OBX5 is used
"RTN","LA7VIN7C",100,0)
 ;
"RTN","LA7VIN7C",101,0)
 N X,SUB,ISQN2,TEXT,TEXT2,MAXLEN
"RTN","LA7VIN7C",102,0)
 ; Dont initialize COM
"RTN","LA7VIN7C",103,0)
 S SUB="18,0"
"RTN","LA7VIN7C",104,0)
 D LAH(SUB,1,LA74)
"RTN","LA7VIN7C",105,0)
 S X=$P(LA7RO,"^",3)
"RTN","LA7VIN7C",106,0)
 D LAH(SUB,2,X) ; resp obsv
"RTN","LA7VIN7C",107,0)
 D LAH(SUB,3,LA7RLNC) ; LOINC
"RTN","LA7VIN7C",108,0)
 D LAH(SUB,4,OBX11) ;obsv status
"RTN","LA7VIN7C",109,0)
 S ISQN2=$O(^LAH(LWL,1,LA7ISQN,"MI",18,"A"),-1)+1
"RTN","LA7VIN7C",110,0)
 ; pull comment from COM or OBX5
"RTN","LA7VIN7C",111,0)
 S TEXT="OBX5"
"RTN","LA7VIN7C",112,0)
 I $D(COM)=1 S TEXT="COM"
"RTN","LA7VIN7C",113,0)
 I TEXT="OBX5" S TEXT2=$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH)
"RTN","LA7VIN7C",114,0)
 I TEXT="COM" S TEXT2=$G(COM)
"RTN","LA7VIN7C",115,0)
 S MAXLEN=68 ; COMMENTS field size
"RTN","LA7VIN7C",116,0)
 S SUB="18,"_ISQN2_",0"
"RTN","LA7VIN7C",117,0)
 ; insert separator line if needed
"RTN","LA7VIN7C",118,0)
 I ISQN2>1 D LAH(SUB,1," ") S ISQN2=ISQN2+1 S SUB="18,"_ISQN2_",0"
"RTN","LA7VIN7C",119,0)
 ;
"RTN","LA7VIN7C",120,0)
 ; if this an override insert Original Concept name
"RTN","LA7VIN7C",121,0)
 I $P(DSOBX3,"^",6) I $P(DSOBX3,"^",1)'=$P(DSOBX3,"^",6) D  ;
"RTN","LA7VIN7C",122,0)
 . S X=$P(DSOBX3,"^",6) ;original concept
"RTN","LA7VIN7C",123,0)
 . S X=$G(^LAB(62.47,X,0))
"RTN","LA7VIN7C",124,0)
 . S X=$P(X,U,1)
"RTN","LA7VIN7C",125,0)
 . Q:X=""
"RTN","LA7VIN7C",126,0)
 . D LAH(SUB,1,"["_X_"]")
"RTN","LA7VIN7C",127,0)
 . S ISQN2=ISQN2+1 S SUB="13,"_ISQN2_",0"
"RTN","LA7VIN7C",128,0)
 ;
"RTN","LA7VIN7C",129,0)
 ; modify MAXLEN for prefixed Subid
"RTN","LA7VIN7C",130,0)
 I $L(TEXT2)'>MAXLEN D  ;
"RTN","LA7VIN7C",131,0)
 . D LAH(SUB,1,TEXT2)
"RTN","LA7VIN7C",132,0)
 I $L(TEXT2)>MAXLEN D  ;
"RTN","LA7VIN7C",133,0)
 . N I,Y,PASS
"RTN","LA7VIN7C",134,0)
 . S PASS=$L(TEXT2)\MAXLEN
"RTN","LA7VIN7C",135,0)
 . S:($L(TEXT2)#MAXLEN)>0 PASS=PASS+1
"RTN","LA7VIN7C",136,0)
 . F I=0:1:PASS-1 S Y=(I*MAXLEN)+1 D  ;
"RTN","LA7VIN7C",137,0)
 . . D LAH(SUB,1,$E(TEXT2,Y,(Y+MAXLEN)-1))
"RTN","LA7VIN7C",138,0)
 . . S Y=Y+MAXLEN
"RTN","LA7VIN7C",139,0)
 . . S ISQN2=ISQN2+1
"RTN","LA7VIN7C",140,0)
 . . S SUB="18,"_ISQN2_",0"
"RTN","LA7VIN7C",141,0)
 . ;
"RTN","LA7VIN7C",142,0)
 D NTE^LA7VIN71(LA76247,ISQN)
"RTN","LA7VIN7C",143,0)
 Q
"RTN","LA7VIN7C",144,0)
 ;
"RTN","LA7VIN7C",145,0)
 ;
"RTN","LA7VIN7C",146,0)
48 ; Process Sterility Results (Subscript 31)
"RTN","LA7VIN7C",147,0)
 ;
"RTN","LA7VIN7C",148,0)
 N LRX,SUB,ISQN2
"RTN","LA7VIN7C",149,0)
 S ISQN2=$O(^LAH(LWL,1,LA7ISQN,"MI",31,"A"),-1)+1
"RTN","LA7VIN7C",150,0)
 S SUB="31,"_ISQN2_",0"
"RTN","LA7VIN7C",151,0)
 S LRX=$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH)
"RTN","LA7VIN7C",152,0)
 D  ;
"RTN","LA7VIN7C",153,0)
 . N LRZ,LAMSG
"RTN","LA7VIN7C",154,0)
 . D CHK^DIE(63.292,.01,"",LRX,.LRZ,"LAMSG")
"RTN","LA7VIN7C",155,0)
 . I $G(LRZ)'="^" S LRX=LRZ
"RTN","LA7VIN7C",156,0)
 ;
"RTN","LA7VIN7C",157,0)
 D LAH(SUB,1,LRX)
"RTN","LA7VIN7C",158,0)
 ;
"RTN","LA7VIN7C",159,0)
 D ADDINFO(31,ISQN2) ;
"RTN","LA7VIN7C",160,0)
 ;
"RTN","LA7VIN7C",161,0)
 D NTE^LA7VIN71(LA76247,ISQN)
"RTN","LA7VIN7C",162,0)
 Q
"RTN","LA7VIN7C",163,0)
 ;
"RTN","LA7VIN7C",164,0)
 ;
"RTN","LA7VIN7C",165,0)
NODE(LA76247,COM) ; Process series of free-text multiples.
"RTN","LA7VIN7C",166,0)
 ;
"RTN","LA7VIN7C",167,0)
 ; Handles the following 62.47 concepts and the corresponding free-text multiple in Microbiology (MI) subscript
"RTN","LA7VIN7C",168,0)
 ; Sequence Concept                           Field                                 Subscript
"RTN","LA7VIN7C",169,0)
 ;
"RTN","LA7VIN7C",170,0)
 ;   40     MYCOLOGY SMEAR/PREP               (#19.6)  MYCOLOGY SMEAR/PREP              15
"RTN","LA7VIN7C",171,0)
 ;   41     PARASITOLOGY SMEAR PREP           (#15.51) PARASITOLOGY SMEAR/PREP          24
"RTN","LA7VIN7C",172,0)
 ;   42     BACTERIOLOGY SMEAR PREP           (#11.7)  BACTERIOLOGY SMEAR/PREP          25
"RTN","LA7VIN7C",173,0)
 ;   43     BACTERIOLOGY TEST                 (#1.5)   BACTERIOLOGY TEST(S)             26
"RTN","LA7VIN7C",174,0)
 ;   44     PARASITE TEST                     (#16.4)  PARASITE TEST(S)                 27
"RTN","LA7VIN7C",175,0)
 ;   45     MYCOLOGY TEST                     (#20.4)  MYCOLOGY TEST(S)                 28
"RTN","LA7VIN7C",176,0)
 ;   46     TB TEST                           (#26.4)  TB TEST(S)                       29
"RTN","LA7VIN7C",177,0)
 ;   47     VIROLOGY TEST                     (#36.4)  VIROLOGY TESTS                   30
"RTN","LA7VIN7C",178,0)
 ;
"RTN","LA7VIN7C",179,0)
 ;  The following are currently processed from NTE segments - See LA7VIN2A (NTE/MISPC)
"RTN","LA7VIN7C",180,0)
 ;   86     MI PRELIMINARY BACT COMMENT       (#1)     PRELIMINARY BACT COMMENT         19
"RTN","LA7VIN7C",181,0)
 ;   87     MI PRELIMINARY VIROLOGY COMMENT   (#36.5)  PRELIMINARY VIROLOGY COMMENT     20
"RTN","LA7VIN7C",182,0)
 ;   88     MI PRELIMINARY PARASITE COMMENT   (#16.5)  PRELIMINARY PARASITE COMMENT     21
"RTN","LA7VIN7C",183,0)
 ;   89     MI PRELIMINARY MYCOLOGY COMMENT   (#20.5)  PRELIMINARY MYCOLOGY COMMENT     22
"RTN","LA7VIN7C",184,0)
 ;   90     MI PRELIMINARY TB COMMENT         (#26.5)  PRELIMINARY TB COMMENT           23
"RTN","LA7VIN7C",185,0)
 ;
"RTN","LA7VIN7C",186,0)
 ; Input
"RTN","LA7VIN7C",187,0)
 ;  LA76247 : ien of related concept in file #62.47
"RTN","LA7VIN7C",188,0)
 ;      COM : <opt> The text to use for the remark (comment)
"RTN","LA7VIN7C",189,0)
 ;          :  If empty OBX5 is used
"RTN","LA7VIN7C",190,0)
 ;
"RTN","LA7VIN7C",191,0)
 ; Don't initialize COM
"RTN","LA7VIN7C",192,0)
 ;
"RTN","LA7VIN7C",193,0)
 N ISQN2,MAXLEN,SUB,SUBROOT,TEXT,TEXT2,X
"RTN","LA7VIN7C",194,0)
 ;
"RTN","LA7VIN7C",195,0)
 ; Determine subscript based on 62.47 concept number.
"RTN","LA7VIN7C",196,0)
 I LA76247<48 S SUBROOT=$P("15^24^25^26^27^28^29^30","^",LA76247-39)
"RTN","LA7VIN7C",197,0)
 E  S SUBROOT=$P("19^20^21^22^23","^",LA76247-85)
"RTN","LA7VIN7C",198,0)
 ;
"RTN","LA7VIN7C",199,0)
 S ISQN2=$O(^LAH(LWL,1,LA7ISQN,"MI",SUBROOT,"A"),-1)+1
"RTN","LA7VIN7C",200,0)
 S SUB=SUBROOT_","_ISQN2_",0"
"RTN","LA7VIN7C",201,0)
 ;
"RTN","LA7VIN7C",202,0)
 ; pull comment from COM or OBX5
"RTN","LA7VIN7C",203,0)
 I $G(COM)=""  S TEXT="OBX5",TEXT2=$$UNESC^LA7VHLU3(OBX5,LA7FS_LA7ECH)
"RTN","LA7VIN7C",204,0)
 E  S TEXT="COM",TEXT2=COM
"RTN","LA7VIN7C",205,0)
 S MAXLEN=68 ; free-text field size
"RTN","LA7VIN7C",206,0)
 ;
"RTN","LA7VIN7C",207,0)
 ; insert separator line if needed
"RTN","LA7VIN7C",208,0)
 I ISQN2>1 D
"RTN","LA7VIN7C",209,0)
 . D LAH(SUB,1," ")
"RTN","LA7VIN7C",210,0)
 . D ADDINFO(SUBROOT,ISQN2)
"RTN","LA7VIN7C",211,0)
 . S ISQN2=ISQN2+1,SUB=SUBROOT_","_ISQN2_",0"
"RTN","LA7VIN7C",212,0)
 ;
"RTN","LA7VIN7C",213,0)
 ; if this an override insert Original Concept name
"RTN","LA7VIN7C",214,0)
 I $P(DSOBX3,"^",6),$P(DSOBX3,"^",1)'=$P(DSOBX3,"^",6) D
"RTN","LA7VIN7C",215,0)
 . S X=$P(DSOBX3,"^",6) ;original concept
"RTN","LA7VIN7C",216,0)
 . S X=$G(^LAB(62.47,X,0))
"RTN","LA7VIN7C",217,0)
 . S X=$P(X,U,1)
"RTN","LA7VIN7C",218,0)
 . Q:X=""
"RTN","LA7VIN7C",219,0)
 . D LAH(SUB,1,"["_X_"]")
"RTN","LA7VIN7C",220,0)
 . D ADDINFO(SUBROOT,ISQN2)
"RTN","LA7VIN7C",221,0)
 . S ISQN2=ISQN2+1,SUB=SUBROOT_","_ISQN2_",0"
"RTN","LA7VIN7C",222,0)
 ;
"RTN","LA7VIN7C",223,0)
 ; modify MAXLEN for prefixed Subid
"RTN","LA7VIN7C",224,0)
 I $L(TEXT2)'>MAXLEN D LAH(SUB,1,TEXT2),ADDINFO(SUBROOT,ISQN2)
"RTN","LA7VIN7C",225,0)
 ;
"RTN","LA7VIN7C",226,0)
 I $L(TEXT2)>MAXLEN D
"RTN","LA7VIN7C",227,0)
 . N LA7I,LA7Y,PASS
"RTN","LA7VIN7C",228,0)
 . S PASS=$L(TEXT2)\MAXLEN
"RTN","LA7VIN7C",229,0)
 . S:($L(TEXT2)#MAXLEN)>0 PASS=PASS+1
"RTN","LA7VIN7C",230,0)
 . F LA7I=0:1:PASS-1 D
"RTN","LA7VIN7C",231,0)
 . . S LA7Y=(LA7I*MAXLEN)+1
"RTN","LA7VIN7C",232,0)
 . . D LAH(SUB,1,$E(TEXT2,LA7Y,(LA7Y+MAXLEN)-1))
"RTN","LA7VIN7C",233,0)
 . . D ADDINFO(SUBROOT,ISQN2)
"RTN","LA7VIN7C",234,0)
 . . S LA7Y=LA7Y+MAXLEN
"RTN","LA7VIN7C",235,0)
 . . S ISQN2=ISQN2+1,SUB=SUBROOT_","_ISQN2_",0"
"RTN","LA7VIN7C",236,0)
 ;
"RTN","LA7VIN7C",237,0)
 D NTE^LA7VIN71(LA76247,ISQN)
"RTN","LA7VIN7C",238,0)
 ;
"RTN","LA7VIN7C",239,0)
 Q
"RTN","LA7VIN7C",240,0)
 ;
"RTN","LA7VIN7C",241,0)
 ;
"RTN","LA7VIN7C",242,0)
LAH(LASUB,LAP,LAVAL) ;
"RTN","LA7VIN7C",243,0)
 ; Convenience method
"RTN","LA7VIN7C",244,0)
 D LAH^LAGEN(+$G(LWL),+$G(LA7ISQN),"MI",LASUB,LAP,LAVAL)
"RTN","LA7VIN7C",245,0)
 Q
"RTN","LA7VIN7C",246,0)
 ;
"RTN","LA7VIN7C",247,0)
 ;
"RTN","LA7VIN7C",248,0)
NTE ;
"RTN","LA7VIN7C",249,0)
 ; Convenience method
"RTN","LA7VIN7C",250,0)
 D NTE^LA7VIN71(LA76247,ISQN2)
"RTN","LA7VIN7C",251,0)
 Q
"RTN","LA7VIN7C",252,0)
 ;
"RTN","LA7VIN7C",253,0)
 ;
"RTN","LA7VIN7C",254,0)
ADDINFO(SUBSCR,ISQN2) ;
"RTN","LA7VIN7C",255,0)
 ; Add result info (lab, person, status, etc.) to comment nodes.
"RTN","LA7VIN7C",256,0)
 ;  Used for adding info to each comment line (0,0 node)
"RTN","LA7VIN7C",257,0)
 ; Inputs
"RTN","LA7VIN7C",258,0)
 ;   SUBSCR: The LAH subscript (eg 25 for Concept 42)
"RTN","LA7VIN7C",259,0)
 ;    ISQN2: The comment sequence number.
"RTN","LA7VIN7C",260,0)
 N SUB,X,Y
"RTN","LA7VIN7C",261,0)
 S SUBSCR=$G(SUBSCR)
"RTN","LA7VIN7C",262,0)
 S ISQN2=$G(ISQN2)
"RTN","LA7VIN7C",263,0)
 S SUB=SUBSCR_","_ISQN2_",0,0"
"RTN","LA7VIN7C",264,0)
 D LAH(SUB,1,LA74)
"RTN","LA7VIN7C",265,0)
 S X=$P(LA7RO,"^",3)
"RTN","LA7VIN7C",266,0)
 D LAH(SUB,2,X) ; resp obsv
"RTN","LA7VIN7C",267,0)
 D LAH(SUB,3,LA7RLNC) ; LOINC
"RTN","LA7VIN7C",268,0)
 D LAH(SUB,4,OBX11) ;obsv status
"RTN","LA7VIN7C",269,0)
 Q
"RTN","LA7VMSG")
0^10^B45543754
"RTN","LA7VMSG",1,0)
LA7VMSG ;DALOI/JMC - LAB ORU (Observation Result) message builder ;08/12/13  15:12
"RTN","LA7VMSG",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**27,50,56,46,64,74,80**;Sep 27, 1994;Build 19
"RTN","LA7VMSG",3,0)
 ;
"RTN","LA7VMSG",4,0)
ORU ; Bleed the ORU (Observation Result) message queue
"RTN","LA7VMSG",5,0)
 ; Tasked by LA7SRR, LRCAPV2, LRU
"RTN","LA7VMSG",6,0)
 ;
"RTN","LA7VMSG",7,0)
 N LA7MTYP
"RTN","LA7VMSG",8,0)
 S LA7MTYP="ORU"
"RTN","LA7VMSG",9,0)
 D START^LA7VMSG1
"RTN","LA7VMSG",10,0)
 ;
"RTN","LA7VMSG",11,0)
 Q
"RTN","LA7VMSG",12,0)
 ;
"RTN","LA7VMSG",13,0)
ORR ; Bleed the ORR (Order Response) message queue
"RTN","LA7VMSG",14,0)
 ; Called by LRWLST12
"RTN","LA7VMSG",15,0)
 ;
"RTN","LA7VMSG",16,0)
 N LA7MTYP
"RTN","LA7VMSG",17,0)
 S LA7MTYP="ORR"
"RTN","LA7VMSG",18,0)
 ;D START^LA7VMSG1
"RTN","LA7VMSG",19,0)
 ;
"RTN","LA7VMSG",20,0)
 Q
"RTN","LA7VMSG",21,0)
 ;
"RTN","LA7VMSG",22,0)
 ;
"RTN","LA7VMSG",23,0)
SET(LRUID,SITE,RUID,SITEN,ORD,LRNLT,LRIDT,LRSS,LRDFN,ORDT,LA7VDB,LA7MTYP) ; adds entries to LA7V QUEUE file
"RTN","LA7VMSG",24,0)
 ; Called by LA7SRR, LRVER3, LRWLST12
"RTN","LA7VMSG",25,0)
 ; variable list
"RTN","LA7VMSG",26,0)
 ; LRUID - Host Unique ID from the local ACCESSION file (#68)
"RTN","LA7VMSG",27,0)
 ; SITE  - remote sites IEN in INSTITUTION file (#4)
"RTN","LA7VMSG",28,0)
 ; RUID  - Remote sites Unique ID from ACCESSION file (#68)
"RTN","LA7VMSG",29,0)
 ; SITEN - Primary site number of remote site ($$SITE^VASITE)
"RTN","LA7VMSG",30,0)
 ; ORD   - Free text ordered test name from WKLD CODE file (#64)
"RTN","LA7VMSG",31,0)
 ; LRNLT - National Laboratory test code from WKLD CODE file (#64)
"RTN","LA7VMSG",32,0)
 ; LRIDT - Inverse date/time (accession date/time)
"RTN","LA7VMSG",33,0)
 ; LRSS  - test subscript defined in LABORATORY TEST file (#60)
"RTN","LA7VMSG",34,0)
 ; LRDFN - IEN in LAB DATA file (#63)
"RTN","LA7VMSG",35,0)
 ; ORDT  - Order date
"RTN","LA7VMSG",36,0)
 ; LA7VDB - <opt><byref> Chemistry results or database section
"RTN","LA7VMSG",37,0)
 ;          for MI, SP, CY, EM subscripts
"RTN","LA7VMSG",38,0)
 ;           ex. glucose LA7VDB(2)=LR NODE
"RTN","LA7VMSG",39,0)
 ;                       LA7VDB(2,1)="C" (corrected results)
"RTN","LA7VMSG",40,0)
 ;   MI: LA7VDB(File #64 Field #63)=""
"RTN","LA7VMSG",41,0)
 ;   SP: LA7VDB("88515.0000")=""  CY: LA7VDB("88593.0000")=""
"RTN","LA7VMSG",42,0)
 ;   EM: LA7VDB("88597.0000")=""  AU: LA7VDB("88533.0000")=""
"RTN","LA7VMSG",43,0)
 ; LA7MTYP (Optional) - Message Type (ORU or ORR) defaults to ORU
"RTN","LA7VMSG",44,0)
 ;
"RTN","LA7VMSG",45,0)
 N FDA,LA76248,LA76249,LA7DT,LA7FACID,LA7ERR,LA7RSITE,LA7Y,LAHLSTAT,PORD,PORT,RSITE
"RTN","LA7VMSG",46,0)
 ;
"RTN","LA7VMSG",47,0)
 S LA7ERR=0
"RTN","LA7VMSG",48,0)
 I $G(LA7MTYP)="" S LA7MTYP="ORU"
"RTN","LA7VMSG",49,0)
 ; Currently not building ORR when accessioning - JMC/7/11/00
"RTN","LA7VMSG",50,0)
 I LA7MTYP="ORR" Q
"RTN","LA7VMSG",51,0)
 ;
"RTN","LA7VMSG",52,0)
 ; Retrieve facility id (VA=station number, DoD=DMIS code, other=local site assigned id)
"RTN","LA7VMSG",53,0)
 S LA7FACID=$$RETFACID^LA7VHLU2(SITEN,2,1),LA76248=0
"RTN","LA7VMSG",54,0)
 S LA7RSITE="LA7V COLLECTION "_LA7FACID
"RTN","LA7VMSG",55,0)
 S LA76248=$O(^LAHM(62.48,"B",LA7RSITE,0))
"RTN","LA7VMSG",56,0)
 ; No entry in 62.48 - *** Need to add error logging ****
"RTN","LA7VMSG",57,0)
 I 'LA76248 Q
"RTN","LA7VMSG",58,0)
 I '$P(^LAHM(62.48,LA76248,0),"^",3) Q  ; not active
"RTN","LA7VMSG",59,0)
 ;
"RTN","LA7VMSG",60,0)
 ;
"RTN","LA7VMSG",61,0)
 ; add check here to see if agency associated with site (SITE) is enabled for this subscript;CKA 6/11
"RTN","LA7VMSG",62,0)
 S LAHLSTAT=$$HLSTATUS("ORU",SITE,LRSS)
"RTN","LA7VMSG",63,0)
 I 'LAHLSTAT Q
"RTN","LA7VMSG",64,0)
 ;
"RTN","LA7VMSG",65,0)
 ; Create new outgoing entry in 62.49
"RTN","LA7VMSG",66,0)
 S LA76249=$$INIT6249^LA7VHLU
"RTN","LA7VMSG",67,0)
 I LA76249<1 D  Q
"RTN","LA7VMSG",68,0)
 . ; Log entry creation error
"RTN","LA7VMSG",69,0)
 ;
"RTN","LA7VMSG",70,0)
 ; Check/validate parameters before storing
"RTN","LA7VMSG",71,0)
 ; If error store but flag entry with error status.
"RTN","LA7VMSG",72,0)
 D CHKACC
"RTN","LA7VMSG",73,0)
 ;
"RTN","LA7VMSG",74,0)
 ; File data
"RTN","LA7VMSG",75,0)
 S FDA(1,62.49,LA76249_",",1)="O"
"RTN","LA7VMSG",76,0)
 S FDA(1,62.49,LA76249_",",.5)=LA76248
"RTN","LA7VMSG",77,0)
 S FDA(1,62.49,LA76249_",",2)=$S(LA7ERR:"E",1:"P")
"RTN","LA7VMSG",78,0)
 S FDA(1,62.49,LA76249_",",5)=LA7RSITE_"-O-"_RUID
"RTN","LA7VMSG",79,0)
 S FDA(1,62.49,LA76249_",",108)=LA7MTYP
"RTN","LA7VMSG",80,0)
 S FDA(1,62.49,LA76249_",",151)=LRUID
"RTN","LA7VMSG",81,0)
 S FDA(1,62.49,LA76249_",",152)=SITEN
"RTN","LA7VMSG",82,0)
 S FDA(1,62.49,LA76249_",",153)=RUID
"RTN","LA7VMSG",83,0)
 S FDA(1,62.49,LA76249_",",154)=ORD
"RTN","LA7VMSG",84,0)
 S FDA(1,62.49,LA76249_",",155)=LRNLT
"RTN","LA7VMSG",85,0)
 S FDA(1,62.49,LA76249_",",156)=LRIDT
"RTN","LA7VMSG",86,0)
 S FDA(1,62.49,LA76249_",",157)=LRSS
"RTN","LA7VMSG",87,0)
 S FDA(1,62.49,LA76249_",",158)=LRDFN
"RTN","LA7VMSG",88,0)
 S FDA(1,62.49,LA76249_",",159)=ORDT
"RTN","LA7VMSG",89,0)
 ;
"RTN","LA7VMSG",90,0)
 D FILE^DIE("","FDA(1)","LA7ERR(1)")
"RTN","LA7VMSG",91,0)
 D CLEAN^DILF
"RTN","LA7VMSG",92,0)
 ;
"RTN","LA7VMSG",93,0)
 ; Add test to order
"RTN","LA7VMSG",94,0)
 S LA7Y=0
"RTN","LA7VMSG",95,0)
 F  S LA7Y=$O(LA7VDB(LA7Y)) Q:'LA7Y  D
"RTN","LA7VMSG",96,0)
 . N FDAIEN
"RTN","LA7VMSG",97,0)
 . S FDA(2,62.49162,"+2,"_LA76249_",",.01)=LA7Y
"RTN","LA7VMSG",98,0)
 . I $G(LA7VDB(LA7Y,1))="C" S FDA(2,62.49162,"+2,"_LA76249_",",.02)="C"
"RTN","LA7VMSG",99,0)
 . S FDAIEN(1)=LA76249
"RTN","LA7VMSG",100,0)
 . D UPDATE^DIE("","FDA(2)","FDAIEN","LA7ERR(2)")
"RTN","LA7VMSG",101,0)
 . D CLEAN^DILF
"RTN","LA7VMSG",102,0)
 ;
"RTN","LA7VMSG",103,0)
 ; Check for date report completed.
"RTN","LA7VMSG",104,0)
 I '$$OK2SEND^LA7SRR D CREATE^LA7LOG(122)
"RTN","LA7VMSG",105,0)
 ;
"RTN","LA7VMSG",106,0)
 ; Release lock on entry.
"RTN","LA7VMSG",107,0)
 L -^LAHM(62.49,LA76249)
"RTN","LA7VMSG",108,0)
 Q
"RTN","LA7VMSG",109,0)
 ;
"RTN","LA7VMSG",110,0)
 ;
"RTN","LA7VMSG",111,0)
MIAP(LRAA,LRAD,LRAN,LR60,LRDFN,LRSS,LRIDT,LRODT) ; Makes MI/AP calls to send results to LA7V QUEUE
"RTN","LA7VMSG",112,0)
 ;
"RTN","LA7VMSG",113,0)
 ; Call with LRAA = accession area IEN
"RTN","LA7VMSG",114,0)
 ;           LRAD = accession date (FM format)
"RTN","LA7VMSG",115,0)
 ;           LRAN = accession number
"RTN","LA7VMSG",116,0)
 ;           LR60 = file #60 test IEN
"RTN","LA7VMSG",117,0)
 ;          LRDFN = IEN in LAB DATA file (#63)
"RTN","LA7VMSG",118,0)
 ;           LRSS = test subscript defined in LABORATORY TEST file (#60)
"RTN","LA7VMSG",119,0)
 ;          LRIDT = Inverse date/time (accession date/time)
"RTN","LA7VMSG",120,0)
 ;         LRORDT = Order date (FM format)
"RTN","LA7VMSG",121,0)
 ;
"RTN","LA7VMSG",122,0)
 ; Called by LRVR0, LRMIUT, LRVRAP4
"RTN","LA7VMSG",123,0)
 ;
"RTN","LA7VMSG",124,0)
 N LA764,LA76248,LA76249,LA7NLT,LA7NLTN,LA7ONQUE,LA7SS,LA7VDB,LA7Y,LRORU3
"RTN","LA7VMSG",125,0)
 ;
"RTN","LA7VMSG",126,0)
 S LA764=$$GET1^DIQ(60,LR60_",",64,"I")
"RTN","LA7VMSG",127,0)
 S LA7NLT=$$GET1^DIQ(64,LA764_",",1)
"RTN","LA7VMSG",128,0)
 I LA7NLT="" Q
"RTN","LA7VMSG",129,0)
 S LA7NLTN=$$GET1^DIQ(64,LA764_",",.01)
"RTN","LA7VMSG",130,0)
 ;
"RTN","LA7VMSG",131,0)
 S LA7VDB=$$GET1^DIQ(64,LA764_",",63,"I")
"RTN","LA7VMSG",132,0)
 I LA7VDB'="" S LA7Y(LA7VDB)=""
"RTN","LA7VMSG",133,0)
 ;
"RTN","LA7VMSG",134,0)
 S LRORU3=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
"RTN","LA7VMSG",135,0)
 ;
"RTN","LA7VMSG",136,0)
 ; Check if this report is already in the queue
"RTN","LA7VMSG",137,0)
 S LA7ONQUE=0
"RTN","LA7VMSG",138,0)
 S LA76248=0 F  S LA76248=$O(^LAHM(62.49,"AC","ORU","P",LA76248)) Q:'LA76248  D
"RTN","LA7VMSG",139,0)
 . S LA76249=0 F  S LA76249=$O(^LAHM(62.49,"AC","ORU","P",LA76248,LA76249)) Q:'LA76249  D
"RTN","LA7VMSG",140,0)
 . . I $$GET1^DIQ(62.49,LA76249_",",2,"I")'="P" Q
"RTN","LA7VMSG",141,0)
 . . ;
"RTN","LA7VMSG",142,0)
 . . ; Check the following fields. If they all match, then it's the same report and don't add to the queue again
"RTN","LA7VMSG",143,0)
 . . I $P(LRORU3,U,5)'=$$GET1^DIQ(62.49,LA76249_",",153,"I") Q  ; Check REMOTE UID
"RTN","LA7VMSG",144,0)
 . . I $P(LRORU3,U,3)'=$$GET1^DIQ(62.49,LA76249_",",152,"I") Q  ; Check COLLECTING SITE
"RTN","LA7VMSG",145,0)
 . . I LA7NLT'=$$GET1^DIQ(62.49,LA76249_",",155,"I") Q  ; Check NLT
"RTN","LA7VMSG",146,0)
 . . I LRIDT'=$$GET1^DIQ(62.49,LA76249_",",156,"I") Q  ; Check LRIDT
"RTN","LA7VMSG",147,0)
 . . I LRSS'=$$GET1^DIQ(62.49,LA76249_",",157,"I") Q  ; Check LRSS
"RTN","LA7VMSG",148,0)
 . . I LRDFN'=$$GET1^DIQ(62.49,LA76249_",",158,"I") Q  ; Check LRDFN
"RTN","LA7VMSG",149,0)
 . . ;
"RTN","LA7VMSG",150,0)
 . . S LA7ONQUE=1 ; All fields match - report already in the queue
"RTN","LA7VMSG",151,0)
 ;
"RTN","LA7VMSG",152,0)
 I LA7ONQUE D  Q  ; Report already in queue, don't add again
"RTN","LA7VMSG",153,0)
 . W !,$$CJ^XLFSTR("Report already in LEDI queue - no need to add again",IOM)
"RTN","LA7VMSG",154,0)
 ;
"RTN","LA7VMSG",155,0)
 ;
"RTN","LA7VMSG",156,0)
 D SET^LA7VMSG($P(LRORU3,U,4),$P(LRORU3,U,2),$P(LRORU3,U,5),$P(LRORU3,U,3),LA7NLTN,LA7NLT,LRIDT,LRSS,LRDFN,LRODT,.LA7Y,"ORU")
"RTN","LA7VMSG",157,0)
 ;
"RTN","LA7VMSG",158,0)
 Q
"RTN","LA7VMSG",159,0)
 ;
"RTN","LA7VMSG",160,0)
 ;
"RTN","LA7VMSG",161,0)
CHKACC ; Check/validate parameters passed in before storing in file #62.49
"RTN","LA7VMSG",162,0)
 ;
"RTN","LA7VMSG",163,0)
 N I,LA763,LA768,LA7AA,LA7AD,LA7AN
"RTN","LA7VMSG",164,0)
 ;
"RTN","LA7VMSG",165,0)
 I $G(LRUID)="",$G(RUID)="" Q
"RTN","LA7VMSG",166,0)
 I LRUID'="",'$D(^LRO(68,"C",LRUID)) D
"RTN","LA7VMSG",167,0)
 . S LRUID=$G(RUID)
"RTN","LA7VMSG",168,0)
 . I LRUID'="",'$D(^LRO(68,"C",LRUID)) S LRUID=""
"RTN","LA7VMSG",169,0)
 I LRUID="" Q
"RTN","LA7VMSG",170,0)
 ;
"RTN","LA7VMSG",171,0)
 S I=$Q(^LRO(68,"C",LRUID)),(LA7AA,LA7AD,LA7AN)=0
"RTN","LA7VMSG",172,0)
 I I'="",$QS(I,3)=LRUID S LA7AA=$QS(I,4),LA7AD=$QS(I,5),LA7AN=$QS(I,6)
"RTN","LA7VMSG",173,0)
 F I=0,.2,.3,3 S LA768(I)=$G(^LRO(68,LA7AA,1,LA7AD,1,LA7AN,I))
"RTN","LA7VMSG",174,0)
 ;
"RTN","LA7VMSG",175,0)
 F I=0,"ORU" S LA763(I)=$G(^LR(LRDFN,LRSS,LRIDT,I))
"RTN","LA7VMSG",176,0)
 ;
"RTN","LA7VMSG",177,0)
 ; Mismatch on subscript with file #68
"RTN","LA7VMSG",178,0)
 I LRSS'=$P(^LRO(68,LA7AA,0),"^",2) S LA7ERR=40 D CREATE^LA7LOG(LA7ERR)
"RTN","LA7VMSG",179,0)
 ;
"RTN","LA7VMSG",180,0)
 ; Mismatch on LRDFN with file #68
"RTN","LA7VMSG",181,0)
 I LRDFN'=$P(LA768(0),"^") S LA7ERR=41 D CREATE^LA7LOG(LA7ERR)
"RTN","LA7VMSG",182,0)
 ;
"RTN","LA7VMSG",183,0)
 ; Mismatch on specimen inverse d/t with file #68
"RTN","LA7VMSG",184,0)
 I LRIDT'=$P(LA768(3),"^",5) S LA7ERR=42 D CREATE^LA7LOG(LA7ERR)
"RTN","LA7VMSG",185,0)
 ;
"RTN","LA7VMSG",186,0)
 ; Mismatch on remote UID with file #68
"RTN","LA7VMSG",187,0)
 I $G(RUID)'="",RUID'=$P(LA768(.3),"^",5) S LA7ERR=43 D CREATE^LA7LOG(LA7ERR)
"RTN","LA7VMSG",188,0)
 ;
"RTN","LA7VMSG",189,0)
 ; Mismatch on remote UID with file #63
"RTN","LA7VMSG",190,0)
 I $G(RUID)'="",$P(LA763("ORU"),"^",5)'="",RUID'=$P(LA763("ORU"),"^",5) S LA7ERR=44 D CREATE^LA7LOG(LA7ERR)
"RTN","LA7VMSG",191,0)
 ;
"RTN","LA7VMSG",192,0)
 ; Mismatch on UID between file #63 and file #68
"RTN","LA7VMSG",193,0)
 I $P(LA768(.3),"^")'="",$P(LA763("ORU"),"^")'="",$P(LA768(.3),"^")'=$P(LA763("ORU"),"^") S LA7ERR=45 D CREATE^LA7LOG(LA7ERR)
"RTN","LA7VMSG",194,0)
 ;
"RTN","LA7VMSG",195,0)
 Q
"RTN","LA7VMSG",196,0)
 ;
"RTN","LA7VMSG",197,0)
 ;
"RTN","LA7VMSG",198,0)
ACK ; ACKnowledgment message processor
"RTN","LA7VMSG",199,0)
 ;
"RTN","LA7VMSG",200,0)
 G ACK^LA7VHL
"RTN","LA7VMSG",201,0)
 Q
"RTN","LA7VMSG",202,0)
HLSTATUS(LA7MTYP,SITE,LRSS) ;
"RTN","LA7VMSG",203,0)
 ;
"RTN","LA7VMSG",204,0)
 ; Check if agency associated with site has LEDI HL7 messaging enabled for this Subscript.
"RTN","LA7VMSG",205,0)
 ;
"RTN","LA7VMSG",206,0)
 ; Call with:
"RTN","LA7VMSG",207,0)
 ;     LA7MTYP = The HL7 message type. Either: "ORU" or "ORM"
"RTN","LA7VMSG",208,0)
 ;        SITE = Site's IEN in INSTITUTION file (#4)
"RTN","LA7VMSG",209,0)
 ;        LRSS = Subscript
"RTN","LA7VMSG",210,0)
 ;
"RTN","LA7VMSG",211,0)
 ; Returns    0: LEDI HL7 messaging is disabled for this SITE and Subscript.
"RTN","LA7VMSG",212,0)
 ;            1: LEDI HL7 messaging is enabled for this SITE and Subscript.
"RTN","LA7VMSG",213,0)
 ; -- if LSRP cutover is installed and rollback restore is not installed, return 1 (enabled)
"RTN","LA7VMSG",214,0)
 I $$PATCH^XPDUTL("LA*5.2*75"),'$$PATCH^XPDUTL("LA*5.2*78") Q 1
"RTN","LA7VMSG",215,0)
 ;
"RTN","LA7VMSG",216,0)
 N LA7PAR
"RTN","LA7VMSG",217,0)
 ;
"RTN","LA7VMSG",218,0)
 S LA7PAR=2
"RTN","LA7VMSG",219,0)
 I LA7MTYP="ORU" S LA7PAR=$$GET^XPAR("ALL","LA LEDI ORU HL7 STATUS",$$WHAT^XUAF4(SITE,"AGENCY"),"Q")
"RTN","LA7VMSG",220,0)
 I LA7MTYP="ORM" S LA7PAR=$$GET^XPAR("ALL","LA LEDI ORM HL7 STATUS",$$WHAT^XUAF4(SITE,"AGENCY"),"Q")
"RTN","LA7VMSG",221,0)
 ;
"RTN","LA7VMSG",222,0)
 I LA7PAR=0 Q 0
"RTN","LA7VMSG",223,0)
 I LA7PAR=2,LRSS'="CH" Q 0
"RTN","LA7VMSG",224,0)
 I LA7PAR=3,LRSS'="MI" Q 0
"RTN","LA7VMSG",225,0)
 I LA7PAR=4,LRSS'["SPCYEM" Q 0
"RTN","LA7VMSG",226,0)
 I LA7PAR=5,"CHMI"'[LRSS Q 0
"RTN","LA7VMSG",227,0)
 I LA7PAR=6,"CHSPCYEM"'[LRSS Q 0
"RTN","LA7VMSG",228,0)
 I LA7PAR=7,"MISPCYEM"'[LRSS Q 0
"RTN","LA7VMSG",229,0)
 ;
"RTN","LA7VMSG",230,0)
 Q 1
"RTN","LA7VORU2")
0^8^B30167256
"RTN","LA7VORU2",1,0)
LA7VORU2 ;DALOI/JMC - LAB ORU (Result) message builder cont'd ;06/03/13  20:11
"RTN","LA7VORU2",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,68,74,80**;Sep 27, 1994;Build 19
"RTN","LA7VORU2",3,0)
 ;
"RTN","LA7VORU2",4,0)
AP ; Observation/Result segment for Lab AP Results
"RTN","LA7VORU2",5,0)
 ;
"RTN","LA7VORU2",6,0)
 N LA7DATA,LA7IDT,LRSB,LRSS
"RTN","LA7VORU2",7,0)
 ;
"RTN","LA7VORU2",8,0)
 S LRDFN=LA("LRDFN"),LRSS=LA("SUB"),(LA7IDT,LRIDT)=LA("LRIDT")
"RTN","LA7VORU2",9,0)
 ;
"RTN","LA7VORU2",10,0)
 I $G(LA("NLT"))'="" S LA7NLT=LA("NLT")
"RTN","LA7VORU2",11,0)
 E  S (LA7NLT,LA("NLT"))=$P($$DEFCODE^LA7VHLU5(LRSS,.012,"",""),"!")
"RTN","LA7VORU2",12,0)
 ;
"RTN","LA7VORU2",13,0)
 D OBR^LA7VORU
"RTN","LA7VORU2",14,0)
 I LA7NVAF=1 D PLC^LA7VORUA
"RTN","LA7VORU2",15,0)
 D NTE^LA7VORU
"RTN","LA7VORU2",16,0)
 D PMR
"RTN","LA7VORU2",17,0)
 ;
"RTN","LA7VORU2",18,0)
 I $D(^LR(LRDFN,LRSS,LRIDT,1.2)) D PSR
"RTN","LA7VORU2",19,0)
 Q
"RTN","LA7VORU2",20,0)
 ;
"RTN","LA7VORU2",21,0)
 ;
"RTN","LA7VORU2",22,0)
APORM ; Entry point when building OBX segments for ORM message
"RTN","LA7VORU2",23,0)
 ;
"RTN","LA7VORU2",24,0)
 D PMR
"RTN","LA7VORU2",25,0)
 ;
"RTN","LA7VORU2",26,0)
 ; Process supplementary reports
"RTN","LA7VORU2",27,0)
 N LA7SR,LA7SS
"RTN","LA7VORU2",28,0)
 S LA7OBXSN=0,LRSB=1.2,LA7SR=0
"RTN","LA7VORU2",29,0)
 F  S LA7SR=$O(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR)) Q:'LA7SR  D
"RTN","LA7VORU2",30,0)
 . N LA7IDT
"RTN","LA7VORU2",31,0)
 . ; If don't release this report then skip.
"RTN","LA7VORU2",32,0)
 . I $P($G(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR,0)),"^",2)'=1 Q
"RTN","LA7VORU2",33,0)
 . S LA7IDT=LRIDT_","_LA7SR D OBX^LA7VORU1
"RTN","LA7VORU2",34,0)
 ;
"RTN","LA7VORU2",35,0)
 Q
"RTN","LA7VORU2",36,0)
 ;
"RTN","LA7VORU2",37,0)
 ;
"RTN","LA7VORU2",38,0)
PMR ; Process main report
"RTN","LA7VORU2",39,0)
 N LA7ORG,LA7SS
"RTN","LA7VORU2",40,0)
 S LA7OBXSN=0
"RTN","LA7VORU2",41,0)
 ;
"RTN","LA7VORU2",42,0)
 D SPEC
"RTN","LA7VORU2",43,0)
 I LA7NVAF'=1 F LRSB=.013,.014,.015,.016,1,1.1,1.3,1.4 D OBX^LA7VORU1
"RTN","LA7VORU2",44,0)
 I LA7NVAF=1 D DOD
"RTN","LA7VORU2",45,0)
 ;
"RTN","LA7VORU2",46,0)
 ; Process organ/tissue subfile
"RTN","LA7VORU2",47,0)
 S LA7ORG=0
"RTN","LA7VORU2",48,0)
 F  S LA7ORG=$O(^LR(LRDFN,LRSS,LRIDT,2,LA7ORG)) Q:'LA7ORG  D
"RTN","LA7VORU2",49,0)
 . N LA7IDT
"RTN","LA7VORU2",50,0)
 . S LRSB=10,LA7IDT=LRIDT_","_LA7ORG D OBX^LA7VORU1
"RTN","LA7VORU2",51,0)
 . I LRSS="SP" S LRSB="10,2",LA7IDT=LRIDT_","_LA7ORG D OBX^LA7VORU1
"RTN","LA7VORU2",52,0)
 . ; Special studies
"RTN","LA7VORU2",53,0)
 . S LA7SS=0,LRSB="10,5"
"RTN","LA7VORU2",54,0)
 . F  S LA7SS=$O(^LR(LRDFN,LRSS,LRIDT,2,LA7ORG,5,LA7SS)) Q:'LA7SS  D
"RTN","LA7VORU2",55,0)
 . . S LA7IDT=LRIDT_","_LA7ORG_","_LA7SS D OBX^LA7VORU1
"RTN","LA7VORU2",56,0)
 ;
"RTN","LA7VORU2",57,0)
 Q
"RTN","LA7VORU2",58,0)
 ;
"RTN","LA7VORU2",59,0)
 ;
"RTN","LA7VORU2",60,0)
PSR ; Process supplementary reports
"RTN","LA7VORU2",61,0)
 N LA7SR,LA7SS
"RTN","LA7VORU2",62,0)
 I $G(LA("NLT"))'="" S LA7NLT=LA("NLT")
"RTN","LA7VORU2",63,0)
 E  S (LA7NLT,LA("NLT"))=$P($$DEFCODE^LA7VHLU5(LRSS,1.2,"",""),"!")
"RTN","LA7VORU2",64,0)
 S LA7OBXSN=0,LRSB=1.2,LA7SR=0
"RTN","LA7VORU2",65,0)
 F  S LA7SR=$O(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR)) Q:'LA7SR  D
"RTN","LA7VORU2",66,0)
 . N LA7IDT
"RTN","LA7VORU2",67,0)
 . ; If don't release this report then skip.
"RTN","LA7VORU2",68,0)
 . I $P($G(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR,0)),"^",2)'=1 Q
"RTN","LA7VORU2",69,0)
 . D OBR^LA7VORU
"RTN","LA7VORU2",70,0)
 . I LA7NVAF=1 D PLC^LA7VORUA,DODSR Q
"RTN","LA7VORU2",71,0)
 . S LA7IDT=LRIDT_","_LA7SR D OBX^LA7VORU1
"RTN","LA7VORU2",72,0)
 Q
"RTN","LA7VORU2",73,0)
 ;
"RTN","LA7VORU2",74,0)
 ;
"RTN","LA7VORU2",75,0)
SPEC ; Send specimen multiple as series of OBX segments. One OBX segment for each specimen
"RTN","LA7VORU2",76,0)
 ; If DoD then send two OBX for each specimen, 1st with free text specimen description, 2nd  with SNOMED CT,
"RTN","LA7VORU2",77,0)
 ;
"RTN","LA7VORU2",78,0)
 N LA7DA,LA7IDT,LRSB
"RTN","LA7VORU2",79,0)
 ;
"RTN","LA7VORU2",80,0)
 S LA7DA=0,LRSB=.012
"RTN","LA7VORU2",81,0)
 F  S LA7DA=$O(^LR(LRDFN,LRSS,LRIDT,.1,LA7DA)) Q:'LA7DA  D
"RTN","LA7VORU2",82,0)
 . S LA7IDT=LRIDT_","_LA7DA S:LA7NVAF=1 LRSB=".012,.01" D OBX^LA7VORU1
"RTN","LA7VORU2",83,0)
 . I LA7NVAF=1 S LRSB=".012,.06" D OBX^LA7VORU1
"RTN","LA7VORU2",84,0)
 Q
"RTN","LA7VORU2",85,0)
 ;
"RTN","LA7VORU2",86,0)
 ;
"RTN","LA7VORU2",87,0)
DOD ; Build OBX segment's to special DoD specifications.
"RTN","LA7VORU2",88,0)
 ; Send word-processing fields as series of ST data type OBX's for DoD.
"RTN","LA7VORU2",89,0)
 ; DoD cannot handle formatted text (FT) data type.
"RTN","LA7VORU2",90,0)
 N LA7DA
"RTN","LA7VORU2",91,0)
 ;
"RTN","LA7VORU2",92,0)
 F LRSB=.013,.014,.015,.016,1,1.1,1.3,1.4 D
"RTN","LA7VORU2",93,0)
 . N LA7IDT,LA7SB
"RTN","LA7VORU2",94,0)
 . S LA7DA=0,LA7SB=$S(LRSB=.013:.2,LRSB=.014:.3,LRSB=.015:.4,LRSB=.016:.5,1:LRSB)
"RTN","LA7VORU2",95,0)
 . F  S LA7DA=$O(^LR(LRDFN,LRSS,LRIDT,LA7SB,LA7DA)) Q:'LA7DA  D
"RTN","LA7VORU2",96,0)
 . . S LA7IDT=LRIDT_","_LA7DA  D OBX^LA7VORU1
"RTN","LA7VORU2",97,0)
 ;
"RTN","LA7VORU2",98,0)
 Q
"RTN","LA7VORU2",99,0)
 ;
"RTN","LA7VORU2",100,0)
 ;
"RTN","LA7VORU2",101,0)
DODSR ; Build OBX segment's to special DoD specifications.
"RTN","LA7VORU2",102,0)
 ; Send Supplementary reports fields as series of ST data type OBX's for DoD.
"RTN","LA7VORU2",103,0)
 ; DoD cannot handle formatted text (FT) data type.
"RTN","LA7VORU2",104,0)
 ;
"RTN","LA7VORU2",105,0)
 N LA7IDT,LA7DA
"RTN","LA7VORU2",106,0)
 S LA7DA=0
"RTN","LA7VORU2",107,0)
 F  S LA7DA=$O(^LR(LRDFN,LRSS,LRIDT,1.2,LA7SR,1,LA7DA)) Q:'LA7DA  D
"RTN","LA7VORU2",108,0)
 . S LA7IDT=LRIDT_","_LA7SR_","_LA7DA  D OBX^LA7VORU1
"RTN","LA7VORU2",109,0)
 ;
"RTN","LA7VORU2",110,0)
 Q
"RTN","LA7VORU2",111,0)
 ;
"RTN","LA7VORU2",112,0)
 ;
"RTN","LA7VORU2",113,0)
RPTNTE ; Send report comments
"RTN","LA7VORU2",114,0)
 ; Called from LA7VORU1 to send MI NTE segments
"RTN","LA7VORU2",115,0)
 ;
"RTN","LA7VORU2",116,0)
 N LA7CMTYP,LA7FMT,LA7J,LA7ND,LA7SOC,LA7TXT,LA7X
"RTN","LA7VORU2",117,0)
 ;
"RTN","LA7VORU2",118,0)
 ; Source of comment - handle special codes for other systems, ie DOD-CHCS
"RTN","LA7VORU2",119,0)
 S LA7SOC=$S($G(LA7NVAF)=1:"RC",1:"L"),LA7ND=0
"RTN","LA7VORU2",120,0)
 ;
"RTN","LA7VORU2",121,0)
 S LA7FMT=0,LA7CMTYP=""
"RTN","LA7VORU2",122,0)
 ; If HDR interface then send as repetition text.
"RTN","LA7VORU2",123,0)
 I $G(LA7INTYP)=30 S LA7FMT=2
"RTN","LA7VORU2",124,0)
 ;
"RTN","LA7VORU2",125,0)
 D
"RTN","LA7VORU2",126,0)
 . ; Bacterial preliminary/report/tests remark
"RTN","LA7VORU2",127,0)
 . I LRSB=11 S LA7ND=4,LA7CMTYP="VA-LRMI010" Q
"RTN","LA7VORU2",128,0)
 . I LRSB=1 S LA7ND=19,LA7CMTYP="VA-LRMI011" Q
"RTN","LA7VORU2",129,0)
 . I LRSB=1.5 S LA7ND=26,LA7CMTYP="VA-LRMI012" Q
"RTN","LA7VORU2",130,0)
 . I LRSB=11.7 S LA7ND=25,LA7CMTYP="VA-LRMI013" Q
"RTN","LA7VORU2",131,0)
 . ; Parasite preliminary/report/tests remark
"RTN","LA7VORU2",132,0)
 . I LRSB=14 S LA7ND=7,LA7CMTYP="VA-LRMI020" Q
"RTN","LA7VORU2",133,0)
 . I LRSB=16.5 S LA7ND=21,LA7CMTYP="VA-LRMI021" Q
"RTN","LA7VORU2",134,0)
 . I LRSB=16.4 S LA7ND=27,LA7CMTYP="VA-LRMI022" Q
"RTN","LA7VORU2",135,0)
 . I LRSB=15.51 S LA7ND=24,LA7CMTYP="VA-LRMI023" Q
"RTN","LA7VORU2",136,0)
 . I LRSB="16,1" S LA7ND=6,LA7CMTYP="VA-LRMI53" Q
"RTN","LA7VORU2",137,0)
 . ; Fungal preliminary/report/tests remark
"RTN","LA7VORU2",138,0)
 . I LRSB=18 S LA7ND=10,LA7CMTYP="VA-LRMI030" Q
"RTN","LA7VORU2",139,0)
 . I LRSB=20.5 S LA7ND=22,LA7CMTYP="VA-LRMI031" Q
"RTN","LA7VORU2",140,0)
 . I LRSB=20.4 S LA7ND=28,LA7CMTYP="VA-LRMI032" Q
"RTN","LA7VORU2",141,0)
 . I LRSB=19.6 S LA7ND=15,LA7CMTYP="VA-LRMI033" Q
"RTN","LA7VORU2",142,0)
 . ; Mycobacteria preliminary/report/tests remark
"RTN","LA7VORU2",143,0)
 . I LRSB=22 S LA7ND=13,LA7CMTYP="VA-LRMI040" Q
"RTN","LA7VORU2",144,0)
 . I LRSB=26.5 S LA7ND=23,LA7CMTYP="VA-LRMI041" Q
"RTN","LA7VORU2",145,0)
 . I LRSB=26.4 S LA7ND=29,LA7CMTYP="VA-LRMI042" Q
"RTN","LA7VORU2",146,0)
 . ; Viral preliminary/report/tests remark
"RTN","LA7VORU2",147,0)
 . I LRSB=33 S LA7ND=18,LA7CMTYP="VA-LRMI050" Q
"RTN","LA7VORU2",148,0)
 . I LRSB=36.5 S LA7ND=20,LA7CMTYP="VA-LRMI051" Q
"RTN","LA7VORU2",149,0)
 . I LRSB=36.4 S LA7ND=30,LA7CMTYP="VA-LRMI052" Q
"RTN","LA7VORU2",150,0)
 ;
"RTN","LA7VORU2",151,0)
 I LA7ND'>0 Q
"RTN","LA7VORU2",152,0)
 ;
"RTN","LA7VORU2",153,0)
 S LA7J=0
"RTN","LA7VORU2",154,0)
 F  S LA7J=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7J)) Q:'LA7J  D
"RTN","LA7VORU2",155,0)
 . S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7J,0))
"RTN","LA7VORU2",156,0)
 . I LA7FMT S LA7TXT(LA7J)=LA7X
"RTN","LA7VORU2",157,0)
 . E  S LA7TXT=LA7X D NTE^LA7VORU1
"RTN","LA7VORU2",158,0)
 ;
"RTN","LA7VORU2",159,0)
 ; If formatted or repetition format then build comments to a NTE segment.
"RTN","LA7VORU2",160,0)
 I LA7FMT,$D(LA7TXT) D NTE^LA7VORU1
"RTN","LA7VORU2",161,0)
 ;
"RTN","LA7VORU2",162,0)
 Q
"RTN","LA7VORU2",163,0)
 ;
"RTN","LA7VORU2",164,0)
 ;
"RTN","LA7VORU2",165,0)
RPT ; Report specimen results as OBX segments to DoD - taken from various XXX RPT REMARK fields (13, 17, 21, 27, 37)
"RTN","LA7VORU2",166,0)
 ; Called from LA7VORU1.
"RTN","LA7VORU2",167,0)
 N LA7DA,LA7IDT,LA7ND
"RTN","LA7VORU2",168,0)
 ;
"RTN","LA7VORU2",169,0)
 S LA7ND=$S(LRSB=11:4,LRSB=14:7,LRSB=18:10,LRSB=22:13,LRSB=33:18,1:0)
"RTN","LA7VORU2",170,0)
 I 'LA7ND Q
"RTN","LA7VORU2",171,0)
 S LA7DA=0
"RTN","LA7VORU2",172,0)
 F  S LA7DA=$O(^LR(LRDFN,LRSS,LRIDT,LA7ND,LA7DA)) Q:'LA7DA  S LA7IDT=LRIDT_","_LA7DA  D OBX^LA7VORU1
"RTN","LA7VORU2",173,0)
 Q
"RTN","LA7VORUB")
0^6^B55537548
"RTN","LA7VORUB",1,0)
LA7VORUB ;DALOI/JMC - Builder of HL7 Lab Results cont'd ;08/16/13  17:02
"RTN","LA7VORUB",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**68,74,80**;Sep 27, 1994;Build 19
"RTN","LA7VORUB",3,0)
 ;
"RTN","LA7VORUB",4,0)
 Q
"RTN","LA7VORUB",5,0)
 ;
"RTN","LA7VORUB",6,0)
 ;
"RTN","LA7VORUB",7,0)
OBR ;Observation Request segment for Lab Order
"RTN","LA7VORUB",8,0)
 ;
"RTN","LA7VORUB",9,0)
 N LA761,LA762,LA7DATA,LA7PLOBR,LA7PRI,LA7RSDT,LA7SAC,LA7SNM,LA7X,LA7Y,LADFINST,OBR,X,Y
"RTN","LA7VORUB",10,0)
 ;
"RTN","LA7VORUB",11,0)
 ; Retrieve placer's OBR information stored in #69.6
"RTN","LA7VORUB",12,0)
 D RETOBR^LA7VHLU(LA("SITE"),LA("RUID"),LA("NLT"),.LA7PLOBR)
"RTN","LA7VORUB",13,0)
 ;
"RTN","LA7VORUB",14,0)
 ; Retrieve "ORUT" node for this NLT from file #63
"RTN","LA7VORUB",15,0)
 S LA7NLT(63)=""
"RTN","LA7VORUB",16,0)
 I LA7NLT'="" D
"RTN","LA7VORUB",17,0)
 . S LA7X=$O(^LR(LRDFN,LRSS,LRIDT,"ORUT","B",LA7NLT,0))
"RTN","LA7VORUB",18,0)
 . I LA7X>0 S LA7NLT(63)=$G(^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7X,0))
"RTN","LA7VORUB",19,0)
 ;
"RTN","LA7VORUB",20,0)
 ; Default institution from Kernel
"RTN","LA7VORUB",21,0)
 S LADFINST=+$$KSP^XUPARAM("INST")
"RTN","LA7VORUB",22,0)
 ;
"RTN","LA7VORUB",23,0)
 ; Retreive accession info used below  - accession area^accession date^accession number
"RTN","LA7VORUB",24,0)
 S LA7Y=$$CHECKUID^LRWU4(LA("HUID"))
"RTN","LA7VORUB",25,0)
 I LA7Y S LA("HUID",68)=$P(LA7Y,"^",2,4)
"RTN","LA7VORUB",26,0)
 E  S LA("HUID",68)=""
"RTN","LA7VORUB",27,0)
 ;
"RTN","LA7VORUB",28,0)
 ; Initialize OBR segment
"RTN","LA7VORUB",29,0)
 S OBR(0)="OBR"
"RTN","LA7VORUB",30,0)
 S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN)
"RTN","LA7VORUB",31,0)
 ;
"RTN","LA7VORUB",32,0)
 ; Remote UID
"RTN","LA7VORUB",33,0)
 K LA7X
"RTN","LA7VORUB",34,0)
 M LA7X=LA("RUID")
"RTN","LA7VORUB",35,0)
 S OBR(2)=$$OBR2^LA7VOBR(.LA7X,LA7FS,LA7ECH)
"RTN","LA7VORUB",36,0)
 ;
"RTN","LA7VORUB",37,0)
 ; Host UID
"RTN","LA7VORUB",38,0)
 K LA7X
"RTN","LA7VORUB",39,0)
 M LA7X=LA("HUID")
"RTN","LA7VORUB",40,0)
 S OBR(3)=$$OBR3^LA7VOBR(.LA7X,LA7FS,LA7ECH)
"RTN","LA7VORUB",41,0)
 ;
"RTN","LA7VORUB",42,0)
 ; Universal service ID, build from info stored in #69.6
"RTN","LA7VORUB",43,0)
 K LA7X
"RTN","LA7VORUB",44,0)
 S LA7X=""
"RTN","LA7VORUB",45,0)
 I $G(LA7PLOBR("OBR-4"))'="" S OBR(4)=$$CNVFLD^LA7VHLU3(LA7PLOBR("OBR-4"),LA7PLOBR("ECH"),LA7ECH)
"RTN","LA7VORUB",46,0)
 E  S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,$P(LA7NLT(63),"^",13),LA7X,LA7FS,LA7ECH)
"RTN","LA7VORUB",47,0)
 ;
"RTN","LA7VORUB",48,0)
 ; Collection D/T - only send date if d/t is inexact (2nd piece)
"RTN","LA7VORUB",49,0)
 K LA7X
"RTN","LA7VORUB",50,0)
 S LA7X=$P(LA763(0),"^") S:$P(LA763(0),"^",2) LA7X=$P(LA7X,".")
"RTN","LA7VORUB",51,0)
 S OBR(7)=$$OBR7^LA7VOBR(LA7X)
"RTN","LA7VORUB",52,0)
 ;
"RTN","LA7VORUB",53,0)
 ; Specimen action code from order type in file #63 "ORUT" node
"RTN","LA7VORUB",54,0)
 ; If no OBR from PENDING ORDER file (#69.6) then assume added test.
"RTN","LA7VORUB",55,0)
 S LA7SAC=""
"RTN","LA7VORUB",56,0)
 I $P(LA7NLT(63),"^",5) S LA7SAC=$$GET1^DIQ(64.061,$P(LA7NLT(63),"^",5)_",",2)
"RTN","LA7VORUB",57,0)
 I $G(LA7INTYP)=10 D
"RTN","LA7VORUB",58,0)
 . I LA7SAC="",$G(LA7PLOBR("OBR-4"))="" S LA7SAC="A"
"RTN","LA7VORUB",59,0)
 . I LA7NVAF=1,LA7SAC'?1(1"G",1"R",1"A") S LA7SAC=""
"RTN","LA7VORUB",60,0)
 I LA7SAC'="" S OBR(11)=$$OBR11^LA7VOBR(LA7SAC)
"RTN","LA7VORUB",61,0)
 ;
"RTN","LA7VORUB",62,0)
 ; Infection Warning
"RTN","LA7VORUB",63,0)
 S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
"RTN","LA7VORUB",64,0)
 ;
"RTN","LA7VORUB",65,0)
 ; Lab Arrival Time
"RTN","LA7VORUB",66,0)
 ; "CH" subscript does not store lab arrival time - attempt to retrieve from file #68.
"RTN","LA7VORUB",67,0)
 ; Other subscripts do store lab arrival time (date/time received).
"RTN","LA7VORUB",68,0)
 I LA("SUB")?1(1"MI",1"SP",1"CY",1"EM") S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^",10))
"RTN","LA7VORUB",69,0)
 I LA("SUB")="CH",LA("HUID",68) D
"RTN","LA7VORUB",70,0)
 . S LA7X=$G(^LRO(68,$P(LA("HUID",68),"^"),1,$P(LA("HUID",68),"^",2),1,$P(LA("HUID",68),"^",3),3))
"RTN","LA7VORUB",71,0)
 . I $P(LA7X,"^",3) S OBR(14)=$$OBR14^LA7VOBR($P(LA7X,"^",3))
"RTN","LA7VORUB",72,0)
 ;
"RTN","LA7VORUB",73,0)
 ; Specimen source
"RTN","LA7VORUB",74,0)
 S (LA761,LA762,LA7Y)="",LA7SNM=1
"RTN","LA7VORUB",75,0)
 I LA("SUB")?1(1"CH",1"MI") D
"RTN","LA7VORUB",76,0)
 . S LA761=$P(LA763(0),U,5)
"RTN","LA7VORUB",77,0)
 . I LA761="" D CREATE^LA7LOG(27)
"RTN","LA7VORUB",78,0)
 . I LA("SUB")="MI" S LA762=$P(LA763(0),U,11)
"RTN","LA7VORUB",79,0)
 ;
"RTN","LA7VORUB",80,0)
 ; If multiple different specimens then OBR-15 always indicates XXX for AP subscripts - specimen is communicated in OBX segments.
"RTN","LA7VORUB",81,0)
 I LA("SUB")?1(1"SP",1"CY",1"EM") D
"RTN","LA7VORUB",82,0)
 . S LA7I=0
"RTN","LA7VORUB",83,0)
 . F  S LA7I=$O(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),.1,LA7I)) Q:'LA7I   D  Q:'LA7I
"RTN","LA7VORUB",84,0)
 . . S LA7X=$P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),.1,LA7I,0),"^",6)
"RTN","LA7VORUB",85,0)
 . . I 'LA761,LA7X S LA761=LA7X
"RTN","LA7VORUB",86,0)
 . . I LA761,LA7X,(LA761'=LA7X) S (LA761,LA7I)=0
"RTN","LA7VORUB",87,0)
 . S LA762=$P(LA7NLT(63),"^",9)
"RTN","LA7VORUB",88,0)
 ;
"RTN","LA7VORUB",89,0)
 I LA7NVAF=1 S LA7SNM=2
"RTN","LA7VORUB",90,0)
 ;
"RTN","LA7VORUB",91,0)
 S OBR(15)=$$OBR15^LA7VOBR(LA761,LA762,LA7Y,LA7FS,LA7ECH,"",LA7SNM)
"RTN","LA7VORUB",92,0)
 ;
"RTN","LA7VORUB",93,0)
 ; If LEDI reflex test and not DoD/CHCS interface
"RTN","LA7VORUB",94,0)
 ;    then check original ordered test for placer field 1/2 (OBR-18/19) and ordering provider (OBR-17)
"RTN","LA7VORUB",95,0)
 I $G(LA7INTYP)=10,LA7SAC="G",LA7NVAF'=1,$G(LA7PLOBR("OBR-18"))="",$G(LA7PLOBR("OBR-19"))="" D
"RTN","LA7VORUB",96,0)
 . N LA7REFLEXNLT,LA7REFLEXPARENT
"RTN","LA7VORUB",97,0)
 . S LA7REFLEXNLT=$P(LA7NLT(63),"^",15)
"RTN","LA7VORUB",98,0)
 . I LA7REFLEXNLT="" Q
"RTN","LA7VORUB",99,0)
 . D RETOBR^LA7VHLU(LA("SITE"),LA("RUID"),LA7REFLEXNLT,.LA7REFLEXPARENT)
"RTN","LA7VORUB",100,0)
 . F I="OBR-18","OBR-19" S LA7PLOBR(I)=$G(LA7REFLEXPARENT(I))
"RTN","LA7VORUB",101,0)
 . I $G(LA7PLOBR("OBR-17"))="" S LA7PLOBR("OBR-17")=$G(LA7REFLEXPARENT("OBR-17"))
"RTN","LA7VORUB",102,0)
 ;
"RTN","LA7VORUB",103,0)
 ; Ordering provider
"RTN","LA7VORUB",104,0)
 K LA7X,LA7Y
"RTN","LA7VORUB",105,0)
 S (LA7X,LA7Y)=""
"RTN","LA7VORUB",106,0)
 ; "CH" subscript stores requesting provider and requesting div/location.
"RTN","LA7VORUB",107,0)
 I LA("SUB")="CH" D
"RTN","LA7VORUB",108,0)
 . N LA7J
"RTN","LA7VORUB",109,0)
 . S LA7J=$P(LA763(0),"^",13)
"RTN","LA7VORUB",110,0)
 . I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I")
"RTN","LA7VORUB",111,0)
 . I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";")
"RTN","LA7VORUB",112,0)
 . S LA7X=$P(LA763(0),"^",10)
"RTN","LA7VORUB",113,0)
 ;
"RTN","LA7VORUB",114,0)
 ; Other subscripts only store requesting provider
"RTN","LA7VORUB",115,0)
 I LA("SUB")?1(1"MI",1"SP",1"CY",1"EM") S LA7X=$P(LA763(0),"^",7)
"RTN","LA7VORUB",116,0)
 ;
"RTN","LA7VORUB",117,0)
 ; Send back ordering provider stored in #69.6 if available.
"RTN","LA7VORUB",118,0)
 I LA7INTYP=10,$G(LA7PLOBR("OBR-17"))'="" S LA7X=LA7PLOBR("OBR-17")
"RTN","LA7VORUB",119,0)
 ;
"RTN","LA7VORUB",120,0)
 I LA7Y="" S LA7Y=LADFINST
"RTN","LA7VORUB",121,0)
 S OBR(16)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH,$S($G(LA7INTYP)=30:2,$G(LA7NVAF)=1:0,1:1))
"RTN","LA7VORUB",122,0)
 ;
"RTN","LA7VORUB",123,0)
 ; Placer Field #1 (remote auto-inst)
"RTN","LA7VORUB",124,0)
 ; Build from info stored in #69.6
"RTN","LA7VORUB",125,0)
 I $G(LA7PLOBR("OBR-18"))'="" D
"RTN","LA7VORUB",126,0)
 . K LA7X
"RTN","LA7VORUB",127,0)
 . S LA7X=$$UNESC^LA7VHLU3(LA7PLOBR("OBR-18"),LA7PLOBR("FS")_LA7PLOBR("ECH"))
"RTN","LA7VORUB",128,0)
 . S OBR(18)=$$CHKDATA^LA7VHLU3(LA7X,LA7FS_LA7ECH)
"RTN","LA7VORUB",129,0)
 ;
"RTN","LA7VORUB",130,0)
 ; Else build "auto instrument" if sending to VA facility
"RTN","LA7VORUB",131,0)
 I $G(LA7PLOBR("OBR-18"))="",'LA7NVAF D
"RTN","LA7VORUB",132,0)
 . K LA7X
"RTN","LA7VORUB",133,0)
 . S LA7X(1)=LA("AUTO-INST")
"RTN","LA7VORUB",134,0)
 . S OBR(18)=$$OBR18^LA7VOBR(.LA7X,LA7FS,LA7ECH)
"RTN","LA7VORUB",135,0)
 ;
"RTN","LA7VORUB",136,0)
 ; Placer Field #2
"RTN","LA7VORUB",137,0)
 I $G(LA7PLOBR("OBR-19"))'="" D
"RTN","LA7VORUB",138,0)
 . K LA7X
"RTN","LA7VORUB",139,0)
 . S LA7X=$$UNESC^LA7VHLU3(LA7PLOBR("OBR-19"),LA7PLOBR("FS")_LA7PLOBR("ECH"))
"RTN","LA7VORUB",140,0)
 . S OBR(19)=$$CHKDATA^LA7VHLU3(LA7X,LA7FS_LA7ECH)
"RTN","LA7VORUB",141,0)
 ;
"RTN","LA7VORUB",142,0)
 ; Else build collecting UID if sending to VA facility
"RTN","LA7VORUB",143,0)
 I $G(LA7PLOBR("OBR-19"))="",'LA7NVAF,LA("RUID")'="" D
"RTN","LA7VORUB",144,0)
 . K LA7X
"RTN","LA7VORUB",145,0)
 . S LA7X(7)=LA("RUID")
"RTN","LA7VORUB",146,0)
 . S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
"RTN","LA7VORUB",147,0)
 ;
"RTN","LA7VORUB",148,0)
 ; Filler Field #1
"RTN","LA7VORUB",149,0)
 ; Send file #63 ien info - used by HDR to track patient/specimen
"RTN","LA7VORUB",150,0)
 K LA7X
"RTN","LA7VORUB",151,0)
 S LA7X(1)=LA("LRDFN"),LA7X(2)=LA("SUB"),LA7X(3)=LA("LRIDT")
"RTN","LA7VORUB",152,0)
 S OBR(20)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
"RTN","LA7VORUB",153,0)
 ;
"RTN","LA7VORUB",154,0)
 ; Filler Field #2
"RTN","LA7VORUB",155,0)
 ; Send Accession/test info - used by DSS to track patient/specimen
"RTN","LA7VORUB",156,0)
 ; LRACC^LRAA^LRAD^LRAN^Accession Area^Area Abbreviation^NLT
"RTN","LA7VORUB",157,0)
 K LA7X
"RTN","LA7VORUB",158,0)
 S LA7X(1)=$P(LA763(0),"^",6),LA7X(7)=LA7NLT
"RTN","LA7VORUB",159,0)
 S LA7Y=LA("HUID",68)
"RTN","LA7VORUB",160,0)
 I LA7Y D
"RTN","LA7VORUB",161,0)
 . N I
"RTN","LA7VORUB",162,0)
 . F I=1,2,3 S LA7X(I+1)=$P(LA7Y,"^",I)
"RTN","LA7VORUB",163,0)
 . S LA7X(5)=$P($G(^LRO(68,$P(LA7Y,"^"),0)),"^")
"RTN","LA7VORUB",164,0)
 . S LA7X(6)=$P($G(^LRO(68,$P(LA7Y,"^"),0)),"^",11)
"RTN","LA7VORUB",165,0)
 S OBR(21)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
"RTN","LA7VORUB",166,0)
 K LA7X
"RTN","LA7VORUB",167,0)
 ;
"RTN","LA7VORUB",168,0)
 ; Date Report Completed/Report status/Responsible person
"RTN","LA7VORUB",169,0)
 ; Determine report date and status from 0 node.
"RTN","LA7VORUB",170,0)
 S LA7RSDT=$P(LA763(0),"^",3),(LA7PRI,LA7RS)=""
"RTN","LA7VORUB",171,0)
 ;
"RTN","LA7VORUB",172,0)
 ; If CYEMSP subscripts then check for corrected report
"RTN","LA7VORUB",173,0)
 I LA("SUB")?1(1"SP",1"CY",1"EM") D
"RTN","LA7VORUB",174,0)
 . S LA7RSDT=$P(LA763(0),"^",11),LA7PRI=$P(LA763(0),"^",2)
"RTN","LA7VORUB",175,0)
 . I LA7RSDT S LA7RS="F"
"RTN","LA7VORUB",176,0)
 . I $P(LA763(0),"^",15) S LA7RS="C"
"RTN","LA7VORUB",177,0)
 . I $G(LRSB)=1.2,$G(LA7SR) S LA7RSDT=+$G(^LR(LRDFN,LA("SUB"),LRIDT,LRSB,LA7SR,0),"^")
"RTN","LA7VORUB",178,0)
 ;
"RTN","LA7VORUB",179,0)
 ; If MI subscript then also check various sections and audit subfile for corrected report
"RTN","LA7VORUB",180,0)
 I LA("SUB")="MI" D
"RTN","LA7VORUB",181,0)
 . S LA7PRI=$P(LA763(0),"^",4)
"RTN","LA7VORUB",182,0)
 . S LA7X=$S(LRSB=11:1,LRSB=11.52:1,LRSB=11.6:1,LRSB=12:1,LRSB=14:5,LRSB=16:5,LRSB=18:8,LRSB=20:8,LRSB=22:11,LRSB=26:11,LRSB=24:11,LRSB=33:16,LRSB=36:16,1:0)
"RTN","LA7VORUB",183,0)
 . S LA7Y=$G(^LR(LRDFN,"MI",LRIDT,LA7X),"^")
"RTN","LA7VORUB",184,0)
 . I $P(LA7Y,"^") S LA7RSDT=$P(LA7Y,"^"),LA7RS=$P(LA7Y,"^",2),LA7PRI=$P(LA7Y,"^",$S(LA7X=11:5,1:3))
"RTN","LA7VORUB",185,0)
 . I $P(LA763(0),"^",9)=1 S LA7RS="C" Q
"RTN","LA7VORUB",186,0)
 . I '$D(^LR(LRDFN,"MI",LRIDT,32)) Q
"RTN","LA7VORUB",187,0)
 . S I=0
"RTN","LA7VORUB",188,0)
 . F  S I=$O(^LR(LRDFN,"MI",LRIDT,32,I)) Q:'I  I $P(^(I,0),"^",4)>1,LA7RS="F" S LA7RS="C" Q
"RTN","LA7VORUB",189,0)
 ;
"RTN","LA7VORUB",190,0)
 ; Also check for individual test status on "ORUT" node in file #63
"RTN","LA7VORUB",191,0)
 I $P(LA7NLT(63),"^",10) S LA7RS=$P(LA7NLT(63),"^",10)
"RTN","LA7VORUB",192,0)
 ;
"RTN","LA7VORUB",193,0)
 ; Date Report Completed
"RTN","LA7VORUB",194,0)
 I LA7RSDT S OBR(22)=$$OBR22^LA7VOBR(LA7RSDT)
"RTN","LA7VORUB",195,0)
 ;
"RTN","LA7VORUB",196,0)
 ; Diagnostic service id
"RTN","LA7VORUB",197,0)
 S OBR(24)=$$OBR24^LA7VOBR(LA("SUB")_"^"_$G(LRSB))
"RTN","LA7VORUB",198,0)
 ;
"RTN","LA7VORUB",199,0)
 ; Result status
"RTN","LA7VORUB",200,0)
 I LA7RS'="" S OBR(25)=$$OBR25^LA7VOBR(LA7RS)
"RTN","LA7VORUB",201,0)
 ;
"RTN","LA7VORUB",202,0)
 ; Parent Result and Parent
"RTN","LA7VORUB",203,0)
 I $D(LA7PARNT) D
"RTN","LA7VORUB",204,0)
 . S OBR(26)=$$OBR26^LA7VOBR(LA7PARNT(1),LA7PARNT(2),LA7PARNT(3),LA7FS,LA7ECH)
"RTN","LA7VORUB",205,0)
 . S OBR(29)=$$OBR29^LA7VOBR(LA("RUID"),LA("HUID"),LA7FS,LA7ECH)
"RTN","LA7VORUB",206,0)
 ;
"RTN","LA7VORUB",207,0)
 ; Principle result interpreter
"RTN","LA7VORUB",208,0)
 I LA("SUB")?1(1"CY",1"EM",1"MI",1"SP"),LA7PRI'="" S OBR(32)=$$OBR32^LA7VOBR(LA7PRI,LADFINST,LA7FS,LA7ECH)
"RTN","LA7VORUB",209,0)
 ;
"RTN","LA7VORUB",210,0)
 ; Assistant result interpreter
"RTN","LA7VORUB",211,0)
 I LA("SUB")?1(1"SP",1"EM"),$P(LA763(0),"^",4) S OBR(33)=$$OBR33^LA7VOBR($P(LA763(0),"^",4),LADFINST,LA7FS,LA7ECH)
"RTN","LA7VORUB",212,0)
 ;
"RTN","LA7VORUB",213,0)
 ; Technician
"RTN","LA7VORUB",214,0)
 I LA("SUB")?1(1"CY",1"EM"),$P(LA763(0),"^",4) S OBR(34)=$$OBR34^LA7VOBR($P(LA763(0),"^",4),LADFINST,LA7FS,LA7ECH)
"RTN","LA7VORUB",215,0)
 ;
"RTN","LA7VORUB",216,0)
 ; Typist - VistA stores as free text
"RTN","LA7VORUB",217,0)
 I LA("SUB")?1(1"SP",1"CY",1"EM"),$P(LA763(0),"^",9)'="" S OBR(35)=$$OBR35^LA7VOBR($P(LA763(0),"^",9),LADFINST,LA7FS,LA7ECH)
"RTN","LA7VORUB",218,0)
 ;
"RTN","LA7VORUB",219,0)
 ; Procedure code - use Order NLT code
"RTN","LA7VORUB",220,0)
 S OBR(44)=$$OBR44^LA7VOBR(LA7NLT,LA7FS,LA7ECH)
"RTN","LA7VORUB",221,0)
 ;
"RTN","LA7VORUB",222,0)
 D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
"RTN","LA7VORUB",223,0)
 D FILESEG^LA7VHLU(GBL,.LA7DATA)
"RTN","LA7VORUB",224,0)
 ;
"RTN","LA7VORUB",225,0)
 ; Check for flag to only build message but do not file
"RTN","LA7VORUB",226,0)
 I '$G(LA7NOMSG) D
"RTN","LA7VORUB",227,0)
 . D FILE6249^LA7VHLU(LA76249,.LA7DATA)
"RTN","LA7VORUB",228,0)
 . I LA("HUID")'="" D
"RTN","LA7VORUB",229,0)
 . . D SETID^LA7VHLU1(LA76249,LA7ID,LA("HUID"),0)
"RTN","LA7VORUB",230,0)
 . . D SETID^LA7VHLU1(LA76249,"",LA("HUID"),0)
"RTN","LA7VORUB",231,0)
 . I LA("RUID")'="" D
"RTN","LA7VORUB",232,0)
 . . D SETID^LA7VHLU1(LA76249,LA7ID,LA("RUID"),0)
"RTN","LA7VORUB",233,0)
 . . D SETID^LA7VHLU1(LA76249,"",LA("RUID"),0)
"RTN","LA7VORUB",234,0)
 ;
"RTN","LA7VORUB",235,0)
 Q
"RTN","LA80")
0^5^B5891361
"RTN","LA80",1,0)
LA80 ;DALOI/STAFF - LA*5.2*80 KIDS ROUTINE ;3/25/13  11:02
"RTN","LA80",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**80**;Sep 27, 1994;Build 19
"RTN","LA80",3,0)
 ;
"RTN","LA80",4,0)
 Q
"RTN","LA80",5,0)
POST ;
"RTN","LA80",6,0)
 ; KIDS Post install for LA*5.2*80
"RTN","LA80",7,0)
 D REMOVE,ADD1,ADD2
"RTN","LA80",8,0)
 Q
"RTN","LA80",9,0)
 ;
"RTN","LA80",10,0)
REMOVE ;
"RTN","LA80",11,0)
 ; Remove LOINC code 22638-1 from the SP Comment concept.
"RTN","LA80",12,0)
 N LRCNPTNM,LRLNC
"RTN","LA80",13,0)
 S LRCNPTNM="SP COMMENT",LRLNC="22638-1"
"RTN","LA80",14,0)
 D REMLNC(LRCNPTNM,LRLNC)
"RTN","LA80",15,0)
 Q
"RTN","LA80",16,0)
 ;
"RTN","LA80",17,0)
REMLNC(LRCNPTNM,LRLNC) ;
"RTN","LA80",18,0)
 ; Remove LOINC code from concept.
"RTN","LA80",19,0)
 N LRCNCPT,LRID
"RTN","LA80",20,0)
 S LRCNCPT=$O(^LAB(62.47,"B",LRCNPTNM,0))
"RTN","LA80",21,0)
 I +LRCNCPT D
"RTN","LA80",22,0)
 .S LRID=$O(^LAB(62.47,LRCNCPT,1,"B",LRLNC,0))
"RTN","LA80",23,0)
 .I +LRID D REMSENT(+LRCNCPT,+LRID,LRLNC)
"RTN","LA80",24,0)
 Q
"RTN","LA80",25,0)
 ;
"RTN","LA80",26,0)
REMSENT(LRCNCPT,LRID,LRLNC) ;
"RTN","LA80",27,0)
 ; Remove Sub-file Entry.
"RTN","LA80",28,0)
 N DA,DIK
"RTN","LA80",29,0)
 S DA(1)=LRCNCPT
"RTN","LA80",30,0)
 S DA=LRID
"RTN","LA80",31,0)
 S DIK="^LAB(62.47,"_DA(1)_",1,"
"RTN","LA80",32,0)
 L +^LAB(62.47,DA(1)):$G(DILOCKTM,5)
"RTN","LA80",33,0)
 I $T D  Q
"RTN","LA80",34,0)
 .D ^DIK
"RTN","LA80",35,0)
 .L -^LAB(62.47,DA(1))
"RTN","LA80",36,0)
 D BMES("*** Unable to obtain lock for ^LAB(62.47,"_DA(1)_") to remove LOINC code "_LRLNC_" ***")
"RTN","LA80",37,0)
 Q
"RTN","LA80",38,0)
 ;
"RTN","LA80",39,0)
ADD1 ;
"RTN","LA80",40,0)
 ; Add LOINC code 24419-4 to CY Gross Description, and EM Gross
"RTN","LA80",41,0)
 ; Description concepts.
"RTN","LA80",42,0)
 N DIC,X,Y
"RTN","LA80",43,0)
 S DIC="^LAB(62.47,",DIC(0)="X"
"RTN","LA80",44,0)
 F X="CY","EM" D
"RTN","LA80",45,0)
 .S X=X_" GROSS DESCRIPTION"
"RTN","LA80",46,0)
 .D ^DIC
"RTN","LA80",47,0)
 .Q:Y=-1
"RTN","LA80",48,0)
 .D ADDLNC(+Y,"24419-4")
"RTN","LA80",49,0)
 Q
"RTN","LA80",50,0)
 ;
"RTN","LA80",51,0)
ADD2 ;
"RTN","LA80",52,0)
 ; Add LOINC code 22638-1 to SP Gross Description, CY Gross
"RTN","LA80",53,0)
 ; Description, and EM Gross Description concepts.
"RTN","LA80",54,0)
 N DIC,X,Y
"RTN","LA80",55,0)
 S DIC="^LAB(62.47,",DIC(0)="X"
"RTN","LA80",56,0)
 F X="SP","CY","EM" D
"RTN","LA80",57,0)
 .S X=X_" GROSS DESCRIPTION"
"RTN","LA80",58,0)
 .D ^DIC
"RTN","LA80",59,0)
 .Q:Y=-1
"RTN","LA80",60,0)
 .D ADDLNC(+Y,"22638-1")
"RTN","LA80",61,0)
 Q
"RTN","LA80",62,0)
 ;
"RTN","LA80",63,0)
ADDLNC(LRCNCPT,LRLNC) ;
"RTN","LA80",64,0)
 ; Add LOINC code to concept
"RTN","LA80",65,0)
 N DA,DIC,X,Y,LRFPRIV,DIE,DR
"RTN","LA80",66,0)
 S DA(1)=LRCNCPT,DIC="^LAB(62.47,"_DA(1)_",1,",DIC(0)="L"
"RTN","LA80",67,0)
 S X=LRLNC
"RTN","LA80",68,0)
 L +^LAB(62.47,DA(1)):$G(DILOCKTM,5)
"RTN","LA80",69,0)
 I '$T D  Q
"RTN","LA80",70,0)
 .D BMES("*** Unable to obtain lock for ^LAB(62.47,"_DA(1)_") to add LOINC code "_LRLNC_" ***")
"RTN","LA80",71,0)
 D ^DIC
"RTN","LA80",72,0)
 I Y=-1 D  Q
"RTN","LA80",73,0)
 .L -^LAB(62.47,DA(1))
"RTN","LA80",74,0)
 ;
"RTN","LA80",75,0)
 S LRFPRIV=1,DIE=DIC   ;LRFPRIV is needed for editing #.05
"RTN","LA80",76,0)
 K DIC
"RTN","LA80",77,0)
 S DA(1)=LRCNCPT,DA=+Y,DR=".02///LN;.03///1;.05///1"
"RTN","LA80",78,0)
 D ^DIE
"RTN","LA80",79,0)
 L -^LAB(62.47,DA(1))
"RTN","LA80",80,0)
 Q
"RTN","LA80",81,0)
 ;
"RTN","LA80",82,0)
BMES(STR) ;
"RTN","LA80",83,0)
 ; Write string
"RTN","LA80",84,0)
 D BMES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$G(IOM,80)),"R"," "))
"RTN","LA80",85,0)
 Q
"RTN","LAMIAUT4")
0^2^B18820439
"RTN","LAMIAUT4",1,0)
LAMIAUT4 ;SLC/FHS - EDIT OR VERIFY MICRO AUTO INSTRUMENTS ;05/02/13
"RTN","LAMIAUT4",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**153,80**;Sep 27, 1994;Build 19
"RTN","LAMIAUT4",3,0)
EN ;
"RTN","LAMIAUT4",4,0)
 Q:LREND  R !!," ('E'dit data, 'C'omments, 'O'rganism 'W'orklist) // ",LREDIT:DTIME Q:'$T
"RTN","LAMIAUT4",5,0)
 I $E(LREDIT)="?" D HLP,^LAMIAUT3 G EN
"RTN","LAMIAUT4",6,0)
 I $E(LREDIT)="^"!($E(LREDIT="@")) D DEL^LAMIAUT5 K LRBDUP,LRMOVE Q
"RTN","LAMIAUT4",7,0)
 K DIC,DR,DIE,DA S DA=LRIDT,DA(1)=LRDFN,LRY(0)=^LR(LRDFN,"MI",LRIDT,0),DIE="^LR("_DA(1)_",""MI"",",DIC=DIE I $E(LREDIT)="E" S ZX9=X9 D EDIT,^LAMIAUT3 S X9=ZX9 K ZX9 G EN
"RTN","LAMIAUT4",8,0)
 I $E(LREDIT)="O" S ZX9=X9 D ^LRMIBUG,^LAMIAUT3 S X9=ZX9 K ZX9 G EN
"RTN","LAMIAUT4",9,0)
 I $E(LREDIT)="C" K DR S DR=".99;1;13" D ^DIE D ^LAMIAUT3 G EN
"RTN","LAMIAUT4",10,0)
 I $E(LREDIT)="W" D EN^LRCAPV D ^LAMIAUT3 G EN
"RTN","LAMIAUT4",11,0)
 R !,"Approve for release by entering your initials: ",X:DTIME I '$T!($E(X)="^") D DEL^LAMIAUT5 Q
"RTN","LAMIAUT4",12,0)
 I X'=LRINI W !!,$C(7)," NOT APPROVED " Q
"RTN","LAMIAUT4",13,0)
 D VER Q
"RTN","LAMIAUT4",14,0)
EXP ;Get the list of tests for this ACC.
"RTN","LAMIAUT4",15,0)
 W !!,PNM,"   ",SSN,!,LRACCN D INF^LRX W !!?5,$P(^LAB(61,LRSPEC,0),U),"  ",$P(^LAB(62,LRSAMP,0),U),!
"RTN","LAMIAUT4",16,0)
 K ^TMP("LR",$J),LRTEST,LRNAME,LRTS S N=0 F I=0:0 S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1  S N=N+1,LRTEST(N)=+^(I,0),LRTEST(N,"P")=$P(^(0),U,9)
"RTN","LAMIAUT4",17,0)
 S LRNTN=N F I=1:1:N S:$D(^LAB(60,+LRTEST(I),0)) LRTEST(I)=LRTEST(I)_U_^(0),LRNAME(I)=$P(LRTEST(I),U,2),LRNAME(I,+LRTEST(I))="",LRTS(I)=LRNAME(I),LRTS(I,+LRTEST(I))=""
"RTN","LAMIAUT4",18,0)
 S LRALL="" F I=1:1:LRNTN I $D(LRNAME(I)) S LRALL=LRALL_","_I W !,I,"  ",LRNAME(I) I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+$O(LRNAME(I,0)),0)),$P(^(0),U,5) W ?25," verified"
"RTN","LAMIAUT4",19,0)
V9 S LRALL=$P(LRALL,",",2,99) R !!,"TEST #(s) (or ""ALL""): ",X:DTIME S:'$T X=U S:X="" X=LRALL S:X["A" X=LRALL S:$E(X)="^" LREND=1 Q:LREND
"RTN","LAMIAUT4",20,0)
 I X["?" W !,"Enter for example 1,2,5-9." G V9
"RTN","LAMIAUT4",21,0)
 Q:$E(X)="^"  D RANGE^LRWU2 Q:X9=""  X (X9_"S:'$D(LRNAME(T1)) X=0") I X=0 W !!?7,"Incorrect test number ",$C(7) G EXP
"RTN","LAMIAUT4",22,0)
L10 S LRNX=0 X (X9_"D EX1^LRVER1")
"RTN","LAMIAUT4",23,0)
 Q
"RTN","LAMIAUT4",24,0)
EDIT S LRALL="" W !?7,"Edit ? ",! F I=0:0 S I=$O(LRNAME(I)) Q:I=""  W !?3,"(",I,")  ",LRNAME(I) S LRALL=LRALL_","_I I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0)),$P(^(0),U,5) W ?25,"Verified "
"RTN","LAMIAUT4",25,0)
 S LRALL=$P(LRALL,",",2,99) R !!,"TEST #(s) (or ""ALL""): ",X:DTIME Q:'$T!($E(X)="^")  S:X["A" X=LRALL S:X="" X=LRALL
"RTN","LAMIAUT4",26,0)
 I X["?" W !?7,"Enter for example 1,2,5-9 ",! G EDIT
"RTN","LAMIAUT4",27,0)
 D RANGE^LRWU2 Q:X9=""  X (X9_"S:'$D(LRNAME(T1)) X=0") I X=0 W !!?7,"Incorrect number ",$C(7),! G EDIT
"RTN","LAMIAUT4",28,0)
 X (X9_"S LRTS=+$O(LRTS(T1,0)) I LRTS D EDIT1^LAMIAUT4")
"RTN","LAMIAUT4",29,0)
 Q
"RTN","LAMIAUT4",30,0)
EDIT1 S LRSB=1,LRCODE=$P(^LAB(60,+$O(LRNAME(T1,0)),0),U,14) D EDIT2
"RTN","LAMIAUT4",31,0)
 Q
"RTN","LAMIAUT4",32,0)
EDIT2 I 'LRCODE W $C(7),!?7,"NO EDIT CODE FOR ",LRNAME(T1) Q
"RTN","LAMIAUT4",33,0)
 I '$D(^LAB(62.07,LRCODE,.1)) W $C(7),!?7,"EDIT CODE IS MISSING FOR ",LRNAME(T1) Q
"RTN","LAMIAUT4",34,0)
 N LRBG0
"RTN","LAMIAUT4",35,0)
 W !!?7,"Editing ",LRNAME(T1),!! K DR S LRTS=+$O(LRTS(T1,0)),(LRBG0,Y(0))=LRY(0) X:LRTS ^LAB(62.07,LRCODE,.1)
"RTN","LAMIAUT4",36,0)
 I 'LRTS W !,"NO TEST DEFINED ",!!,$C(7)
"RTN","LAMIAUT4",37,0)
 Q
"RTN","LAMIAUT4",38,0)
VER ;
"RTN","LAMIAUT4",39,0)
 N LRBG0
"RTN","LAMIAUT4",40,0)
 Q:X9=""  S (LRBG0,Y(0))=^LR(LRDFN,"MI",LRIDT,0),LRCAPOK=1,LRUNDO=0 I '$P(Y(0),U,3) S:$P(Y(0),U,9) LRUNDO=1 G VER1
"RTN","LAMIAUT4",41,0)
 I $P(^LR(LRDFN,"MI",LRIDT,0),U,3) W !,"Final report has been verified by micro  supervisor,",$C(7),!,"If you proceed in editing, the report will be reprinted"
"RTN","LAMIAUT4",42,0)
 F I=0:0 W !?10,"OK" S %=1 D YN^DICN Q:%  W !," Enter  'Y' or 'N' : "
"RTN","LAMIAUT4",43,0)
 I %=2!(%<0) Q
"RTN","LAMIAUT4",44,0)
VER1 ;
"RTN","LAMIAUT4",45,0)
 D:'$P(^LAB(69.9,1,"NITE"),U) ANN^LRCAPV
"RTN","LAMIAUT4",46,0)
 ;N LRADD,GLB,LRBUG,LRBUGY
"RTN","LAMIAUT4",47,0)
 S LRSB=1 W ! X (X9_"S LRPTP=$O(LRNAME(T1,0))") S LRCAPOK=1,Y(0)=^LR(LRDFN,"MI",LRIDT,0) D
"RTN","LAMIAUT4",48,0)
 . K DR S DR=11,LRSAME=0 D:LRUNDO UNDO^LRMIEDZ D ^DIE,TIME^LRMIEDZ3 S LRTS=LRPTP I $G(LRTS) D:LRCAPOK&($P(LRPARAM,U,14)) LOOK^LRCAPV1
"RTN","LAMIAUT4",49,0)
 N LRWRDVEW,LRUID
"RTN","LAMIAUT4",50,0)
 S LRWRDVEW=1
"RTN","LAMIAUT4",51,0)
 D VT^LRMIUT1 I $L($G(LRVT)) D STF^LRMIUT
"RTN","LAMIAUT4",52,0)
 ;
"RTN","LAMIAUT4",53,0)
 ;Ask for performing lab assignment
"RTN","LAMIAUT4",54,0)
 D EDIT^LRRPLU(LRDFN,LRSS,LRIDT)
"RTN","LAMIAUT4",55,0)
 ;
"RTN","LAMIAUT4",56,0)
 ;call clinical reminders
"RTN","LAMIAUT4",57,0)
 D UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
"RTN","LAMIAUT4",58,0)
 ;
"RTN","LAMIAUT4",59,0)
 ;Ask to send CPRS alert
"RTN","LAMIAUT4",60,0)
 S LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^")
"RTN","LAMIAUT4",61,0)
 D ASKXQA^LRMIEDZ2
"RTN","LAMIAUT4",62,0)
 S ^LRO(68,"AVS",LRAA,LRAD,LRAN)=LRDFN_U_LRIDT
"RTN","LAMIAUT4",63,0)
 ;Cleanup entry in LAH.
"RTN","LAMIAUT4",64,0)
 D ZAPALL^LRVR3(LRLL,LRIFN)
"RTN","LAMIAUT4",65,0)
 Q
"RTN","LAMIAUT4",66,0)
HLP W !!?10,"ENTER",?20,"'E' TO EDIT ENTIRE ACCESSION. ",!?20,"'C' TO EDIT COMMENT",!?20,"'O' TO EDIT ORGANISM "
"RTN","LAMIAUT4",67,0)
 W !?20,"'^' OR '@' WILL DELETE TRANSFERRED DATA ",! H 2 Q
"UP",62.47,62.4701,-1)
62.47^1
"UP",62.47,62.4701,0)
62.4701
"UP",62.48,62.482,-1)
62.48^SCT
"UP",62.48,62.482,0)
62.482
"VER")
8.0^22.0
"^DD",62.47,62.47,.001,0)
SEQUENCE^NJ4,0X^^ ^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1.N) X K:($G(DIUTIL)'="VERIFY FIELDS"&'$G(LRFPRIV)) X
"^DD",62.47,62.47,.001,3)
Type a number between 1 and 9999, 0 Decimal Digits.
"^DD",62.47,62.47,.001,21,0)
^.001^1^1^3121023^^
"^DD",62.47,62.47,.001,21,1,0)
Sequence number (IEN).
"^DD",62.47,62.47,.001,"DT")
3121024
"^DD",62.47,62.47,.01,0)
CONCEPT^RF^^0;1^K:$L(X)>45!($L(X)<3)!'(X'?1P.E) X
"^DD",62.47,62.47,.01,1,0)
^.1
"^DD",62.47,62.47,.01,1,1,0)
62.47^B
"^DD",62.47,62.47,.01,1,1,1)
S ^LAB(62.47,"B",$E(X,1,30),DA)=""
"^DD",62.47,62.47,.01,1,1,2)
K ^LAB(62.47,"B",$E(X,1,30),DA)
"^DD",62.47,62.47,.01,3)
Answer must be 3-45 characters in length.
"^DD",62.47,62.47,.01,21,0)
^.001^3^3^3121023^^
"^DD",62.47,62.47,.01,21,1,0)
Indicates the nature of the codes and what area of the laboratory
"^DD",62.47,62.47,.01,21,2,0)
the concept relates.
"^DD",62.47,62.47,.01,21,3,0)

"^DD",62.47,62.47,.01,"DT")
3121024
"^DD",62.47,62.47,.04,0)
ALTERNATE CONCEPT^P62.47'^LAB(62.47,^0;4^Q
"^DD",62.47,62.47,.04,3)
Select the alternate concept related to this concept.
"^DD",62.47,62.47,.04,21,0)
^^9^9^3121023^
"^DD",62.47,62.47,.04,21,1,0)
Used to designate an alternate concept when the answer associated
"^DD",62.47,62.47,.04,21,2,0)
with this concept is not in a form that can be stored within the
"^DD",62.47,62.47,.04,21,3,0)
current VistA database.
"^DD",62.47,62.47,.04,21,4,0)
 
"^DD",62.47,62.47,.04,21,5,0)
Example is when VistA expects to store the answer as a pointer
"^DD",62.47,62.47,.04,21,6,0)
to a VistA file and the instance of an answer is free text.
"^DD",62.47,62.47,.04,21,7,0)
 
"^DD",62.47,62.47,.04,21,8,0)
This field will point to a concept that will allow the answer to
"^DD",62.47,62.47,.04,21,9,0)
be stored in a field which can accept the answer.
"^DD",62.47,62.47,.04,"DT")
3121024
"^DD",62.47,62.47,1,0)
IDENTIFIER^62.4701I^^1;0
"^DD",62.47,62.47,1,21,0)
^.001^2^2^3121023^^
"^DD",62.47,62.47,1,21,1,0)
The Identifier contains the codes/codesets that are associated 
"^DD",62.47,62.47,1,21,2,0)
with this Concept.
"^DD",62.47,62.47,1,"DT")
3060206
"^DD",62.47,62.4701,0)
IDENTIFIER SUB-FIELD^^2.2^7
"^DD",62.47,62.4701,0,"NM","IDENTIFIER")

"^DD",62.47,62.4701,.01,0)
IDENTIFIER^MFX^^0;1^K:$L(X)>30!($L(X)<1) X D:$G(X)]"" CODSETOK^LA7VLCM3(DA(1),$G(DA),X,,1)
"^DD",62.47,62.4701,.01,1,0)
^.1^^-1
"^DD",62.47,62.4701,.01,1,1,0)
62.4701^B
"^DD",62.47,62.4701,.01,1,1,1)
S ^LAB(62.47,DA(1),1,"B",$E(X,1,30),DA)=""
"^DD",62.47,62.4701,.01,1,1,2)
K ^LAB(62.47,DA(1),1,"B",$E(X,1,30),DA)
"^DD",62.47,62.4701,.01,3)
Answer must be 1-30 characters in length.
"^DD",62.47,62.4701,.01,21,0)
^^3^3^3121023^
"^DD",62.47,62.4701,.01,21,1,0)
This is the code or id associated with an instance of this concept.
"^DD",62.47,62.4701,.01,21,2,0)
The identifier in conjunction with CODING SYSTEM field (#.02) 
"^DD",62.47,62.4701,.01,21,3,0)
indicates its use and source.
"^DD",62.47,62.4701,.01,"DT")
3121024
"^DD",62.47,62.4701,.02,0)
CODING SYSTEM^RFX^^0;2^D ITP02^LA7XREF
"^DD",62.47,62.4701,.02,1,0)
^.1
"^DD",62.47,62.4701,.02,1,1,0)
62.4701^C
"^DD",62.47,62.4701,.02,1,1,1)
S ^LAB(62.47,DA(1),1,"C",$E(X,1,30),DA)=""
"^DD",62.47,62.4701,.02,1,1,2)
K ^LAB(62.47,DA(1),1,"C",$E(X,1,30),DA)
"^DD",62.47,62.4701,.02,1,1,"DT")
3060616
"^DD",62.47,62.4701,.02,3)
Answer 1-15 characters, Uppercase (e.g., LN, SCT, L, 99*).
"^DD",62.47,62.4701,.02,21,0)
^.001^3^3^3121023^^^
"^DD",62.47,62.4701,.02,21,1,0)
Identifies the name of the coding system which this code is derived
"^DD",62.47,62.4701,.02,21,2,0)
from.
"^DD",62.47,62.4701,.02,21,3,0)

"^DD",62.47,62.4701,.02,23,0)
^.001^1^1^3121023^^^
"^DD",62.47,62.4701,.02,23,1,0)

"^DD",62.47,62.4701,.02,"DT")
3121024
"^DD",62.47,62.4701,.05,0)
NATIONAL STANDARD^*SX^0:NO;1:YES;^0;5^Q
"^DD",62.47,62.4701,.05,1,0)
^.1
"^DD",62.47,62.4701,.05,1,1,0)
62.4701^AC
"^DD",62.47,62.4701,.05,1,1,1)
S ^LAB(62.47,DA(1),1,"AC",$E(X,1,30),DA)=""
"^DD",62.47,62.4701,.05,1,1,2)
K ^LAB(62.47,DA(1),1,"AC",$E(X,1,30),DA)
"^DD",62.47,62.4701,.05,1,1,"DT")
3060616
"^DD",62.47,62.4701,.05,3)
Is this entry nationally released code?
"^DD",62.47,62.4701,.05,12)
Do not allow local entries to be flagged as national.
"^DD",62.47,62.4701,.05,12.1)
S DIC("S")="I ($G(DIUTIL)=""VERIFY FIELDS"")!$G(LRFPRIV)!('$G(LRFPRIV)&Y=0)"
"^DD",62.47,62.4701,.05,21,0)
^^2^2^3121023^
"^DD",62.47,62.4701,.05,21,1,0)
This field indicates whether this entry was distributed nationwide. If
"^DD",62.47,62.4701,.05,21,2,0)
not, then it was entered locally.
"^DD",62.47,62.4701,.05,"DT")
3121024
"^DD",62.47,62.4701,2.1,0)
RELATED ENTRY^V^^2;1^
"^DD",62.47,62.4701,2.1,1,0)
^.1
"^DD",62.47,62.4701,2.1,1,1,0)
62.47^AE
"^DD",62.47,62.4701,2.1,1,1,1)
S ^LAB(62.47,"AE",$E(X,1,30),DA(1),DA)=""
"^DD",62.47,62.4701,2.1,1,1,2)
K ^LAB(62.47,"AE",$E(X,1,30),DA(1),DA)
"^DD",62.47,62.4701,2.1,1,1,"%D",0)
^^4^4^3060426^
"^DD",62.47,62.4701,2.1,1,1,"%D",1,0)
LAB(62.47,"AE",Pointed-To File,DA(1),DA)
"^DD",62.47,62.4701,2.1,1,1,"%D",2,0)
 
"^DD",62.47,62.4701,2.1,1,1,"%D",3,0)
Identify entries in the pointed-to files that are mapped to #62.47
"^DD",62.47,62.4701,2.1,1,1,"%D",4,0)
entries.
"^DD",62.47,62.4701,2.1,1,1,"DT")
3060426
"^DD",62.47,62.4701,2.1,3)
Select the related entry to link this code/codeset to.
"^DD",62.47,62.4701,2.1,21,0)
^.001^3^3^3121023^^
"^DD",62.47,62.4701,2.1,21,1,0)
Links this code/codeset to an entry in one of the pointed-to files.  This 
"^DD",62.47,62.4701,2.1,21,2,0)
allows the system to determine how to translate a code/codeset to a file 
"^DD",62.47,62.4701,2.1,21,3,0)
entry.
"^DD",62.47,62.4701,2.1,"DT")
3121024
"^DD",62.47,62.4701,2.1,"V",0)
^.12P^^2
"^DD",62.47,62.4701,2.1,"V",1,0)
61.2^Select ETIOLOGY^1^ET^n^n
"^DD",62.47,62.4701,2.1,"V",2,0)
62.06^Select ANTIBIOTIC^2^AB^n^n
"^DD",62.47,62.4701,2.2,0)
MESSAGE CONFIGURATION^P62.48'^LAHM(62.48,^2;2^Q
"^DD",62.47,62.4701,2.2,1,0)
^.1
"^DD",62.47,62.4701,2.2,1,1,0)
62.47^AG
"^DD",62.47,62.4701,2.2,1,1,1)
S ^LAB(62.47,"AG",$E(X,1,30),DA(1),DA)=""
"^DD",62.47,62.4701,2.2,1,1,2)
K ^LAB(62.47,"AG",$E(X,1,30),DA(1),DA)
"^DD",62.47,62.4701,2.2,1,1,"%D",0)
^^1^1^3060912^
"^DD",62.47,62.4701,2.2,1,1,"%D",1,0)
^LAB(62.47,"AG",R6248,R6247,R624701)=""
"^DD",62.47,62.4701,2.2,1,1,"DT")
3060912
"^DD",62.47,62.4701,2.2,3)
For local codes, select the interface this code is associated with.
"^DD",62.47,62.4701,2.2,21,0)
^.001^4^4^3121023^^^^
"^DD",62.47,62.4701,2.2,21,1,0)
When the related identifier (code) is from a local coding system
"^DD",62.47,62.4701,2.2,21,2,0)
then this field indicates for which specific interface the code
"^DD",62.47,62.4701,2.2,21,3,0)
is associated with. Local codes are interface specific.
"^DD",62.47,62.4701,2.2,21,4,0)

"^DD",62.47,62.4701,2.2,"DT")
3121024
"^DD",62.48,62.48,30,0)
NON-VA ORDER SNOMED CODES^62.482IV^^SCT;0
"^DD",62.48,62.48,30,21,0)
^.001^3^3^3121026^^^^
"^DD",62.48,62.48,30,21,1,0)
Allows mapping a SNOMED CT code to specimen (topography) and/or collection
"^DD",62.48,62.48,30,21,2,0)
sample which an external system requires and which is different from the
"^DD",62.48,62.48,30,21,3,0)
SNOMED CT code assigned to the concept by the Dept of Veterans Affairs.
"^DD",62.48,62.48,30,23,0)
^.001^2^2^3121026^^^
"^DD",62.48,62.48,30,23,1,0)
This field uses a combination of an Output Transform and a "WRITE
"^DD",62.48,62.48,30,23,2,0)
ID" node in the DD to display the file that the particular entry is from.
"^DD",62.48,62.482,0)
NON-VA ORDER SNOMED CODES SUB-FIELD^^.001^3
"^DD",62.48,62.482,0,"DT")
3121026
"^DD",62.48,62.482,0,"ID","LA")
D EN^DDIOL("  "_$$ID62482^LA7XREF(),"","$C(32)")
"^DD",62.48,62.482,0,"IX","B",62.482,.01)

"^DD",62.48,62.482,0,"NM","NON-VA ORDER SNOMED CODES")

"^DD",62.48,62.482,0,"UP")
62.48
"^DD",62.48,62.482,.001,0)
SEQUENCE^NJ12,0^^ ^K:+X'=X!(X>999999999999)!(X<1)!(X?.E1"."1N.N) X
"^DD",62.48,62.482,.001,3)
Type a Number between 1 and 999999999999, 0 Decimal Digits.
"^DD",62.48,62.482,.001,21,0)
^^1^1^3070803^
"^DD",62.48,62.482,.001,21,1,0)
Sequence (IEN) number.
"^DD",62.48,62.482,.001,"DT")
3121026
"^DD",62.48,62.482,.01,0)
VA FILE ENTRY^MVO^^0;1^
"^DD",62.48,62.482,.01,1,0)
^.1
"^DD",62.48,62.482,.01,1,1,0)
62.482^B
"^DD",62.48,62.482,.01,1,1,1)
S ^LAHM(62.48,DA(1),"SCT","B",$E(X,1,30),DA)=""
"^DD",62.48,62.482,.01,1,1,2)
K ^LAHM(62.48,DA(1),"SCT","B",$E(X,1,30),DA)
"^DD",62.48,62.482,.01,1,1,3)
Required for Variable Pointer
"^DD",62.48,62.482,.01,2)
S Y(0)=Y S Y=$$OT62482^LA7XREF(Y)
"^DD",62.48,62.482,.01,2.1)
S Y=$$OT62482^LA7XREF(Y)
"^DD",62.48,62.482,.01,3)
Select specimen or collection sample.
"^DD",62.48,62.482,.01,21,0)
^.001^1^1^3121026^^
"^DD",62.48,62.482,.01,21,1,0)
The file entry to map to a different code/codeset.
"^DD",62.48,62.482,.01,"DT")
3121026
"^DD",62.48,62.482,.01,"V",0)
^.12P^^2
"^DD",62.48,62.482,.01,"V",1,0)
61^Specimen from TOPOGRAPHY file^1^SP^n^n
"^DD",62.48,62.482,.01,"V",2,0)
62^Sample from COLLECTION SAMPLE^2^CS^n^n
"^DD",62.48,62.482,.02,0)
SNOMED CT ID^NJ10,0X^^0;2^N LROUT K:'$$SCTOK^LRSCT(X,,.LROUT) X D:$D(X)&('$$ISQUIET^LRXREF()) EN^DDIOL($G(LROUT("F")),"","$C(32)")
"^DD",62.48,62.482,.02,3)
Enter a valid SNOMED CT Code.
"^DD",62.48,62.482,.02,21,0)
^^1^1^3061218^
"^DD",62.48,62.482,.02,21,1,0)
This is the SNOMED CT code for this entry.
"^DD",62.48,62.482,.02,"DT")
3121026
**END**
**END**
OBR-19"))="",'LA7NVAF,LA("RUID")'="" D
"RTN","LA7VORUB",144,0)
 . K LA7X
"RTN","LA7VORUB",145,0)
 . S LA7X(7)=LA("RUID")
"RTN","LA7VORUB",146,0)
 . S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
"RTN","LA7VORUB",147,0)
 ;
"RTN","LA7VORUB",148,0)
 ; Filler Field #1
"RTN","LA7VORUB",149,0)
 ; Send file #63 ien info - used by HDR to track patient/specimen
"RTN","LA7VORUB",150,0)
 K LA7X
"RTN","LA7VORUB",151,0)
 S LA7X(1)=LA("LRDFN"),LA7X(2)=LA("SUB"),LA7X(3)=LA("LRIDT")
"RTN","LA7VORUB",152,0)
 S OBR(20)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
"RTN","LA7VORUB",153,0)
 ;
"RTN","LA7VORUB",154,0)
 ; Filler Field #2
"RTN","LA7VORUB",155,0)
 ; Send Accession/test info - used by DSS to track patient/specimen
"RTN","LA7VORUB",156,0)
 ; LRACC^LRAA^LRAD^LRAN^Accession Area^Area Abbreviation^NLT
"RTN","LA7VORUB",157,0)
 K LA7X
"RTN","LA7VORUB",158,0)
 S LA7X(1)=$P(LA763(0),"^",6),LA7X(7)=LA7NLT
"RTN","LA7VORUB",159,0)
 S LA7Y=LA("HUID",68)
"RTN","LA7VORUB",160,0)
 I LA7Y D
"RTN","LA7VORUB",161,0)
 . N I
"RTN","LA7VORUB",162,0)
 . F I=1,2,3 S LA7X(I+1)=$P(LA7Y,"^",I)
"RTN","LA7VORUB",163,0)
 . S LA7X(5)=$P($G(^LRO(68,$P(LA7Y,"^"),0)),"^")
"RTN","LA7VORUB",164,0)
 . S LA7X(6)=$P($G(^LRO(68,$P(LA7Y,"^"),0)),"^",11)
"RTN","LA7VORUB",165,0)
 S OBR(21)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
"RTN","LA7VORUB",166,0)
 K LA7X
"RTN","LA7VORUB",167,0)
 ;
"RTN","LA7VORUB",168,0)
 ; Date Report Completed/Report status/Responsible person
"RTN","LA7VORUB",169,0)
 ; Determine report date and status from 0 node.
"RTN","LA7VORUB",170,0)
 S LA7RSDT=$P(LA763(0),"^",3),(LA7PRI,LA7RS)=""
"RTN","LA7VORUB",171,0)
 ;
"RTN","LA7VORUB",172,0)
 ; If CYEMSP subscripts then check for corrected report
"RTN","LA7VORUB",173,0)
 I LA("SUB")?1(1"SP",1"CY",1"EM") D
"RTN","LA7VORUB",174,0)
 . S LA7RSDT=$P(LA763(0),"^",11),LA7PRI=$P(LA763(0),"^",2)
"RTN","LA7VORUB",175,0)
 . I LA7RSDT S LA7RS="F"
"RTN","LA7VORUB",176,0)
 . I $P(LA763(0),"^",15) S LA7RS="C"
"RTN","LA7VORUB",177,0)
 . I $G(LRSB)=1.2,$G(LA7SR) S LA7RSDT=+$G(^LR(LRDFN,LA("SUB"),LRIDT,LRSB,LA7SR,0),"^")
"RTN","LA7VORUB",178,0)
 ;
"RTN","LA7VORUB",179,0)
 ; If MI subscript then also check various sections and audit subfile for corrected report
"RTN","LA7VORUB",180,0)
 I LA("SUB")="MI" D
"RTN","LA7VORUB",181,0)
 . S LA7PRI=$P(LA763(0),"^",4)
"RTN","LA7VORUB",182,0)
 . S LA7X=$S(LRSB=11:1,LRSB=11.52:1,LRSB=11.6:1,LRSB=12:1,LRSB=14:5,LRSB=16:5,LRSB=18:8,LRSB=20:8,LRSB=22:11,LRSB=26:11,LRSB=24:11,LRSB=33:16,LRSB=36:16,1:0)
"RTN","LA7VORUB",183,0)
 . S LA7Y=$G(^LR(LRDFN,"MI",LRIDT,LA7X),"^")
"RTN","LA7VORUB",184,0)
 . I $P(LA7Y,"^") S LA7RSDT=$P(LA7Y,"^"),LA7RS=$P(LA7Y,"^",2),LA7PRI=$P(LA7Y,"^",$S(LA7X=11:5,1:3))
"RTN","LA7VORUB",185,0)
 . I $P(LA763(0),"^",9)=1 S LA7RS="C" Q
"RTN","LA7VORUB",186,0)
 . I '$D(^LR(LRDFN,"MI",LRIDT,32)) Q
"RTN","LA7VORUB",187,0)
 . S I=0
"RTN","LA7VORUB",188,0)
 . F  S I=$O(^LR(LRDFN,"MI",LRIDT,32,I)) Q:'I  I $P(^(I,0),"^",4)>1,LA7RS="F" S LA7RS="C" Q
"RTN","LA7VORUB",189,0)
 ;
"RTN","LA7VORUB",190,0)
 ; Also check for individual test status on "ORUT" node in file #63
"RTN","LA7VORUB",191,0)
 I $P(LA7NLT(63),"^",10) S LA7RS=$P(LA7NLT(63),"^",10)
"RTN","LA7VORUB",192,0)
 ;
"RTN","LA7VORUB",193,0)
 ; Date Report Completed
"RTN","LA7VORUB",194,0)
 I LA7RSDT S OBR(22)=$$OBR22^LA7VOBR(LA7RSDT)
"RTN","LA7VORUB",195,0)
 ;
"RTN","LA7VORUB",196,0)
 ; Diagnostic service id
"RTN","LA7VORUB",197,0)
 S OBR(24)=$$OBR24^LA7VOBR(LA("SUB")_"^"_$G(LRSB))
"RTN","LA7VORUB",198,0)
 ;
"RTN","LA7VORUB",199,0)
 ; Result status
"RTN","LA7VORUB",200,0)
 I LA7RS'="" S OBR(25)=$$OBR25^LA7VOBR(LA7RS)
"RTN","LA7VORUB",201,0)
 ;
"RTN","LA7VORUB",202,0)
 ; Parent Result and Parent
"RTN","LA7VORUB",203,0)
 I $D(LA7PARNT) D
"RTN","LA7VORUB",204,0)
 . S OBR(26)=$$OBR26^LA7VOBR(LA7PARNT(1),LA7PARNT(2),LA7PARNT(3),LA7FS,LA7ECH)
"RTN","LA7VORUB",205,0)
 . S OBR(29)=$$OBR29^LA7VOBR(LA("RUID"),LA("HUID"),LA7FS,LA7ECH)
"RTN","LA7VORUB",206,0)
 ;
"RTN","LA7VORUB",207,0)
 ; Principle result interpreter
"RTN","LA7VORUB",208,0)
 I LA("SUB")?1(1"CY",1"EM",1"MI",1"SP"),LA7PRI'="" S OBR(32)=$$OBR32^LA7VOBR(LA7PRI,LADFINST,LA7FS,LA7ECH)
"RTN","LA7VORUB",209,0)
 ;
"RTN","LA7VORUB",210,0)
 ; Assistant result interpreter
"RTN","LA7VORUB",211,0)
 I LA("SUB")?1(1"SP",1"EM"),$P(LA763(0),"^",4) S OBR(33)=$$OBR33^LA7VOBR($P(LA763(0),"^",4),LADFINST,LA7FS,LA7ECH)
"RTN","LA7VORUB",212,0)
 ;
"RTN","LA7VORUB",213,0)
 ; Technician
"RTN","LA7VORUB",214,0)
 I LA("SUB")?1(1"CY",1"EM"),$P(LA763(0),"^",4) S OBR(34)=$$OBR34^LA7VOBR($P(LA763(0),"^",4),LADFINST,LA7FS,LA7ECH)
"RTN","LA7VORUB",215,0)
 ;
"RTN","LA7VORUB",216,0)
 ; Typist - VistA stores as free text
"RTN","LA7VORUB",217,0)
 I LA("SUB")?1(1"SP",1"CY",1"EM"),$P(LA763(0),"^",9)'="" S OBR(35)=$$OBR35^LA7VOBR($P(LA763(0),"^",9),LADFINST,LA7FS,LA7ECH)
"RTN","LA7VORUB",218,0)
 ;
"RTN","LA7VORUB",219,0)
 ; Procedure code - use Order NLT code
"RTN","LA7VORUB",220,0)
 S OBR(44)=$$OBR44^LA7VOBR(LA7NLT,LA7FS,LA7ECH)
"RTN","LA7VORUB",221,0)
 ;
"RTN","LA7VORUB",222,0)
 D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
"RTN","LA7VORUB",223,0)
 D FILESEG^LA7VHLU(GBL,.LA7DATA)
"RTN","LA7VORUB",224,0)
 ;
"RTN","LA7VORUB",225,0)
 ; Check for flag to only build message but do not file
"RTN","LA7VORUB",226,0)
 I '$G(LA7NOMSG) D
"RTN","LA7VORUB",227,0)
 . D FILE6249^LA7VHLU(LA76249,.LA7DATA)
"RTN","LA7VORUB",228,0)
 . I LA("HUID")'="" D
"RTN","LA7VORUB",229,0)
 . . D SETID^LA7VHLU1(LA76249,LA7ID,LA("HUID"),0)
"RTN","LA7VORUB",230,0)
 . . D SETID^LA7VHLU1(LA76249,"",LA("HUID"),0)
"RTN","LA7VORUB",231,0)
 . I LA("RUID")'="" D
"RTN","LA7VORUB",232,0)
 . . D SETID^LA7VHLU1(LA76249,LA7ID,LA("RUID"),0)
"RTN","LA7VORUB",233,0)
 . . D SETID^LA7VHLU1(LA76249,"",LA("RUID"),0)
"RTN","LA7VORUB",234,0)
 ;
"RTN","LA7VORUB",235,0)
 Q
"RTN","LA80")
0^5^B5891361
"RTN","LA80",1,0)
LA80 ;DALOI/STAFF - LA*5.2*80 KIDS ROUTINE ;3/25/13  11:02
"RTN","LA80",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**80**;Sep 27, 1994;Build 19
"RTN","LA80",3,0)
 ;
"RTN","LA80",4,0)
 Q
"RTN","LA80",5,0)
POST ;
"RTN","LA80",6,0)
 ; KIDS Post install for LA*5.2*80
"RTN","LA80",7,0)
 D REMOVE,ADD1,ADD2
"RTN","LA80",8,0)
 Q
"RTN","LA80",9,0)
 ;
"RTN","LA80",10,0)
REMOVE ;
"RTN","LA80",11,0)
 ; Remove LOINC code 22638-1 from the SP Comment concept.
"RTN","LA80",12,0)
 N LRCNPTNM,LRLNC
"RTN","LA80",13,0)
 S LRCNPTNM="SP COMMENT",LRLNC="22638-1"
"RTN","LA80",14,0)
 D REMLNC(LRCNPTNM,LRLNC)
"RTN","LA80",15,0)
 Q
"RTN","LA80",16,0)
 ;
"RTN","LA80",17,0)
REMLNC(LRCNPTNM,LRLNC) ;
"RTN","LA80",18,0)
 ; Remove LOINC code from concept.
"RTN","LA80",19,0)
 N LRCNCPT,LRID
"RTN","LA80",20,0)
 S LRCNCPT=$O(^LAB(62.47,"B",LRCNPTNM,0))
"RTN","LA80",21,0)
 I +LRCNCPT D
"RTN","LA80",22,0)
 .S LRID=$O(^LAB(62.47,LRCNCPT,1,"B",LRLNC,0))
"RTN","LA80",23,0)
 .I +LRID D REMSENT(+LRCNCPT,+LRID,LRLNC)
"RTN","LA80",24,0)
 Q
"RTN","LA80",25,0)
 ;
"RTN","LA80",26,0)
REMSENT(LRCNCPT,LRID,LRLNC) ;
"RTN","LA80",27,0)
 ; Remove Sub-file Entry.
"RTN","LA80",28,0)
 N DA,DIK
"RTN","LA80",29,0)
 S DA(1)=LRCNCPT
"RTN","LA80",30,0)
 S DA=LRID
"RTN","LA80",31,0)
 S DIK="^LAB(62.47,"_DA(1)_",1,"
"RTN","LA80",32,0)
 L +^LAB(62.47,DA(1)):$G(DILOCKTM,5)
"RTN","LA80",33,0)
 I $T D  Q
"RTN","LA80",34,0)
 .D ^DIK
"RTN","LA80",35,0)
 .L -^LAB(62.47,DA(1))
"RTN","LA80",36,0)
 D BMES("*** Unable to obtain lock for ^LAB(62.47,"_DA(1)_") to remove LOINC code "_LRLNC_" ***")
"RTN","LA80",37,0)
 Q
"RTN","LA80",38,0)
 ;
"RTN","LA80",39,0)
ADD1 ;
"RTN","LA80",40,0)
 ; Add LOINC code 24419-4 to CY Gross Description, and EM Gross
"RTN","LA80",41,0)
 ; Description concepts.
"RTN","LA80",42,0)
 N DIC,X,Y
"RTN","LA80",43,0)
 S DIC="^LAB(62.47,",DIC(0)="X"
"RTN","LA80",44,0)
 F X="CY","EM" D
"RTN","LA80",45,0)
 .S X=X_" GROSS DESCRIPTION"
"RTN","LA80",46,0)
 .D ^DIC
"RTN","LA80",47,0)
 .Q:Y=-1
"RTN","LA80",48,0)
 .D ADDLNC(+Y,"24419-4")
"RTN","LA80",49,0)
 Q
"RTN","LA80",50,0)
 ;
"RTN","LA80",51,0)
ADD2 ;
"RTN","LA80",52,0)
 ; Add LOINC code 22638-1 to SP Gross Description, CY Gross
"RTN","LA80",53,0)
 ; Description, and EM Gross Description concepts.
"RTN","LA80",54,0)
 N DIC,X,Y
"RTN","LA80",55,0)
 S DIC="^LAB(62.47,",DIC(0)="X"
"RTN","LA80",56,0)
 F X="SP","CY","EM" D
"RTN","LA80",57,0)
 .S X=X_" GROSS DESCRIPTION"
"RTN","LA80",58,0)
 .D ^DIC
"RTN","LA80",59,0)
 .Q:Y=-1
"RTN","LA80",60,0)
 .D ADDLNC(+Y,"22638-1")
"RTN","LA80",61,0)
 Q
"RTN","LA80",62,0)
 ;
"RTN","LA80",63,0)
ADDLNC(LRCNCPT,LRLNC) ;
"RTN","LA80",64,0)
 ; Add LOINC code to concept
"RTN","LA80",65,0)
 N DA,DIC,X,Y,LRFPRIV,DIE,DR
"RTN","LA80",66,0)
 S DA(1)=LRCNCPT,DIC="^LAB(62.47,"_DA(1)_",1,",DIC(0)="L"
"RTN","LA80",67,0)
 S X=LRLNC
"RTN","LA80",68,0)
 L +^LAB(62.47,DA(1)):$G(DILOCKTM,5)
"RTN","LA80",69,0)
 I '$T D  Q
"RTN","LA80",70,0)
 .D BMES("*** Unable to obtain lock for ^LAB(62.47,"_DA(1)_") to add LOINC code "_LRLNC_" ***")
"RTN","LA80",71,0)
 D ^DIC
"RTN","LA80",72,0)
 I Y=-1 D  Q
"RTN","LA80",73,0)
 .L -^LAB(62.47,DA(1))
"RTN","LA80",74,0)
 ;
"RTN","LA80",75,0)
 S LRFPRIV=1,DIE=DIC   ;LRFPRIV is needed for editing #.05
"RTN","LA80",76,0)
 K DIC
"RTN","LA80",77,0)
 S DA(1)=LRCNCPT,DA=+Y,DR=".02///LN;.03///1;.05///1"
"RTN","LA80",78,0)
 D ^DIE
"RTN","LA80",79,0)
 L -^LAB(62.47,DA(1))
"RTN","LA80",80,0)
 Q
"RTN","LA80",81,0)
 ;
"RTN","LA80",82,0)
BMES(STR) ;
"RTN","LA80",83,0)
 ; Write string
"RTN","LA80",84,0)
 D BMES^XPDUTL($$TRIM^XLFSTR($$CJ^XLFSTR(STR,$G(IOM,80)),"R"," "))
"RTN","LA80",85,0)
 Q
"RTN","LAMIAUT4")
0^2^B18820439
"RTN","LAMIAUT4",1,0)
LAMIAUT4 ;SLC/FHS - EDIT OR VERIFY MICRO AUTO INSTRUMENTS ;05/02/13
"RTN","LAMIAUT4",2,0)
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**153,80**;Sep 27, 1994;Build 19
"RTN","LAMIAUT4",3,0)
EN ;
"RTN","LAMIAUT4",4,0)
 Q:LREND  R !!," ('E'dit data, 'C'omments, 'O'rganism 'W'orklist) // ",LREDIT:DTIME Q:'$T
"RTN","LAMIAUT4",5,0)
 I $E(LREDIT)="?" D HLP,^LAMIAUT3 G EN
"RTN","LAMIAUT4",6,0)
 I $E(LREDIT)="^"!($E(LREDIT="@")) D DEL^LAMIAUT5 K LRBDUP,LRMOVE Q
"RTN","LAMIAUT4",7,0)
 K DIC,DR,DIE,DA S DA=LRIDT,DA(1)=LRDFN,LRY(0)=^LR(LRDFN,"MI",LRIDT,0),DIE="^LR("_DA(1)_",""MI"",",DIC=DIE I $E(LREDIT)="E" S ZX9=X9 D EDIT,^LAMIAUT3 S X9=ZX9 K ZX9 G EN
"RTN","LAMIAUT4",8,0)
 I $E(LREDIT)="O" S ZX9=X9 D ^LRMIBUG,^LAMIAUT3 S X9=ZX9 K ZX9 G EN
"RTN","LAMIAUT4",9,0)
 I $E(LREDIT)="C" K DR S DR=".99;1;13" D ^DIE D ^LAMIAUT3 G EN
"RTN","LAMIAUT4",10,0)
 I $E(LREDIT)="W" D EN^LRCAPV D ^LAMIAUT3 G EN
"RTN","LAMIAUT4",11,0)
 R !,"Approve for release by entering your initials: ",X:DTIME I '$T!($E(X)="^") D DEL^LAMIAUT5 Q
"RTN","LAMIAUT4",12,0)
 I X'=LRINI W !!,$C(7)," NOT APPROVED " Q
"RTN","LAMIAUT4",13,0)
 D VER Q
"RTN","LAMIAUT4",14,0)
EXP ;Get the list of tests for this ACC.
"RTN","LAMIAUT4",15,0)
 W !!,PNM,"   ",SSN,!,LRACCN D INF^LRX W !!?5,$P(^LAB(61,LRSPEC,0),U),"  ",$P(^LAB(62,LRSAMP,0),U),!
"RTN","LAMIAUT4",16,0)
 K ^TMP("LR",$J),LRTEST,LRNAME,LRTS S N=0 F I=0:0 S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1  S N=N+1,LRTEST(N)=+^(I,0),LRTEST(N,"P")=$P(^(0),U,9)
"RTN","LAMIAUT4",17,0)
 S LRNTN=N F I=1:1:N S:$D(^LAB(60,+LRTEST(I),0)) LRTEST(I)=LRTEST(I)_U_^(0),LRNAME(I)=$P(LRTEST(I),U,2),LRNAME(I,+LRTEST(I))="",LRTS(I)=LRNAME(I),LRTS(I,+LRTEST(I))=""
"RTN","LAMIAUT4",18,0)
 S LRALL="" F I=1:1:LRNTN I $D(LRNAME(I)) S LRALL=LRALL_","_I W !,I,"  ",LRNAME(I) I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,+$O(LRNAME(I,0)),0)),$P(^(0),U,5) W ?25," verified"
"RTN","LAMIAUT4",19,0)
V9 S LRALL=$P(LRALL,",",2,99) R !!,"TEST #(s) (or ""ALL""): ",X:DTIME S:'$T X=U S:X="" X=LRALL S:X["A" X=LRALL S:$E(X)="^" LREND=1 Q:LREND
"RTN","LAMIAUT4",20,0)
 I X["?" W !,"Enter for example 1,2,5-9." G V9
"RTN","LAMIAUT4",21,0)
 Q:$E(X)="^"  D RANGE^LRWU2 Q:X9=""  X (X9_"S:'$D(LRNAME(T1)) X=0") I X=0 W !!?7,"Incorrect test number ",$C(7) G EXP
"RTN","LAMIAUT4",22,0)
L10 S LRNX=0 X (X9_"D EX1^LRVER1")
"RTN","LAMIAUT4",23,0)
 Q
"RTN","LAMIAUT4",24,0)
EDIT S LRALL="" W !?7,"Edit ? ",! F I=0:0 S I=$O(LRNAME(I)) Q:I=""  W !?3,"(",I,")  ",LRNAME(I) S LRALL=LRALL_","_I I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0)),$P(^(0),U,5) W ?25,"Verified "
"RTN","LAMIAUT4",25,0)
 S LRALL=$P(LRALL,",",2,99) R !!,"TEST #(s) (or ""ALL""): ",X:DTIME Q:'$T!($E(X)="^")  S:X["A" X=LRALL S:X="" X=LRALL
"RTN","LAMIAUT4",26,0)
 I X["?" W !?7,"Enter for example 1,2,5-9 ",! G EDIT
"RTN","LAMIAUT4",27,0)
 D RANGE^LRWU2 Q:X9=""  X (X9_"S:'$D(LRNAME(T1)) X=0") I X=0 W !!?7,"Incorrect number ",$C(7),! G EDIT
"RTN","LAMIAUT4",28,0)
 X (X9_"S LRTS=+$O(LRTS(T1,0)) I LRTS D EDIT1^LAMIAUT4")
"RTN","LAMIAUT4",29,0)
 Q
"RTN","LAMIAUT4",30,0)
EDIT1 S LRSB=1,LRCODE=$P(^LAB(60,+$O(LRNAME(T1,0)),0),U,14) D EDIT2
"RTN","LAMIAUT4",31,0)
 Q
"RTN","LAMIAUT4",32,0)
EDIT2 I 'LRCODE W $C(7),!?7,"NO EDIT CODE FOR ",LRNAME(T1) Q
"RTN","LAMIAUT4",33,0)
 I '$D(^LAB(62.07,LRCODE,.1)) W $C(7),!?7,"EDIT CODE IS MISSING FOR ",LRNAME(T1) Q
"RTN","LAMIAUT4",34,0)
 N LRBG0
"RTN","LAMIAUT4",35,0)
 W !!?7,"Editing ",LRNAME(T1),!! K DR S LRTS=+$O(LRTS(T1,0)),(LRBG0,Y(0))=LRY(0) X:LRTS ^LAB(62.07,LRCODE,.1)
"RTN","LAMIAUT4",36,0)
 I 'LRTS W !,"NO TEST DEFINED ",!!,$C(7)
"RTN","LAMIAUT4",37,0)
 Q
"RTN","LAMIAUT4",38,0)
VER ;
"RTN","LAMIAUT4",39,0)
 N LRBG0
"RTN","LAMIAUT4",40,0)
 Q:X9=""  S (LRBG0,Y(0))=^LR(LRDFN,"MI",LRIDT,0),LRCAPOK=1,LRUNDO=0 I '$P(Y(0),U,3) S:$P(Y(0),U,9) LRUNDO=1 G VER1
"RTN","LAMIAUT4",41,0)
 I $P(^LR(LRDFN,"MI",LRIDT,0),U,3) W !,"Final report has been verified by micro  supervisor,",$C(7),!,"If you proceed in editing, the report will be reprinted"
"RTN","LAMIAUT4",42,0)
 F I=0:0 W !?10,"OK" S %=1 D YN^DICN Q:%  W !," Enter  'Y' or 'N' : "
"RTN","LAMIAUT4",43,0)
 I %=2!(%<0) Q
"RTN","LAMIAUT4",44,0)
VER1 ;
"RTN","LAMIAUT4",45,0)
 D:'$P(^LAB(69.9,1,"NITE"),U) ANN^LRCAPV
"RTN","LAMIAUT4",46,0)
 ;N LRADD,GLB,LRBUG,LRBUGY
"RTN","LAMIAUT4",47,0)
 S LRSB=1 W ! X (X9_"S LRPTP=$O(LRNAME(T1,0))") S LRCAPOK=1,Y(0)=^LR(LRDFN,"MI",LRIDT,0) D
"RTN","LAMIAUT4",48,0)
 . K DR S DR=11,LRSAME=0 D:LRUNDO UNDO^LRMIEDZ D ^DIE,TIME^LRMIEDZ3 S LRTS=LRPTP I $G(LRTS) D:LRCAPOK&($P(LRPARAM,U,14)) LOOK^LRCAPV1
"RTN","LAMIAUT4",49,0)
 N LRWRDVEW,LRUID
"RTN","LAMIAUT4",50,0)
 S LRWRDVEW=1
"RTN","LAMIAUT4",51,0)
 D VT^LRMIUT1 I $L($G(LRVT)) D STF^LRMIUT
"RTN","LAMIAUT4",52,0)
 ;
"RTN","LAMIAUT4",53,0)
 ;Ask for performing lab assignment
"RTN","LAMIAUT4",54,0)
 D EDIT^LRRPLU(LRDFN,LRSS,LRIDT)
"RTN","LAMIAUT4",55,0)
 ;
"RTN","LAMIAUT4",56,0)
 ;call clinical reminders
"RTN","LAMIAUT4",57,0)
 D UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
"RTN","LAMIAUT4",58,0)
 ;
"RTN","LAMIAUT4",59,0)
 ;Ask to send CPRS alert
"RTN","LAMIAUT4",60,0)
 S LRUID=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^")
"RTN","LAMIAUT4",61,0)
 D ASKXQA^LRMIEDZ2
"RTN","LAMIAUT4",62,0)
 S ^LRO(68,"AVS",LRAA,LRAD,LRAN)=LRDFN_U_LRIDT
"RTN","LAMIAUT4",63,0)
 ;Cleanup entry in LAH.
"RTN","LAMIAUT4",64,0)
 D ZAPALL^LRVR3(LRLL,LRIFN)
"RTN","LAMIAUT4",65,0)
 Q
"RTN","LAMIAUT4",66,0)
HLP W !!?10,"ENTER",?20,"'E' TO EDIT ENTIRE ACCESSION. ",!?20,"'C' TO EDIT COMMENT",!?20,"'O' TO EDIT ORGANISM "
"RTN","LAMIAUT4",67,0)
 W !?20,"'^' OR '@' WILL DELETE TRANSFERRED DATA ",! H 2 Q
"UP",62.47,62.4701,-1)
62.47^1
"UP",62.47,62.4701,0)
62.4701
"UP",62.48,62.482,-1)
62.48^SCT
"UP",62.48,62.482,0)
62.482
"VER")
8.0^22.0
"^DD",62.47,62.47,.001,0)
SEQUENCE^NJ4,0X^^ ^K:+X'=X!(X>9999)!(X<1)!(X?.E1"."1.N) X K:($G(DIUTIL)'="VERIFY FIELDS"&'$G(LRFPRIV)) X
"^DD",62.47,62.47,.001,3)
Type a number between 1 and 9999, 0 Decimal Digits.
"^DD",62.47,62.47,.001,21,0)
^.001^1^1^3121023^^
"^DD",62.47,62.47,.001,21,1,0)
Sequence number (IEN).
"^DD",62.47,62.47,.001,"DT")
3121024
"^DD",62.47,62.47,.01,0)
CONCEPT^RF^^0;1^K:$L(X)>45!($L(X)<3)!'(X'?1P.E) X
"^DD",62.47,62.47,.01,1,0)
^.1
"^DD",62.47,62.47,.01,1,1,0)
62.47^B
"^DD",62.47,62.47,.01,1,1,1)
S ^LAB(62.47,"B",$E(X,1,30),DA)=""
"^DD",62.47,62.47,.01,1,1,2)
K ^LAB(62.47,"B",$E(X,1,30),DA)
"^DD",62.47,62.47,.01,3)
Answer must be 3-45 characters in length.
"^DD",62.47,62.47,.01,21,0)
^.001^3^3^3121023^^
"^DD",62.47,62.47,.01,21,1,0)
Indicates the nature of the codes and what area of the laboratory
"^DD",62.47,62.47,.01,21,2,0)
the concept relates.
"^DD",62.47,62.47,.01,21,3,0)

"^DD",62.47,62.47,.01,"DT")
3121024
"^DD",62.47,62.47,.04,0)
ALTERNATE CONCEPT^P62.47'^LAB(62.47,^0;4^Q
"^DD",62.47,62.47,.04,3)
Select the alternate concept related to this concept.
"^DD",62.47,62.47,.04,21,0)
^^9^9^3121023^
"^DD",62.47,62.47,.04,21,1,0)
Used to designate an alternate concept when the answer associated
"^DD",62.47,62.47,.04,21,2,0)
with this concept is not in a form that can be stored within the
"^DD",62.47,62.47,.04,21,3,0)
current VistA database.
"^DD",62.47,62.47,.04,21,4,0)
 
"^DD",62.47,62.47,.04,21,5,0)
Example is when VistA expects to store the answer as a pointer
"^DD",62.47,62.47,.04,21,6,0)
to a VistA file and the instance of an answer is free text.
"^DD",62.47,62.47,.04,21,7,0)
 
"^DD",62.47,62.47,.04,21,8,0)
This field will point to a concept that will allow the answer to
"^DD",62.47,62.47,.04,21,9,0)
be stored in a field which can accept the answer.
"^DD",62.47,62.47,.04,"DT")
3121024
"^DD",62.47,62.47,1,0)
IDENTIFIER^62.4701I^^1;0
"^DD",62.47,62.47,1,21,0)
^.001^2^2^3121023^^
"^DD",62.47,62.47,1,21,1,0)
The Identifier contains the codes/codesets that are associated 
"^DD",62.47,62.47,1,21,2,0)
with this Concept.
"^DD",62.47,62.47,1,"DT")
3060206
"^DD",62.47,62.4701,0)
IDENTIFIER SUB-FIELD^^2.2^7
"^DD",62.47,62.4701,0,"NM","IDENTIFIER")

"^DD",62.47,62.4701,.01,0)
IDENTIFIER^MFX^^0;1^K:$L(X)>30!($L(X)<1) X D:$G(X)]"" CODSETOK^LA7VLCM3(DA(1),$G(DA),X,,1)
"^DD",62.47,62.4701,.01,1,0)
^.1^^-1
"^DD",62.47,62.4701,.01,1,1,0)
62.4701^B
"^DD",62.47,62.4701,.01,1,1,1)
S ^LAB(62.47,DA(1),1,"B",$E(X,1,30),DA)=""
"^DD",62.47,62.4701,.01,1,1,2)
K ^LAB(62.47,DA(1),1,"B",$E(X,1,30),DA)
"^DD",62.47,62.4701,.01,3)
Answer must be 1-30 characters in length.
"^DD",62.47,62.4701,.01,21,0)
^^3^3^3121023^
"^DD",62.47,62.4701,.01,21,1,0)
This is the code or id associated with an instance of this concept.
"^DD",62.47,62.4701,.01,21,2,0)
The identifier in conjunction with CODING SYSTEM field (#.02) 
"^DD",62.47,62.4701,.01,21,3,0)
indicates its use and source.
"^DD",62.47,62.4701,.01,"DT")
3121024
"^DD",62.47,62.4701,.02,0)
CODING SYSTEM^RFX^^0;2^D ITP02^LA7XREF
"^DD",62.47,62.4701,.02,1,0)
^.1
"^DD",62.47,62.4701,.02,1,1,0)
62.4701^C
"^DD",62.47,62.4701,.02,1,1,1)
S ^LAB(62.47,DA(1),1,"C",$E(X,1,30),DA)=""
"^DD",62.47,62.4701,.02,1,1,2)
K ^LAB(62.47,DA(1),1,"C",$E(X,1,30),DA)
"^DD",62.47,62.4701,.02,1,1,"DT")
3060616
"^DD",62.47,62.4701,.02,3)
Answer 1-15 characters, Uppercase (e.g., LN, SCT, L, 99*).
"^DD",62.47,62.4701,.02,21,0)
^.001^3^3^3121023^^^
"^DD",62.47,62.4701,.02,21,1,0)
Identifies the name of the coding system which this code is derived
"^DD",62.47,62.4701,.02,21,2,0)
from.
"^DD",62.47,62.4701,.02,21,3,0)

"^DD",62.47,62.4701,.02,23,0)
^.001^1^1^3121023^^^
"^DD",62.47,62.4701,.02,23,1,0)

"^DD",62.47,62.4701,.02,"DT")
3121024
"^DD",62.47,62.4701,.05,0)
NATIONAL STANDARD^*SX^0:NO;1:YES;^0;5^Q
"^DD",62.47,62.4701,.05,1,0)
^.1
"^DD",62.47,62.4701,.05,1,1,0)
62.4701^AC
"^DD",62.47,62.4701,.05,1,1,1)
S ^LAB(62.47,DA(1),1,"AC",$E(X,1,30),DA)=""
"^DD",62.47,62.4701,.05,1,1,2)
K ^LAB(62.47,DA(1),1,"AC",$E(X,1,30),DA)
"^DD",62.47,62.4701,.05,1,1,"DT")
3060616
"^DD",62.47,62.4701,.05,3)
Is this entry nationally released code?
"^DD",62.47,62.4701,.05,12)
Do not allow local entries to be flagged as national.
"^DD",62.47,62.4701,.05,12.1)
S DIC("S")="I ($G(DIUTIL)=""VERIFY FIELDS"")!$G(LRFPRIV)!('$G(LRFPRIV)&Y=0)"
"^DD",62.47,62.4701,.05,21,0)
^^2^2^3121023^
"^DD",62.47,62.4701,.05,21,1,0)
This field indicates whether this entry was distributed nationwide. If
"^DD",62.47,62.4701,.05,21,2,0)
not, then it was entered locally.
"^DD",62.47,62.4701,.05,"DT")
3121024
"^DD",62.47,62.4701,2.1,0)
RELATED ENTRY^V^^2;1^
"^DD",62.47,62.4701,2.1,1,0)
^.1
"^DD",62.47,62.4701,2.1,1,1,0)
62.47^AE
"^DD",62.47,62.4701,2.1,1,1,1)
S ^LAB(62.47,"AE",$E(X,1,30),DA(1),DA)=""
"^DD",62.47,62.4701,2.1,1,1,2)
K ^LAB(62.47,"AE",$E(X,1,30),DA(1),DA)
"^DD",62.47,62.4701,2.1,1,1,"%D",0)
^^4^4^3060426^
"^DD",62.47,62.4701,2.1,1,1,"%D",1,0)
LAB(62.47,"AE",Pointed-To File,DA(1),DA)
"^DD",62.47,62.4701,2.1,1,1,"%D",2,0)
 
"^DD",62.47,62.4701,2.1,1,1,"%D",3,0)
Identify entries in the pointed-to files that are mapped to #62.47
"^DD",62.47,62.4701,2.1,1,1,"%D",4,0)
entries.
"^DD",62.47,62.4701,2.1,1,1,"DT")
3060426
"^DD",62.47,62.4701,2.1,3)
Select the related entry to link this code/codeset to.
"^DD",62.47,62.4701,2.1,21,0)
^.001^3^3^3121023^^
"^DD",62.47,62.4701,2.1,21,1,0)
Links this code/codeset to an entry in one of the pointed-to files.  This 
"^DD",62.47,62.4701,2.1,21,2,0)
allows the system to determine how to translate a code/codeset to a file 
"^DD",62.47,62.4701,2.1,21,3,0)
entry.
"^DD",62.47,62.4701,2.1,"DT")
3121024
"^DD",62.47,62.4701,2.1,"V",0)
^.12P^^2
"^DD",62.47,62.4701,2.1,"V",1,0)
61.2^Select ETIOLOGY^1^ET^n^n
"^DD",62.47,62.4701,2.1,"V",2,0)
62.06^Select ANTIBIOTIC^2^AB^n^n
"^DD",62.47,62.4701,2.2,0)
MESSAGE CONFIGURATION^P62.48'^LAHM(62.48,^2;2^Q
"^DD",62.47,62.4701,2.2,1,0)
^.1
"^DD",62.47,62.4701,2.2,1,1,0)
62.47^AG
"^DD",62.47,62.4701,2.2,1,1,1)
S ^LAB(62.47,"AG",$E(X,1,30),DA(1),DA)=""
"^DD",62.47,62.4701,2.2,1,1,2)
K ^LAB(62.47,"AG",$E(X,1,30),DA(1),DA)
"^DD",62.47,62.4701,2.2,1,1,"%D",0)
^^1^1^3060912^
"^DD",62.47,62.4701,2.2,1,1,"%D",1,0)
^LAB(62.47,"AG",R6248,R6247,R624701)=""
"^DD",62.47,62.4701,2.2,1,1,"DT")
3060912
"^DD",62.47,62.4701,2.2,3)
For local codes, select the interface this code is associated with.
"^DD",62.47,62.4701,2.2,21,0)
^.001^4^4^3121023^^^^
"^DD",62.47,62.4701,2.2,21,1,0)
When the related identifier (code) is from a local coding system
"^DD",62.47,62.4701,2.2,21,2,0)
then this field indicates for which specific interface the code
"^DD",62.47,62.4701,2.2,21,3,0)
is associated with. Local codes are interface specific.
"^DD",62.47,62.4701,2.2,21,4,0)

"^DD",62.47,62.4701,2.2,"DT")
3121024
"^DD",62.48,62.48,30,0)
NON-VA ORDER SNOMED CODES^62.482IV^^SCT;0
"^DD",62.48,62.48,30,21,0)
^.001^3^3^3121026^^^^
"^DD",62.48,62.48,30,21,1,0)
Allows mapping a SNOMED CT code to specimen (topography) and/or collection
"^DD",62.48,62.48,30,21,2,0)
sample which an external system requires and which is different from the
"^DD",62.48,62.48,30,21,3,0)
SNOMED CT code assigned to the concept by the Dept of Veterans Affairs.
"^DD",62.48,62.48,30,23,0)
^.001^2^2^3121026^^^
"^DD",62.48,62.48,30,23,1,0)
This field uses a combination of an Output Transform and a "WRITE
"^DD",62.48,62.48,30,23,2,0)
ID" node in the DD to display the file that the particular entry is from.
"^DD",62.48,62.482,0)
NON-VA ORDER SNOMED CODES SUB-FIELD^^.001^3
"^DD",62.48,62.482,0,"DT")
3121026
"^DD",62.48,62.482,0,"ID","LA")
D EN^DDIOL("  "_$$ID62482^LA7XREF(),"","$C(32)")
"^DD",62.48,62.482,0,"IX","B",62.482,.01)

"^DD",62.48,62.482,0,"NM","NON-VA ORDER SNOMED CODES")

"^DD",62.48,62.482,0,"UP")
62.48
"^DD",62.48,62.482,.001,0)
SEQUENCE^NJ12,0^^ ^K:+X'=X!(X>999999999999)!(X<1)!(X?.E1"."1N.N) X
"^DD",62.48,62.482,.001,3)
Type a Number between 1 and 999999999999, 0 Decimal Digits.
"^DD",62.48,62.482,.001,21,0)
^^1^1^3070803^
"^DD",62.48,62.482,.001,21,1,0)
Sequence (IEN) number.
"^DD",62.48,62.482,.001,"DT")
3121026
"^DD",62.48,62.482,.01,0)
VA FILE ENTRY^MVO^^0;1^
"^DD",62.48,62.482,.01,1,0)
^.1
"^DD",62.48,62.482,.01,1,1,0)
62.482^B
"^DD",62.48,62.482,.01,1,1,1)
S ^LAHM(62.48,DA(1),"SCT","B",$E(X,1,30),DA)=""
"^DD",62.48,62.482,.01,1,1,2)
K ^LAHM(62.48,DA(1),"SCT","B",$E(X,1,30),DA)
"^DD",62.48,62.482,.01,1,1,3)
Required for Variable Pointer
"^DD",62.48,62.482,.01,2)
S Y(0)=Y S Y=$$OT62482^LA7XREF(Y)
"^DD",62.48,62.482,.01,2.1)
S Y=$$OT62482^LA7XREF(Y)
"^DD",62.48,62.482,.01,3)
Select specimen or collection sample.
"^DD",62.48,62.482,.01,21,0)
^.001^1^1^3121026^^
"^DD",62.48,62.482,.01,21,1,0)
The file entry to map to a different code/codeset.
"^DD",62.48,62.482,.01,"DT")
3121026
"^DD",62.48,62.482,.01,"V",0)
^.12P^^2
"^DD",62.48,62.482,.01,"V",1,0)
61^Specimen from TOPOGRAPHY file^1^SP^n^n
"^DD",62.48,62.482,.01,"V",2,0)
62^Sample from COLLECTION SAMPLE^2^CS^n^n
"^DD",62.48,62.482,.02,0)
SNOMED CT ID^NJ10,0X^^0;2^N LROUT K:'$$SCTOK^LRSCT(X,,.LROUT) X D:$D(X)&('$$ISQUIET^LRXREF()) EN^DDIOL($G(LROUT("F")),"","$C(32)")
"^DD",62.48,62.482,.02,3)
Enter a valid SNOMED CT Code.
"^DD",62.48,62.482,.02,21,0)
^^1^1^3061218^
"^DD",62.48,62.482,.02,21,1,0)
This is the SNOMED CT code for this entry.
"^DD",62.48,62.482,.02,"DT")
3121026
**END**
**END**