KIDS Distribution saved on Sep 06, 2016@10:20:34
REMOTE HUB KIDS BUILD
**KIDS**:ZZTEST 1.0^

**INSTALL NAME**
ZZTEST 1.0
"BLD",19,0)
ZZTEST 1.0^MOBILE SCHEDULING APPLICATIONS^0^3160906^y
"BLD",19,1,0)
^^1^1^3160906^
"BLD",19,1,1,0)
Remote ordering Hub
"BLD",19,4,0)
^9.64PA^^
"BLD",19,6.3)
19
"BLD",19,"INID")
^n
"BLD",19,"INIT")

"BLD",19,"KRN",0)
^9.67PA^779.2^20
"BLD",19,"KRN",.4,0)
.4
"BLD",19,"KRN",.401,0)
.401
"BLD",19,"KRN",.402,0)
.402
"BLD",19,"KRN",.403,0)
.403
"BLD",19,"KRN",.5,0)
.5
"BLD",19,"KRN",.84,0)
.84
"BLD",19,"KRN",3.6,0)
3.6
"BLD",19,"KRN",3.8,0)
3.8
"BLD",19,"KRN",9.2,0)
9.2
"BLD",19,"KRN",9.8,0)
9.8
"BLD",19,"KRN",9.8,"NM",0)
^9.68A^13^13
"BLD",19,"KRN",9.8,"NM",1,0)
LRHBIN^^0^B50512844
"BLD",19,"KRN",9.8,"NM",2,0)
LRHBIN1^^0^B74937979
"BLD",19,"KRN",9.8,"NM",3,0)
LRHBIN2^^0^B261445475
"BLD",19,"KRN",9.8,"NM",4,0)
LRHBIN3^^0^B46092527
"BLD",19,"KRN",9.8,"NM",5,0)
LRHBIN4^^0^B55889278
"BLD",19,"KRN",9.8,"NM",6,0)
LRHBIN5^^0^B60470966
"BLD",19,"KRN",9.8,"NM",7,0)
LRHBIN6^^0^B111317764
"BLD",19,"KRN",9.8,"NM",8,0)
LRHBIN7^^0^B289743250
"BLD",19,"KRN",9.8,"NM",9,0)
LRHBR1^^0^B117641163
"BLD",19,"KRN",9.8,"NM",10,0)
RAHBIN^^0^B14288552
"BLD",19,"KRN",9.8,"NM",11,0)
LRHBR2^^0^B169207416
"BLD",19,"KRN",9.8,"NM",12,0)
RAHBIN2^^0^B97217147
"BLD",19,"KRN",9.8,"NM",13,0)
RAHBIN3^^0^B207308557
"BLD",19,"KRN",9.8,"NM","B","LRHBIN",1)

"BLD",19,"KRN",9.8,"NM","B","LRHBIN1",2)

"BLD",19,"KRN",9.8,"NM","B","LRHBIN2",3)

"BLD",19,"KRN",9.8,"NM","B","LRHBIN3",4)

"BLD",19,"KRN",9.8,"NM","B","LRHBIN4",5)

"BLD",19,"KRN",9.8,"NM","B","LRHBIN5",6)

"BLD",19,"KRN",9.8,"NM","B","LRHBIN6",7)

"BLD",19,"KRN",9.8,"NM","B","LRHBIN7",8)

"BLD",19,"KRN",9.8,"NM","B","LRHBR1",9)

"BLD",19,"KRN",9.8,"NM","B","LRHBR2",11)

"BLD",19,"KRN",9.8,"NM","B","RAHBIN",10)

"BLD",19,"KRN",9.8,"NM","B","RAHBIN2",12)

"BLD",19,"KRN",9.8,"NM","B","RAHBIN3",13)

"BLD",19,"KRN",19,0)
19
"BLD",19,"KRN",19,"NM",0)
^9.68A^^0
"BLD",19,"KRN",19.1,0)
19.1
"BLD",19,"KRN",101,0)
101
"BLD",19,"KRN",101,"NM",0)
^9.68A^20^20
"BLD",19,"KRN",101,"NM",1,0)
LA7V 565 ORM-O01 EVENT^^0
"BLD",19,"KRN",101,"NM",2,0)
LA7V 565 ORM-O01 SUBS^^0
"BLD",19,"KRN",101,"NM",3,0)
LA7V 659 ORM-O01 EVENT^^0
"BLD",19,"KRN",101,"NM",4,0)
LA7V 659 ORM-O01 SUBS^^0
"BLD",19,"KRN",101,"NM",5,0)
LA7V 565 REMOTE ORM-O01 EVENT^^0
"BLD",19,"KRN",101,"NM",6,0)
LA7V 565 REMOTE ORM-O01 SUBS^^0
"BLD",19,"KRN",101,"NM",7,0)
LA7V 659 REMOTE ORM-O01 EVENT^^0
"BLD",19,"KRN",101,"NM",8,0)
LA7V 659 REMOTE ORM-O01 SUBS^^0
"BLD",19,"KRN",101,"NM",9,0)
LR EVSEND CPRS^^0
"BLD",19,"KRN",101,"NM",10,0)
LR EVSEND REMTE^^0
"BLD",19,"KRN",101,"NM",11,0)
RA 565 ORM-O01 EVENT^^0
"BLD",19,"KRN",101,"NM",12,0)
RA 565 ORM-O01 SUBS^^0
"BLD",19,"KRN",101,"NM",13,0)
RA 565 REMOTE ORM-O01 EVENT^^0
"BLD",19,"KRN",101,"NM",14,0)
RA 565 REMOTE ORM-O01 SUBS^^0
"BLD",19,"KRN",101,"NM",15,0)
RA 659 ORM-O01 EVENT^^0
"BLD",19,"KRN",101,"NM",16,0)
RA 659 ORM-O01 SUBS^^0
"BLD",19,"KRN",101,"NM",17,0)
RA 659 REMOTE ORM-O01 EVENT^^0
"BLD",19,"KRN",101,"NM",18,0)
RA 659 REMOTE ORM-O01 SUBS^^0
"BLD",19,"KRN",101,"NM",19,0)
RA EVSEND OR^^0
"BLD",19,"KRN",101,"NM",20,0)
RA EVSEND RMTE^^0
"BLD",19,"KRN",101,"NM","B","LA7V 565 ORM-O01 EVENT",1)

"BLD",19,"KRN",101,"NM","B","LA7V 565 ORM-O01 SUBS",2)

"BLD",19,"KRN",101,"NM","B","LA7V 565 REMOTE ORM-O01 EVENT",5)

"BLD",19,"KRN",101,"NM","B","LA7V 565 REMOTE ORM-O01 SUBS",6)

"BLD",19,"KRN",101,"NM","B","LA7V 659 ORM-O01 EVENT",3)

"BLD",19,"KRN",101,"NM","B","LA7V 659 ORM-O01 SUBS",4)

"BLD",19,"KRN",101,"NM","B","LA7V 659 REMOTE ORM-O01 EVENT",7)

"BLD",19,"KRN",101,"NM","B","LA7V 659 REMOTE ORM-O01 SUBS",8)

"BLD",19,"KRN",101,"NM","B","LR EVSEND CPRS",9)

"BLD",19,"KRN",101,"NM","B","LR EVSEND REMTE",10)

"BLD",19,"KRN",101,"NM","B","RA 565 ORM-O01 EVENT",11)

"BLD",19,"KRN",101,"NM","B","RA 565 ORM-O01 SUBS",12)

"BLD",19,"KRN",101,"NM","B","RA 565 REMOTE ORM-O01 EVENT",13)

"BLD",19,"KRN",101,"NM","B","RA 565 REMOTE ORM-O01 SUBS",14)

"BLD",19,"KRN",101,"NM","B","RA 659 ORM-O01 EVENT",15)

"BLD",19,"KRN",101,"NM","B","RA 659 ORM-O01 SUBS",16)

"BLD",19,"KRN",101,"NM","B","RA 659 REMOTE ORM-O01 EVENT",17)

"BLD",19,"KRN",101,"NM","B","RA 659 REMOTE ORM-O01 SUBS",18)

"BLD",19,"KRN",101,"NM","B","RA EVSEND OR",19)

"BLD",19,"KRN",101,"NM","B","RA EVSEND RMTE",20)

"BLD",19,"KRN",409.61,0)
409.61
"BLD",19,"KRN",771,0)
771
"BLD",19,"KRN",771,"NM",0)
^9.68A^12^12
"BLD",19,"KRN",771,"NM",1,0)
LA7V 500 CLIENT^^0
"BLD",19,"KRN",771,"NM",2,0)
LA7V 565 CLIENT^^0
"BLD",19,"KRN",771,"NM",3,0)
LA7V 659 CLIENT^^0
"BLD",19,"KRN",771,"NM",4,0)
LA7V HOST 500^^0
"BLD",19,"KRN",771,"NM",5,0)
LA7V HOST 565^^0
"BLD",19,"KRN",771,"NM",6,0)
LA7V HOST 659^^0
"BLD",19,"KRN",771,"NM",7,0)
RA 500 CLIENT^^0
"BLD",19,"KRN",771,"NM",8,0)
RA 565 CLIENT^^0
"BLD",19,"KRN",771,"NM",9,0)
RA 659 CLIENT^^0
"BLD",19,"KRN",771,"NM",10,0)
RA HOST 500^^0
"BLD",19,"KRN",771,"NM",11,0)
RA HOST 565^^0
"BLD",19,"KRN",771,"NM",12,0)
RA HOST 659^^0
"BLD",19,"KRN",771,"NM","B","LA7V 500 CLIENT",1)

"BLD",19,"KRN",771,"NM","B","LA7V 565 CLIENT",2)

"BLD",19,"KRN",771,"NM","B","LA7V 659 CLIENT",3)

"BLD",19,"KRN",771,"NM","B","LA7V HOST 500",4)

"BLD",19,"KRN",771,"NM","B","LA7V HOST 565",5)

"BLD",19,"KRN",771,"NM","B","LA7V HOST 659",6)

"BLD",19,"KRN",771,"NM","B","RA 500 CLIENT",7)

"BLD",19,"KRN",771,"NM","B","RA 565 CLIENT",8)

"BLD",19,"KRN",771,"NM","B","RA 659 CLIENT",9)

"BLD",19,"KRN",771,"NM","B","RA HOST 500",10)

"BLD",19,"KRN",771,"NM","B","RA HOST 565",11)

"BLD",19,"KRN",771,"NM","B","RA HOST 659",12)

"BLD",19,"KRN",779.2,0)
779.2
"BLD",19,"KRN",870,0)
870
"BLD",19,"KRN",870,"NM",0)
^9.68A^4^4
"BLD",19,"KRN",870,"NM",1,0)
LA7RMTE1^^0
"BLD",19,"KRN",870,"NM",2,0)
LA7RMTE2^^0
"BLD",19,"KRN",870,"NM",3,0)
LA7RMTE3^^0
"BLD",19,"KRN",870,"NM",4,0)
HUB1^^0
"BLD",19,"KRN",870,"NM","B","HUB1",4)

"BLD",19,"KRN",870,"NM","B","LA7RMTE1",1)

"BLD",19,"KRN",870,"NM","B","LA7RMTE2",2)

"BLD",19,"KRN",870,"NM","B","LA7RMTE3",3)

"BLD",19,"KRN",8989.51,0)
8989.51
"BLD",19,"KRN",8989.52,0)
8989.52
"BLD",19,"KRN",8989.52,"NM",0)
^9.68A^^
"BLD",19,"KRN",8994,0)
8994
"BLD",19,"KRN",8994,"NM",0)
^9.68A^^0
"BLD",19,"KRN","B",.4,.4)

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

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

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

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

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

"BLD",19,"KRN","B",3.6,3.6)

"BLD",19,"KRN","B",3.8,3.8)

"BLD",19,"KRN","B",9.2,9.2)

"BLD",19,"KRN","B",9.8,9.8)

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

"BLD",19,"KRN","B",19.1,19.1)

"BLD",19,"KRN","B",101,101)

"BLD",19,"KRN","B",409.61,409.61)

"BLD",19,"KRN","B",771,771)

"BLD",19,"KRN","B",779.2,779.2)

"BLD",19,"KRN","B",870,870)

"BLD",19,"KRN","B",8989.51,8989.51)

"BLD",19,"KRN","B",8989.52,8989.52)

"BLD",19,"KRN","B",8994,8994)

"BLD",19,"QUES",0)
^9.62^^
"BLD",19,"REQB",0)
^9.611^^
"KRN",101,2690,-1)
0^19
"KRN",101,2690,0)
RA EVSEND OR^Radiology event sent to OE/RR^^X^^^^^^^^RADIOLOGY/NUCLEAR MEDICINE
"KRN",101,2690,1,0)
^^3^3^2960529^^^^
"KRN",101,2690,1,1,0)
Invoked when a request is created or changed by the Radiology/Nuclear
"KRN",101,2690,1,2,0)
Medicine package (the "backdoor") and the data is passed to the Order
"KRN",101,2690,1,3,0)
Entry package, Version 3.0 or greater.
"KRN",101,2690,4)
^^^RA EVSEND
"KRN",101,2690,10,0)
^101.01PA^5^5
"KRN",101,2690,10,4,0)
6199^^^
"KRN",101,2690,10,4,"^")
RA EVSEND RMTE
"KRN",101,2690,15)
K:$L($G(RAVARBLE)) @RAVARBLE,RAVARBLE
"KRN",101,2690,20)

"KRN",101,2690,99)
64090,41966
"KRN",101,6177,-1)
0^10
"KRN",101,6177,0)
LR EVSEND REMTE^REMOTE ORDERING PROTOCOL^^A^^^^^^^^
"KRN",101,6177,15)
K HLA("HLS")
"KRN",101,6177,20)
I $G(REMOTE)'=1,$D(XQORMSG) D EN^LRHBOUT(.XQORMSG)
"KRN",101,6177,99)
63908,55772
"KRN",101,6181,-1)
0^9
"KRN",101,6181,0)
LR EVSEND CPRS^VISTA TO CPRS^^A^^^^^^^^
"KRN",101,6181,15)
K HLA("HLS")
"KRN",101,6181,20)
I $G(REMOTE)'=1,$D(XQORMSG) D EN^LRHBOUT("",.XQORMSG)
"KRN",101,6181,99)
63910,36263
"KRN",101,6181,770)
^^^^^^^^^2.4^
"KRN",101,6187,-1)
0^1
"KRN",101,6187,0)
LA7V 565 ORM-O01 EVENT^REMOTE SENDING PROTOCOL^^E^^^^^^^^
"KRN",101,6187,99)
63952,57661
"KRN",101,6187,770)
LA7V HOST 500^^ORM^O01^^^^AL^NE^2.4^
"KRN",101,6187,773)
1^1^0
"KRN",101,6187,775,0)
^101.0775PA^1^1
"KRN",101,6187,775,1,0)
6188
"KRN",101,6187,775,1,"^")
LA7V 565 ORM-O01 SUBS
"KRN",101,6188,-1)
0^2
"KRN",101,6188,0)
LA7V 565 ORM-O01 SUBS^REMOTE SUBSCRIBER^^S^^^^^^^^
"KRN",101,6188,99)
63952,57818
"KRN",101,6188,770)
^LA7V 565 CLIENT^^^^^LA7RMTE1^AL^NE^2.4^
"KRN",101,6188,773)
1^1^0
"KRN",101,6189,-1)
0^3
"KRN",101,6189,0)
LA7V 659 ORM-O01 EVENT^REMOTE SENDING PROTOCOL^^E^^^^^^^^
"KRN",101,6189,99)
63972,42193
"KRN",101,6189,770)
LA7V HOST 500^^ORM^O01^^^^AL^NE^2.4^
"KRN",101,6189,773)
1^1^0
"KRN",101,6189,775,0)
^101.0775PA^1^1
"KRN",101,6189,775,1,0)
6190
"KRN",101,6189,775,1,"^")
LA7V 659 ORM-O01 SUBS
"KRN",101,6190,-1)
0^4
"KRN",101,6190,0)
LA7V 659 ORM-O01 SUBS^REMOTE SUBSCRIBER^^S^^^^^^^^
"KRN",101,6190,99)
63972,42310
"KRN",101,6190,770)
^LA7V 659 CLIENT^^^^^LA7RMTE2^AL^NE^2.4^
"KRN",101,6190,773)
1^1^0
"KRN",101,6193,-1)
0^5
"KRN",101,6193,0)
LA7V 565 REMOTE ORM-O01 EVENT^Incoming messages from remote order spoke^^E^^^^^^^^
"KRN",101,6193,99)
63978,34874
"KRN",101,6193,770)
LA7V HOST 565^^ORM^O01^49^^^NE^NE^2.4^
"KRN",101,6193,775,0)
^101.0775PA^1^1
"KRN",101,6193,775,1,0)
6194
"KRN",101,6193,775,1,"^")
LA7V 565 REMOTE ORM-O01 SUBS
"KRN",101,6194,-1)
0^6
"KRN",101,6194,0)
LA7V 565 REMOTE ORM-O01 SUBS^Incoming mesages from the remote spoke^^S^^^^^^^^
"KRN",101,6194,99)
63978,35140
"KRN",101,6194,770)
^LA7V 500 CLIENT^^O01^^^^NE^NE^2.4^
"KRN",101,6194,771)
D EN^LRHBIN
"KRN",101,6194,773)
0^0^0
"KRN",101,6195,-1)
0^7
"KRN",101,6195,0)
LA7V 659 REMOTE ORM-O01 EVENT^SPOKE2 TO HUB^^E^^^^^^^^
"KRN",101,6195,99)
63993,54853
"KRN",101,6195,770)
LA7V HOST 659^^ORM^O01^49^^^AL^NE^2.4^
"KRN",101,6195,775,0)
^101.0775PA^1^1
"KRN",101,6196,-1)
0^8
"KRN",101,6196,0)
LA7V 659 REMOTE ORM-O01 SUBS^SPOKE2 TO HUB^^S^^^^^^^^
"KRN",101,6196,99)
63993,54923
"KRN",101,6196,770)
^LA7V 500 CLIENT^^O01^^^^AL^NE^2.4^ACK
"KRN",101,6196,771)
D EN^LRHBIN
"KRN",101,6196,773)
0^0^0
"KRN",101,6199,-1)
0^20
"KRN",101,6199,0)
RA EVSEND RMTE^RAD OERR => VISTA^^A^^^^^^^^
"KRN",101,6199,15)
K HLA("HLS")
"KRN",101,6199,20)
I $G(REMOTE)'=1,$D(XQORMSG) D EN^LRHBOUT(.XQORMSG)
"KRN",101,6199,99)
64037,37007
"KRN",101,6200,-1)
0^11
"KRN",101,6200,0)
RA 565 ORM-O01 EVENT^REMOTE RAD SEND PROTOCOL^^E^^^^^^^^
"KRN",101,6200,99)
64037,39102
"KRN",101,6200,770)
RA HOST 500^^ORM^O01^^^^NE^NE^2.4^
"KRN",101,6200,773)
1^1^0
"KRN",101,6200,775,0)
^101.0775PA^1^1
"KRN",101,6200,775,1,0)
6201
"KRN",101,6200,775,1,"^")
RA 565 ORM-O01 SUBS
"KRN",101,6201,-1)
0^12
"KRN",101,6201,0)
RA 565 ORM-O01 SUBS^RAD REMOTE SUBSCRIBER^^S^^^^^^^^
"KRN",101,6201,99)
64037,39219
"KRN",101,6201,770)
^RA 565 CLIENT^^^^^LA7RMTE1^NE^NE^2.4^
"KRN",101,6201,773)
1^1^0
"KRN",101,6202,-1)
0^15
"KRN",101,6202,0)
RA 659 ORM-O01 EVENT^REMOTE RAD SEND^^E^^^^^^^^
"KRN",101,6202,99)
64040,54916
"KRN",101,6202,770)
RA HOST 500^^ORM^O01^^^^NE^NE^2.4^
"KRN",101,6202,773)
1^1^0
"KRN",101,6202,775,0)
^101.0775PA^1^1
"KRN",101,6202,775,1,0)
6203
"KRN",101,6202,775,1,"^")
RA 659 ORM-O01 SUBS
"KRN",101,6203,-1)
0^16
"KRN",101,6203,0)
RA 659 ORM-O01 SUBS^HUB TO SPOKE RAD ORDER^^S^^^^^^^^
"KRN",101,6203,99)
64040,55027
"KRN",101,6203,770)
^RA 659 CLIENT^^^^^LA7RMTE2^NE^NE^2.4^
"KRN",101,6203,773)
1^1^0
"KRN",101,6204,-1)
0^18
"KRN",101,6204,0)
RA 659 REMOTE ORM-O01 SUBS^SPOKE2 RAD TO HUB^^S^^^^^^^^
"KRN",101,6204,99)
64049,36551
"KRN",101,6204,770)
^RA 500 CLIENT^^O01^^^^NE^NE^2.4^ACK
"KRN",101,6204,771)
D EN^RAHBIN
"KRN",101,6204,773)
0^0^0
"KRN",101,6205,-1)
0^17
"KRN",101,6205,0)
RA 659 REMOTE ORM-O01 EVENT^RAD SPOKE2 TO HUB^^E^^^^^^^^
"KRN",101,6205,99)
64049,36701
"KRN",101,6205,770)
RA HOST 659^^ORM^O01^49^^^NE^NE^2.4^
"KRN",101,6205,773)
0^0^0
"KRN",101,6205,775,0)
^101.0775PA^1^1
"KRN",101,6205,775,1,0)
6204
"KRN",101,6205,775,1,"^")
RA 659 REMOTE ORM-O01 SUBS
"KRN",101,6206,-1)
0^13
"KRN",101,6206,0)
RA 565 REMOTE ORM-O01 EVENT^RAD SPOKE1 TO HUB^^E^^^^^^^^
"KRN",101,6206,99)
64056,49109
"KRN",101,6206,770)
RA HOST 565^^ORM^O01^49^^^NE^NE^2.4^
"KRN",101,6206,773)
0^0^0
"KRN",101,6206,775,0)
^101.0775PA^1^1
"KRN",101,6206,775,1,0)
6207
"KRN",101,6206,775,1,"^")
RA 565 REMOTE ORM-O01 SUBS
"KRN",101,6207,-1)
0^14
"KRN",101,6207,0)
RA 565 REMOTE ORM-O01 SUBS^RAD SPOKE1 TO HUB^^S^^^^^^^^
"KRN",101,6207,99)
64056,49251
"KRN",101,6207,770)
^RA 500 CLIENT^^O01^^^^NE^NE^2.4^ACK
"KRN",101,6207,771)
D EN^RAHBIN
"KRN",101,6207,773)
0^0^0
"KRN",771,36,-1)
0^4
"KRN",771,36,0)
LA7V HOST 500^a^500^^^^USA
"KRN",771,36,"EC")
^~\&
"KRN",771,36,"FS")
|
"KRN",771,248,-1)
0^6
"KRN",771,248,0)
LA7V HOST 659^a^659
"KRN",771,248,"EC")
^~\&
"KRN",771,248,"FS")
|
"KRN",771,249,-1)
0^5
"KRN",771,249,0)
LA7V HOST 565^a^565
"KRN",771,249,"EC")
^~\&
"KRN",771,249,"FS")
|
"KRN",771,256,-1)
0^2
"KRN",771,256,0)
LA7V 565 CLIENT^a^565^^^^USA
"KRN",771,256,"EC")
^~\&
"KRN",771,256,"FS")
|
"KRN",771,257,-1)
0^3
"KRN",771,257,0)
LA7V 659 CLIENT^a^659^^^^USA
"KRN",771,257,"EC")
^~\&
"KRN",771,257,"FS")
|
"KRN",771,258,-1)
0^1
"KRN",771,258,0)
LA7V 500 CLIENT^a^500^^^^USA
"KRN",771,258,"EC")
^~\&
"KRN",771,258,"FS")
|
"KRN",771,259,-1)
0^10
"KRN",771,259,0)
RA HOST 500^a^500^^^^USA
"KRN",771,259,"EC")
^~\&
"KRN",771,259,"FS")
|
"KRN",771,260,-1)
0^8
"KRN",771,260,0)
RA 565 CLIENT^a^565^^^^USA
"KRN",771,260,"EC")
^~\&
"KRN",771,260,"FS")
|
"KRN",771,261,-1)
0^9
"KRN",771,261,0)
RA 659 CLIENT^a^659^^^^USA
"KRN",771,261,"EC")
^~\&
"KRN",771,261,"FS")
|
"KRN",771,262,-1)
0^7
"KRN",771,262,0)
RA 500 CLIENT^a^500^^^^USA
"KRN",771,262,"EC")
^~\&
"KRN",771,262,"FS")
|
"KRN",771,263,-1)
0^12
"KRN",771,263,0)
RA HOST 659^a^659^^^^USA
"KRN",771,263,"EC")
^~\&
"KRN",771,263,"FS")
|
"KRN",771,264,-1)
0^11
"KRN",771,264,0)
RA HOST 565^a^565^^^^USA
"KRN",771,264,"EC")
^~\&
"KRN",771,264,"FS")
|
"KRN",870,148,-1)
0^1
"KRN",870,148,0)
LA7RMTE1^^TCP^^^^^^^^^^^^^^^^^^10
"KRN",870,148,200)
^^^^^11^28
"KRN",870,148,400)
54.243.51.231^5026^C^N^^^^^
"KRN",870,149,-1)
0^2
"KRN",870,149,0)
LA7RMTE2^^TCP^^^^^^^^^^^^^^^^^^10
"KRN",870,149,200)
^^^^^11^28
"KRN",870,149,400)
54.243.51.240^5026^C^N^^^^^
"KRN",870,150,-1)
0^4
"KRN",870,150,0)
HUB1^^TCP^^^^^^^^^^^^^^^^^^10
"KRN",870,150,200)
^5^245^40^120^^^^^I
"KRN",870,150,400)
54.166.15.74^5026^S^Y^^^^5027^
"KRN",870,151,-1)
0^3
"KRN",870,151,0)
LA7RMTE3^^TCP^^^^^^^^^^^^^^^^^^10
"KRN",870,151,200)
^^^^^11^28
"KRN",870,151,400)
54.234.107.15^5026^C^N^^^^^
"MBREQ")
0
"ORD",13,870)
870;13;1;;HLLL^XPDTA1;;HLLLE^XPDIA1;;;HLLLDEL^XPDIA1(%)
"ORD",13,870,0)
HL LOGICAL LINK
"ORD",14,771)
771;14;;;HLAP^XPDTA1;HLAPF1^XPDIA1;HLAPE1^XPDIA1;HLAPF2^XPDIA1;;HLAPDEL^XPDIA1(%)
"ORD",14,771,0)
HL7 APPLICATION PARAMETER
"ORD",15,101)
101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA
"ORD",15,101,0)
PROTOCOL
"PKG",576,-1)
1^1
"PKG",576,0)
MOBILE SCHEDULING APPLICATIONS^MBAA^MOBILE SCHEDULING APPLICATIONS SUITE
"PKG",576,5)
OIT-PD
"PKG",576,7)
^^I
"PKG",576,22,0)
^9.49I^1^1
"PKG",576,22,1,0)
1.0^3160906^3140314^1
"PKG",576,22,1,1,0)
^^1^1^3160906
"PKG",576,22,1,1,1,0)
Remote ordering Hub
"PKG",576,22,1,"PAH",0)
^9.4901^1^1
"PKG",576,22,1,"PAH",1,0)
1^3150626
"PKG",576,22,1,"PAH",1,1,0)
^^1^1^3150626
"PKG",576,22,1,"PAH",1,1,1,0)
Scheduling Calendar View initial build.
"PKG",576,22,1,"PAH","B",1,1)

"PKG",576,"DEV")
MHED/PD
"PKG",576,"VERSION")
1.0
"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")
13
"RTN","LRHBIN")
0^1^B50512844
"RTN","LRHBIN",1,0)
LRHBIN ';;LEIDOS/TCK - REMOTE ORDER - INCOMING ; 7/30/16 12:39pm
"RTN","LRHBIN",2,0)
 ;;1.0;REMOTE ORDERS;;OCT 1,2016;Build 19
"RTN","LRHBIN",3,0)
 ; Reference to UNESC^ORHLESC supported by IA #4922
"RTN","LRHBIN",4,0)
 ;; TEST
"RTN","LRHBIN",5,0)
 ;
"RTN","LRHBIN",6,0)
EN ;
"RTN","LRHBIN",7,0)
 ; Entry point for INCOMING ORDERS FROM A HOST FACILITY
"RTN","LRHBIN",8,0)
 N I,D1,D2,D3,D4,D5,TYPE
"RTN","LRHBIN",9,0)
 S (D1,D2,D3,D4,D5,TYPE)="",C=0  ;Initialize variables
"RTN","LRHBIN",10,0)
 I $G(HLMTIEN)'>0 S LROROUT(1)="0^No Results Array Received" Q
"RTN","LRHBIN",11,0)
 S HLMA="",HLMA=$O(^HLMA("B",HLMTIEN,HLMA))
"RTN","LRHBIN",12,0)
 Q:$G(HLMA)'>0
"RTN","LRHBIN",13,0)
 Q:'$D(^HLMA(HLMA,0))
"RTN","LRHBIN",14,0)
 Q:'$D(^HLMA(HLMA,"MSH"))
"RTN","LRHBIN",15,0)
 I $P(^HLMA(HLMA,"MSH",1,0),"|",3)["LA7V" S TYPE="LAB"
"RTN","LRHBIN",16,0)
 I $P(^HLMA(HLMA,"MSH",1,0),"|",3)["RA" S TYPE="RAD"
"RTN","LRHBIN",17,0)
 S LOC=+$P(^HLMA(HLMA,"MSH",1,0),"|",4)
"RTN","LRHBIN",18,0)
 M ^TMP("RMTE",1)=^HLMA(HLMA,"MSH",1,0)
"RTN","LRHBIN",19,0)
 S I=0 F  S I=$O(^HL(772,HLMTIEN,"IN",I)) Q:I=""  D
"RTN","LRHBIN",20,0)
 .S C=$G(I)+1
"RTN","LRHBIN",21,0)
 .S ^TMP("RMTE",C)=^HL(772,HLMTIEN,"IN",I,0)
"RTN","LRHBIN",22,0)
 M REC=^TMP("RMTE")
"RTN","LRHBIN",23,0)
 Q:'$D(REC)
"RTN","LRHBIN",24,0)
 D EN^LRHBIN1(.REC,TYPE,LOC)
"RTN","LRHBIN",25,0)
 K REC,HLMTIEN,^TMP("RMTE"),HLMA,LOC,DONE
"RTN","LRHBIN",26,0)
 Q
"RTN","LRHBIN",27,0)
 ;
"RTN","LRHBIN",28,0)
TEST(LROROUT,HLMTIEN) ;
"RTN","LRHBIN",29,0)
 D EN
"RTN","LRHBIN",30,0)
 Q
"RTN","LRHBIN",31,0)
 ;
"RTN","LRHBIN",32,0)
GTDOM(R) ;
"RTN","LRHBIN",33,0)
 N NME,INST,CNT
"RTN","LRHBIN",34,0)
 S (DOM,INST,R)="",CNT=0
"RTN","LRHBIN",35,0)
 Q:'$D(^DIC(4,"E"))
"RTN","LRHBIN",36,0)
 S INST="" F  S INST=$O(^DIC(4,"E",INST)) Q:INST=""  D
"RTN","LRHBIN",37,0)
 .S NME=$$GET1^DIQ(4,INST,.01,"E")
"RTN","LRHBIN",38,0)
 .S CNT=$G(CNT)+1
"RTN","LRHBIN",39,0)
 .S R(CNT)=INST_"^"_NME
"RTN","LRHBIN",40,0)
 Q
"RTN","LRHBIN",41,0)
 ;
"RTN","LRHBIN",42,0)
DC(REC,ORID,ORVP,ORNP,ORL,REAS,DCORIG,ISNEWORD) ;
"RTN","LRHBIN",43,0)
 D PROXY^RAHBIN2(.DUZ,.DUZNME)
"RTN","LRHBIN",44,0)
 S ORNP=DUZ
"RTN","LRHBIN",45,0)
 S REMOTE=1
"RTN","LRHBIN",46,0)
 N FLG,FLAG,LRSEND,LRODT,LRSN,LRSEND,ORN,LRIEN,LRFILE,LRAA,LRAN,LRAD
"RTN","LRHBIN",47,0)
 S (FLG,FLAG)=0,(LRAA,LRAN,LRAD)=""
"RTN","LRHBIN",48,0)
 S (DCORIG,ISNEWORD)=0
"RTN","LRHBIN",49,0)
 S ORDNUM=+ORID
"RTN","LRHBIN",50,0)
 S FILE=100,ORIEN=ORDNUM_","
"RTN","LRHBIN",51,0)
 I $$GET1^DIQ(FILE,ORIEN,31,"I") D  Q:FLG
"RTN","LRHBIN",52,0)
 .I $$GET1^DIQ(FILE,ORIEN,5,"I")=1 S NDE=$O(^OR(100,ORDNUM,8,9999),-1),REC(1)=ORDNUM_";"_NDE_"^RS" S FLG=1 Q
"RTN","LRHBIN",53,0)
 Q:FLG
"RTN","LRHBIN",54,0)
 S STATUS=$$GET1^DIQ(100,ORDNUM_",",5,"I")
"RTN","LRHBIN",55,0)
 S PTYPE=$$GET1^DIQ(100,ORDNUM_",",12),PTYPE=$E(PTYPE,1,3)
"RTN","LRHBIN",56,0)
 I PTYPE'["RAD" D
"RTN","LRHBIN",57,0)
 .I STATUS=2 D  Q
"RTN","LRHBIN",58,0)
 ..S REC(1)="Warning: Not cancelled. Lab order is already completed."
"RTN","LRHBIN",59,0)
 .I $G(ACT)="DC" D
"RTN","LRHBIN",60,0)
 ..I $G(REAS)'="" S REASIEN="",REASIEN=$O(^ORD(100.03,"B",REAS,REASIEN))
"RTN","LRHBIN",61,0)
 ..I $G(REASIEN)>0 S REAS=REASIEN
"RTN","LRHBIN",62,0)
 .S LRFILE=100,LRIEN=ORDNUM_","
"RTN","LRHBIN",63,0)
 .S LRDATA=$$GET1^DIQ(LRFILE,LRIEN,33,"I") I LRDATA="" Q
"RTN","LRHBIN",64,0)
 .S LRORD=$P(LRDATA,";"),LRODT=$P(LRDATA,";",2),LRSND=$P(LRDATA,";",3)
"RTN","LRHBIN",65,0)
 .Q:$G(LRORD)=""
"RTN","LRHBIN",66,0)
 .Q:$G(LRODT)=""
"RTN","LRHBIN",67,0)
 .Q:$G(LRSND)=""
"RTN","LRHBIN",68,0)
 .I '$D(^LRO(69,LRODT,1,LRSND)) Q
"RTN","LRHBIN",69,0)
 .I '$D(^LRO(69,LRODT,1,LRSND,2)) Q
"RTN","LRHBIN",70,0)
 .S LRSEND=0 F  S LRSEND=$O(^LRO(69,LRODT,1,LRSND,2,LRSEND)) Q:LRSEND'?.N  D
"RTN","LRHBIN",71,0)
 ..S ORN=$P(^LRO(69,LRODT,1,LRSND,2,LRSEND,0),U,7)
"RTN","LRHBIN",72,0)
 ..I ORN=ORDNUM D
"RTN","LRHBIN",73,0)
 ...S LRSN=LRSND,LRI=LRSEND,ORIFN=ORN
"RTN","LRHBIN",74,0)
 ...S LRTEST=$P(^LRO(69,LRODT,1,LRSND,2,LRSEND,0),U)
"RTN","LRHBIN",75,0)
 ...S LRSS=$$GET1^DIQ(60,LRTEST,4,"I")
"RTN","LRHBIN",76,0)
 ...S LIEN=LRSN_","_LRODT_","
"RTN","LRHBIN",77,0)
 ...S LRDFN=$$GET1^DIQ(69.01,LIEN,.01,"I")
"RTN","LRHBIN",78,0)
 ...S PNM=$$GET1^DIQ(2,ORVP,.01,"I"),LRDPF=2
"RTN","LRHBIN",79,0)
 ...S LRAA=$P(^LRO(69,LRODT,1,LRSND,2,LRSEND,0),U,4)
"RTN","LRHBIN",80,0)
 ...S LRAD=$P(^LRO(69,LRODT,1,LRSND,2,LRSEND,0),U,3)
"RTN","LRHBIN",81,0)
 ...S LRAN=$P(^LRO(69,LRODT,1,LRSND,2,LRSEND,0),U,5)
"RTN","LRHBIN",82,0)
 .I ACT="OC" S FLAG=1
"RTN","LRHBIN",83,0)
 .I LRAA'="",LRAD'="",LRAN'="" S FLAG=1
"RTN","LRHBIN",84,0)
 I PTYPE["RAD" D
"RTN","LRHBIN",85,0)
 .I STATUS=2 D  Q
"RTN","LRHBIN",86,0)
 ..S REC(1)="Warning: Not cancelled. Rad order is already completed."
"RTN","LRHBIN",87,0)
 .I $G(ACT)="DC" D
"RTN","LRHBIN",88,0)
 ..I $G(REAS)'="" S REASIEN="",REASIEN=$O(^ORD(100.03,"B",REAS,REASIEN))
"RTN","LRHBIN",89,0)
 ..I $G(REASIEN)>0 S REAS=REASIEN
"RTN","LRHBIN",90,0)
 .I STATUS'=5 D  Q
"RTN","LRHBIN",91,0)
 ..K RADFDA,ERRMSG,RAONUM,EXMSTA,NOW
"RTN","LRHBIN",92,0)
 ..N RADTI,RACNI
"RTN","LRHBIN",93,0)
 ..S FILE=100,RAIEN=ORDNUM_","
"RTN","LRHBIN",94,0)
 ..S RAOIFN=$$GET1^DIQ(FILE,RAIEN,33,"I") I RAOIFN="" D
"RTN","LRHBIN",95,0)
 ...S JVOROUT(1)="-1^Error: Case number does not exist in the order file." Q
"RTN","LRHBIN",96,0)
 ..S RAOSTS=1,RAOREA=25,RADFN=ORVP
"RTN","LRHBIN",97,0)
 ..S RADTI=$O(^RADPT("AO",RAOIFN,RADFN,""))
"RTN","LRHBIN",98,0)
 ..S RACNI=$O(^RADPT("AO",RAOIFN,RADFN,RADTI,""))
"RTN","LRHBIN",99,0)
 ..D ^RAORDU
"RTN","LRHBIN",100,0)
 ..;Ensure Rad Order file is updated to discontinue
"RTN","LRHBIN",101,0)
 ..D NOW^%DTC S NOW=% K %
"RTN","LRHBIN",102,0)
 ..S RADFDA(75.1,RAOIFN_",",5)=1  ;4076;0 was an invalid code, use 1=DC
"RTN","LRHBIN",103,0)
 ..S RADFDA(75.1,RAOIFN_",",18)=NOW
"RTN","LRHBIN",104,0)
 ..D UPDATE^DIE("S","RADFDA","","ERRMSG")
"RTN","LRHBIN",105,0)
 ..S DIE="^OR(100,",DA=+ORID,DR="65////"_REAS_";" D ^DIE K DIE,DA
"RTN","LRHBIN",106,0)
 ..;Must have proper status number for RADPT status
"RTN","LRHBIN",107,0)
 ..S PROC=$$GET1^DIQ(75.1,RAOIFN,2,"I")
"RTN","LRHBIN",108,0)
 ..S STATUS="CANCELLED"
"RTN","LRHBIN",109,0)
 ..S EXMSTA=$$GETSTA^RAHBIN2(PROC,STATUS)
"RTN","LRHBIN",110,0)
 ..D X7005^RADD3(RADFN,RADTI,RACNI,1,"",EXMSTA,$G(ORNP))
"RTN","LRHBIN",111,0)
 ..S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U,3)=EXMSTA
"RTN","LRHBIN",112,0)
 ..S REC(1)=ORDNUM_"^RS",FLAG=1
"RTN","LRHBIN",113,0)
 ..;PACS msg - for Cancel - needs RAEID,RADFN,RADTI,RACNI defined
"RTN","LRHBIN",114,0)
 ..S RAEID=$O(^ORD(101,"B","RA CANCEL 2.3",0))
"RTN","LRHBIN",115,0)
 ..D EN^RAHLR
"RTN","LRHBIN",116,0)
 I 'FLAG D
"RTN","LRHBIN",117,0)
 .D DC^ORWDXA(.REC,ORID,ORNP,ORL,REAS,DCORIG,ISNEWORD)
"RTN","LRHBIN",118,0)
 .D BLDSND^LRHBIN1(.REC,.ORWREC)
"RTN","LRHBIN",119,0)
 .K REC S ES="AA",ORWLST=""
"RTN","LRHBIN",120,0)
 .D SEND^ORWDX(.ORWLST,ORVP,ORNP,ORL,ES,.ORWREC)
"RTN","LRHBIN",121,0)
 .M REC=ORWLST K ORWLST
"RTN","LRHBIN",122,0)
 I PTYPE'="RAD",REAS'?.N D
"RTN","LRHBIN",123,0)
 .N DEF,R,PKG,X,OK
"RTN","LRHBIN",124,0)
 .S PKG=$O(^DIC(9.4,"B","LAB SERVICE",0))
"RTN","LRHBIN",125,0)
 .S DEF=$P($G(^LAB(69.9,1,"OR")),"^",2)
"RTN","LRHBIN",126,0)
 .S X=$$DC^ORX1(DEF,+$G(REQ),PKG,"Cancellation Reason"),LRNATURE=$S(X:"^^^"_$P(X,"^",1,2)_"^99ORR",1:-1)
"RTN","LRHBIN",127,0)
 .S LRSN=LRSND
"RTN","LRHBIN",128,0)
 .S LRTNM=$$GET1^DIQ(60,LRTEST,.01,"I")
"RTN","LRHBIN",129,0)
 .S LRCCOM=$G(REAS)
"RTN","LRHBIN",130,0)
 .S LRCCOM=$P(LRCCOM,"*",1,2)
"RTN","LRHBIN",131,0)
 .S ORIFN=ORN,LRTSTS=LRTEST
"RTN","LRHBIN",132,0)
 .D ^LRPARAM
"RTN","LRHBIN",133,0)
 .;Call LRTSTOUT to update file 69, 68 and 63
"RTN","LRHBIN",134,0)
 .D SET^LRTSTOUT
"RTN","LRHBIN",135,0)
 I '$D(REC(1)) S REC(1)=ORID_"^RS"
"RTN","LRHBIN",136,0)
 Q
"RTN","LRHBIN",137,0)
 ;
"RTN","LRHBIN",138,0)
CAN69(LRTEST,ORIFN,LRODT,LRSND,LRSEND) ;
"RTN","LRHBIN",139,0)
 S LRNOW=$$NOW^XLFDT
"RTN","LRHBIN",140,0)
 I $G(REMOTE)=1 D
"RTN","LRHBIN",141,0)
 .N II,JVACC,JVDT,JVXREF,LRDFN,LRIDT,LRMSTATI,LRSTATUS,LRI
"RTN","LRHBIN",142,0)
 .S X=1+$O(^LRO(69,LRODT,1,LRSND,2,LRSEND,1.1,"A"),-1),X(1)=$P($G(^(0)),U,4)
"RTN","LRHBIN",143,0)
 .S LRNATURE="SERVICE CORRECTION",LRNOW=$$NOW^XLFDT
"RTN","LRHBIN",144,0)
 .S LRCCOM="SERVICE CORRECTION.",LRSTATUS="",LRMSTATI="OC"
"RTN","LRHBIN",145,0)
 .S ^LRO(69,LRODT,1,LRSND,2,LRSEND,1.1,0)="^^"_X_"^"_X(1)_"^"_DT
"RTN","LRHBIN",146,0)
 .I $G(ORIFN),$D(II) D NEW^LR7OB1(LRODT,LRSND,$S($G(LRMSTATI)=""!($G(LRMSTATI)=1):"OC",1:"SC"),$G(LRNATURE),.II,LRSTATUS)
"RTN","LRHBIN",147,0)
 .S $P(^LRO(69,LRODT,1,LRSND,2,LRSEND,0),"^",9)="CA",$P(^(0),U,10)="L",$P(^(0),U,11)=$G(ORNP)
"RTN","LRHBIN",148,0)
 .S:$D(^LRO(69,LRODT,1,LRSND,"PCE")) ^LRO(69,"AE",DUZ,LRODT,LRSND,LRSEND)=""
"RTN","LRHBIN",149,0)
 ;DELETE MANAGEMENT REPORT CROSS REFERENCES
"RTN","LRHBIN",150,0)
 ;S LRAD=$P($G(^LRO(69,LRODT,1,LRSND,2,LRSEND,0)),"^",3)
"RTN","LRHBIN",151,0)
 ;S LRAA=$P($G(^LRO(69,LRODT,1,LRSND,2,LRSEND,0)),"^",4)
"RTN","LRHBIN",152,0)
 ;S LRAN=$P($G(^LRO(69,LRODT,1,LRSND,2,LRSEND,0)),"^",5)
"RTN","LRHBIN",153,0)
 S ORID=ORIFN
"RTN","LRHBIN",154,0)
 D DLTRPT(ORID,LRAA,LRAD,LRAN,LRODT,LRSND)
"RTN","LRHBIN",155,0)
 Q
"RTN","LRHBIN",156,0)
 ;
"RTN","LRHBIN",157,0)
DLTRPT(ORID,LRAA,LRAD,LRAN,LRODT,LRSND) ;
"RTN","LRHBIN",158,0)
 ;IF LRAA IS NOT DEFINED, ORDER NOT ACCESSIONED SO QUIT
"RTN","LRHBIN",159,0)
 I $G(LRAA)="" S JVOROUT(1)=ORIFN_";"_2_"^"_"RS" Q
"RTN","LRHBIN",160,0)
 S LRDFN=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^")
"RTN","LRHBIN",161,0)
 S JVACC=^LRO(68,LRAA,1,LRAD,1,LRAN,.2)
"RTN","LRHBIN",162,0)
 S LRIDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",5)
"RTN","LRHBIN",163,0)
 Q:$G(JVACC)=""
"RTN","LRHBIN",164,0)
 ;CHECK IF FILE 68 EXISTS FOR THIS RECORD, DELETE FILE 63.
"RTN","LRHBIN",165,0)
 I $G(LRAA)>0 S SUCCESS=0 D CAN63(LRAA,LRAD,LRAN,LRDFN,LRSS,LRTEST,.SUCCESS)
"RTN","LRHBIN",166,0)
 I $G(SUCCESS)>0 S REC(1)=ORID_"^RS"
"RTN","LRHBIN",167,0)
 I $G(SUCCESS)'>0 S REC(1)="-1^Error: Discontinue failed." Q
"RTN","LRHBIN",168,0)
 Q
"RTN","LRHBIN",169,0)
 ;
"RTN","LRHBIN",170,0)
CAN63(LRAA,LRAD,LRAN,LRDFN,LRSS,LRTEST,SUCCESS) ;
"RTN","LRHBIN",171,0)
 N JV,LRI
"RTN","LRHBIN",172,0)
 S JVIENS=LRAN_","_LRAD_","_LRAA_",",LRFILE=68.02
"RTN","LRHBIN",173,0)
 S INVDT=$$GET1^DIQ(LRFILE,JVIENS,13.5,"I"),LRI=INVDT
"RTN","LRHBIN",174,0)
 S JVIENS=LRTEST_","_LRAN_","_LRAD_","_LRAA_",",LRFILE=68.04
"RTN","LRHBIN",175,0)
 S JVFDA(4,LRFILE,JVIENS,4)=$$NOW^XLFDT
"RTN","LRHBIN",176,0)
 D UPDATE^DIE("","JVFDA(4)","JVIENS","JVMSG")
"RTN","LRHBIN",177,0)
 S TEST=$$GET1^DIQ(60,LRTEST,.01)
"RTN","LRHBIN",178,0)
 S PFMBY=$$GET1^DIQ(200,DUZ,.01)
"RTN","LRHBIN",179,0)
 S TEXT="*"_$G(TEST)_" Not Performed: "_$$FMTE^XLFDT(LRNOW,"1FMZ")_" by "_$G(PFMBY)
"RTN","LRHBIN",180,0)
 S LRFILE=$S(LRSS="CH":63.041,LRSS="MI":63.051,1:0)
"RTN","LRHBIN",181,0)
 S FDA(2,LRFILE,"+2,"_INVDT_","_LRDFN_",",.01)=TEXT
"RTN","LRHBIN",182,0)
 D UPDATE^DIE("","FDA(2)","","LRERR(2)")
"RTN","LRHBIN",183,0)
 K FDA(1),LRDIE(1)
"RTN","LRHBIN",184,0)
 D CLEAN^DILF
"RTN","LRHBIN",185,0)
 Q
"RTN","LRHBIN",186,0)
 ;
"RTN","LRHBIN1")
0^2^B74937979
"RTN","LRHBIN1",1,0)
LRHBIN1 ;LEIDOS/TCK; REMOTE ORDERING; 12/14/15 6:09pm ; 9/5/16 11:18am
"RTN","LRHBIN1",2,0)
 ;;1.0;Remote orders;;JAN 1, 2016;Build 19
"RTN","LRHBIN1",3,0)
 ;--------------------------------------------------------------------
"RTN","LRHBIN1",4,0)
EN(REC,TYPE,LOC) ;
"RTN","LRHBIN1",5,0)
 ;
"RTN","LRHBIN1",6,0)
 K ORD,OR,OLDOR,ORNUM
"RTN","LRHBIN1",7,0)
 Q:'$D(REC)
"RTN","LRHBIN1",8,0)
 S ACT=""
"RTN","LRHBIN1",9,0)
 D ACTION(.REC,.ACT,.ORN)
"RTN","LRHBIN1",10,0)
 I ACT="AE" D MAIL(.REC) Q
"RTN","LRHBIN1",11,0)
 D GTDATA(.REC,.ORVP,.ORNP,.ORL,.DLG,.ORDG,.ORIT,.ORIFN,.REAS,TYPE)
"RTN","LRHBIN1",12,0)
 I ACT="NW" Q
"RTN","LRHBIN1",13,0)
 I (ACT["OC")!(ACT["CA")!(ACT["DC") D
"RTN","LRHBIN1",14,0)
 .S ORID=$G(ORIFN),(DCORIG,ISNEWORD)=0
"RTN","LRHBIN1",15,0)
 .I ORID'="" D
"RTN","LRHBIN1",16,0)
 ..S ORL=+$$GET1^DIQ(100,ORID,6,"I")
"RTN","LRHBIN1",17,0)
 ..I ORID'[";" S ORID=ORID_";1"
"RTN","LRHBIN1",18,0)
 ..D DC^LRHBIN(.REC,ORID,ORVP,ORNP,ORL,REAS,DCORIG,ISNEWORD)
"RTN","LRHBIN1",19,0)
 I ACT["SC" D EN^LRHBIN2(.JVOROUT,.REC) ;ACCESSION MESSAGE FROM SPOKE
"RTN","LRHBIN1",20,0)
 I ACT["RE" D EN^LRHBIN2(.JVOROUT,.REC)  ;FILE RESULTS FROM SPOKE
"RTN","LRHBIN1",21,0)
 D END
"RTN","LRHBIN1",22,0)
 ;
"RTN","LRHBIN1",23,0)
 Q
"RTN","LRHBIN1",24,0)
 ;-----------------------------------------------------------------------
"RTN","LRHBIN1",25,0)
MAIL(REC) ; Send email if AE received.
"RTN","LRHBIN1",26,0)
 ;
"RTN","LRHBIN1",27,0)
 ;   Input: REC - HL(772 data
"RTN","LRHBIN1",28,0)
 ;
"RTN","LRHBIN1",29,0)
 ;  Output: Email
"RTN","LRHBIN1",30,0)
 ;
"RTN","LRHBIN1",31,0)
 K ^XTMP("LRHB",$J)
"RTN","LRHBIN1",32,0)
 ;
"RTN","LRHBIN1",33,0)
 N ERRMSG,I,OLORD,PLAB
"RTN","LRHBIN1",34,0)
 ;
"RTN","LRHBIN1",35,0)
 S (ERRMSG,J,PLAB)="",I=0
"RTN","LRHBIN1",36,0)
 ;
"RTN","LRHBIN1",37,0)
 F  S J=$O(REC(J)) Q:J=""  D  Q:ERRMSG]""
"RTN","LRHBIN1",38,0)
 .I $P(REC(J),"|")="MSH" S PLAB=$P(REC(J),"|",4)      ; performing lab
"RTN","LRHBIN1",39,0)
 .I $P(REC(J),"|")="MSA" D  Q
"RTN","LRHBIN1",40,0)
 ..S ERRMSG=$P(REC(J),"|",4),OLORD=$P(REC(J),"|",5)   ; error text & order number
"RTN","LRHBIN1",41,0)
 ;
"RTN","LRHBIN1",42,0)
 S I=I+1,^XTMP("LRHB",$J,I)="   Order#: "_OLORD_"  Performing Lab: "
"RTN","LRHBIN1",43,0)
 S ^XTMP("LRHB",$J,I)=^XTMP("LRHB",$J,1)_$$GET1^DIQ(4,PLAB,.01)
"RTN","LRHBIN1",44,0)
 S I=I+1,^XTMP("LRHB",$J,I)="  Patient: "_$$GET1^DIQ(100,OLORD,.02)
"RTN","LRHBIN1",45,0)
 S I=I+1,^XTMP("LRHB",$J,I)=" Provider: "_$$GET1^DIQ(100,OLORD,1)
"RTN","LRHBIN1",46,0)
 S TEST=$G(^OR(100,OLORD,4.5,1,1))
"RTN","LRHBIN1",47,0)
 S I=I+1,^XTMP("LRHB",$J,I)="Orderable: "_$$GET1^DIQ(101.43,TEST,.01)
"RTN","LRHBIN1",48,0)
 S I=I+1,^XTMP("LRHB",$J,I)=$TR($J(" ",60)," ","-")
"RTN","LRHBIN1",49,0)
 S I=I+1,^XTMP("LRHB",$J,I)="Application error: "_ERRMSG
"RTN","LRHBIN1",50,0)
 S XMSUB="Application Error Received"
"RTN","LRHBIN1",51,0)
 S XMY("G.REMOTE_ORDERS_AE_ALERTS")=""
"RTN","LRHBIN1",52,0)
 D ^XMD
"RTN","LRHBIN1",53,0)
 ;
"RTN","LRHBIN1",54,0)
 K ^XTMP("LRHB",$J)
"RTN","LRHBIN1",55,0)
 ;
"RTN","LRHBIN1",56,0)
 Q
"RTN","LRHBIN1",57,0)
 ;-----------------------------------------------------------------------
"RTN","LRHBIN1",58,0)
UPDTOR(OR,ORNP) ;
"RTN","LRHBIN1",59,0)
 ;
"RTN","LRHBIN1",60,0)
 Q:$G(OR)'>0
"RTN","LRHBIN1",61,0)
 S ORD=+OR
"RTN","LRHBIN1",62,0)
 S LRIENS=1_","_ORD_","
"RTN","LRHBIN1",63,0)
 S LRFDA(1,100.008,LRIENS,13)=ORNP
"RTN","LRHBIN1",64,0)
 D UPDATE^DIE("","LRFDA(1)","LRMSG")
"RTN","LRHBIN1",65,0)
 ;
"RTN","LRHBIN1",66,0)
 Q
"RTN","LRHBIN1",67,0)
 ;-----------------------------------------------------------------------
"RTN","LRHBIN1",68,0)
BLDXRF(ORNUM,NWOR) ;
"RTN","LRHBIN1",69,0)
 ;
"RTN","LRHBIN1",70,0)
 I '$D(^XTMP(TYPE)) D SETZERO(TYPE)
"RTN","LRHBIN1",71,0)
 Q:'$D(^XTMP(TYPE))
"RTN","LRHBIN1",72,0)
 I $D(^XTMP(TYPE)) D
"RTN","LRHBIN1",73,0)
 .S ^XTMP(TYPE,+ORNUM)=+ORD
"RTN","LRHBIN1",74,0)
 .S ^XTMP(TYPE,"B",+ORD)=+ORNUM
"RTN","LRHBIN1",75,0)
 .S ^XTMP(TYPE,"CNT")=$G(^XTMP(TYPE,"CNT"))+1
"RTN","LRHBIN1",76,0)
 ;
"RTN","LRHBIN1",77,0)
 Q
"RTN","LRHBIN1",78,0)
 ;-----------------------------------------------------------------------
"RTN","LRHBIN1",79,0)
SETZERO(TYPE) ;
"RTN","LRHBIN1",80,0)
 ;
"RTN","LRHBIN1",81,0)
 D NOW^%DTC S X1=$P(%,".",1),X2=365,Y=X1 D C^%DTC
"RTN","LRHBIN1",82,0)
 S ^XTMP(TYPE,0)=X_"^"_Y_" OR XREF FOR REMOTE ORDER"
"RTN","LRHBIN1",83,0)
 S ^XTMP(TYPE,0,"CNT")=0
"RTN","LRHBIN1",84,0)
 ;
"RTN","LRHBIN1",85,0)
 Q
"RTN","LRHBIN1",86,0)
 ;-----------------------------------------------------------------------
"RTN","LRHBIN1",87,0)
ACTION(REC,ACT,ORN) ;
"RTN","LRHBIN1",88,0)
 ;
"RTN","LRHBIN1",89,0)
 N I,STOP
"RTN","LRHBIN1",90,0)
 ;
"RTN","LRHBIN1",91,0)
 S (ACT,I)="",STOP=0
"RTN","LRHBIN1",92,0)
 ;
"RTN","LRHBIN1",93,0)
 F  S I=$O(REC(I)) Q:I=""  S MSGTYP=$P(REC(I),"|") D  Q:STOP
"RTN","LRHBIN1",94,0)
 .;
"RTN","LRHBIN1",95,0)
 .I MSGTYP="ORC" D  Q
"RTN","LRHBIN1",96,0)
 ..S ORN=+$P(REC(I),"|",3),ACT=$P(REC(I),"|",2),STOP=1
"RTN","LRHBIN1",97,0)
 .;
"RTN","LRHBIN1",98,0)
 .I MSGTYP="MSA" D  Q
"RTN","LRHBIN1",99,0)
 ..S ORN="",ACT=$P(REC(I),"|",2),STOP=1   ;[not sure about ORN???]
"RTN","LRHBIN1",100,0)
 ;
"RTN","LRHBIN1",101,0)
 Q
"RTN","LRHBIN1",102,0)
 ;-----------------------------------------------------------------------
"RTN","LRHBIN1",103,0)
BLDSND(REC,ORWREC,ORNUM) ;
"RTN","LRHBIN1",104,0)
 Q:'$D(REC(1))
"RTN","LRHBIN1",105,0)
 S ORNUM=$P(REC(1),"^")
"RTN","LRHBIN1",106,0)
 S ORNUM=$E(ORNUM,2,99)
"RTN","LRHBIN1",107,0)
 S ORWREC(1)=ORNUM_"^"_1_"^"_1_"^"_"E"
"RTN","LRHBIN1",108,0)
 ;
"RTN","LRHBIN1",109,0)
 Q
"RTN","LRHBIN1",110,0)
 ;-----------------------------------------------------------------------
"RTN","LRHBIN1",111,0)
GTDATA(REC,ORVP,ORNP,ORL,DLG,ORDG,ORIT,ORIFN,REAS,TYPE) ;
"RTN","LRHBIN1",112,0)
 ;
"RTN","LRHBIN1",113,0)
 N I,CNT,QUIT
"RTN","LRHBIN1",114,0)
 S (ORVP,ORNP,ORL,DLG,ORDG,ORIT,ORIFN)="",QUIT=0
"RTN","LRHBIN1",115,0)
 I TYPE="LAB" S DLG="LR OTHER LAB TESTS"
"RTN","LRHBIN1",116,0)
 I TYPE="RAD" S DLG="RA OERR EXAM"
"RTN","LRHBIN1",117,0)
 S ORIT=$O(^ORD(101.41,"AB",DLG,0))
"RTN","LRHBIN1",118,0)
 S ORDG=$O(^ORD(100.98,"B",TYPE,0))
"RTN","LRHBIN1",119,0)
 S I="" F  S I=$O(REC(I)) Q:I=""  D
"RTN","LRHBIN1",120,0)
 .S MSGNDE=REC(I),MSGTYP=$P($G(MSGNDE),"|")
"RTN","LRHBIN1",121,0)
 .Q:MSGTYP=""
"RTN","LRHBIN1",122,0)
 .Q:MSGTYP["BHS"
"RTN","LRHBIN1",123,0)
 .I MSGTYP["MSH",$P(MSGNDE,"|",9)="ORR" Q
"RTN","LRHBIN1",124,0)
 .I MSGTYP["PID" D
"RTN","LRHBIN1",125,0)
 ..S ORVP=$P(MSGNDE,"|",3)
"RTN","LRHBIN1",126,0)
 ..I $G(ORVP)'>0 S ORVP=$P(MSGNDE,"|",4)
"RTN","LRHBIN1",127,0)
 ..I ORVP["-" S ORVP=+$P(ORVP,"-",2)
"RTN","LRHBIN1",128,0)
 ..I $G(ORVP)>0 S ORVPNME=$$GET1^DIQ(2,ORVP,.01,"E")
"RTN","LRHBIN1",129,0)
 ..;S ORVPNME=$P(MSGNDE,"|",6)
"RTN","LRHBIN1",130,0)
 ..I $D(^DPT("B",ORVPNME)) D
"RTN","LRHBIN1",131,0)
 ...S ORVP="",ORVP=$O(^DPT("B",ORVPNME,ORVP))
"RTN","LRHBIN1",132,0)
 .I MSGTYP["PV1" D
"RTN","LRHBIN1",133,0)
 ..S ORL=$P(REC(I),"|",4)
"RTN","LRHBIN1",134,0)
 .I TYPE="LAB" D
"RTN","LRHBIN1",135,0)
 ..I MSGTYP["ORC" D
"RTN","LRHBIN1",136,0)
 ...S ST=$P(REC(I),"|",2)
"RTN","LRHBIN1",137,0)
 ...S ORIFN=+$P(MSGNDE,"|",3)
"RTN","LRHBIN1",138,0)
 ...S ORNP=$P(MSGNDE,"|",13)
"RTN","LRHBIN1",139,0)
 ...D PROXY^RAHBIN2(.ORNP,.ORNPNME)
"RTN","LRHBIN1",140,0)
 ...;S ORNPNME=$P($P(MSGNDE,"|",13),"^",2,3)
"RTN","LRHBIN1",141,0)
 ...;I ORNPNME["^" S ORNPNME=$TR(ORNPNME,"^",",")
"RTN","LRHBIN1",142,0)
 ...;I $D(^VA(200,"B",ORNPNME)) D
"RTN","LRHBIN1",143,0)
 ....;S ORNP="",ORNP=$O(^VA(200,"B",ORNPNME,ORNP))
"RTN","LRHBIN1",144,0)
 ...S COL=$P($P(MSGNDE,"|",8),"^",4)
"RTN","LRHBIN1",145,0)
 ...S COL=$$HL7TFM^XLFDT(COL,"L")
"RTN","LRHBIN1",146,0)
 ...I $P(COL,".",2)="" S COL="TODAY"
"RTN","LRHBIN1",147,0)
 ...S COLLECTIONDATETIME=COL
"RTN","LRHBIN1",148,0)
 ...S START=COLLECTIONDATETIME
"RTN","LRHBIN1",149,0)
 ...I $G(ST)="CA" S REAS=$P($P(MSGNDE,"|",17),"^",4),ST=""
"RTN","LRHBIN1",150,0)
 ..I MSGTYP["NTE",ST="OC" S ST="" D
"RTN","LRHBIN1",151,0)
 ...S LRCCOM=$P(REC(I),"|",4),LRCCOM=$P(LRCCOM,":",2,4)
"RTN","LRHBIN1",152,0)
 ...S REAS=LRCCOM
"RTN","LRHBIN1",153,0)
 ..I MSGTYP["OBR" D  Q:QUIT
"RTN","LRHBIN1",154,0)
 ...S OBRNDE=REC(I)
"RTN","LRHBIN1",155,0)
 ...S TSTNDE=$P(OBRNDE,"|",5)
"RTN","LRHBIN1",156,0)
 ...I TSTNDE'="" S TSTNME=$P(TSTNDE,"^",5)
"RTN","LRHBIN1",157,0)
 ...I TSTNME="" S REC(1)="-1^ERR: LAB TEST NOT FOUND",QUIT=1 Q
"RTN","LRHBIN1",158,0)
 ...I '$D(^LAB(60,"B",TSTNME)) S REC(1)="-1^ERR: LAB TEST NOT FOUND",QUIT=1 Q
"RTN","LRHBIN1",159,0)
 ...S LABTEST="",LABTEST=$O(^LAB(60,"B",TSTNME,LABTEST))
"RTN","LRHBIN1",160,0)
 ...I LABTEST="" S REC(1)="-1^ERR: LAB TEST NOT FOUND",QUIT=1 Q
"RTN","LRHBIN1",161,0)
 ...S SAMPLE=$P(OBRNDE,"|",16),SAMPLE=+$P(SAMPLE,"^",4)
"RTN","LRHBIN1",162,0)
 ...S SPECIMEN=$P(OBRNDE,"|",16),SPECIMEN=$P(SPECIMEN,";",4)
"RTN","LRHBIN1",163,0)
 ...S COLLECTEDBY="SP",HOWOFTEN=28
"RTN","LRHBIN1",164,0)
 ...S URG=$P($P(OBRNDE,"|",28),"^",6),URGENCY=$P(URG,";",2)
"RTN","LRHBIN1",165,0)
 ...S LOC=565
"RTN","LRHBIN1",166,0)
 ...S LOCNME=$$GET1^DIQ(4,LOC,.01,"E")
"RTN","LRHBIN1",167,0)
 ...;S COMMENT="**ORDER ORIGINATED IN "_LOCNME_"**"
"RTN","LRHBIN1",168,0)
 .I TYPE="RAD" D
"RTN","LRHBIN1",169,0)
 ..I MSGTYP["ORC" D
"RTN","LRHBIN1",170,0)
 ...S ORIFN=$P(MSGNDE,"|",3)
"RTN","LRHBIN1",171,0)
 ...S USR="" D PROXY^RAHBIN2(.USR,.USRNME)
"RTN","LRHBIN1",172,0)
 ...;S USRNME="PROXY,PROVIDER"
"RTN","LRHBIN1",173,0)
 ...;I $D(^VA(200,"B",USRNME)) D
"RTN","LRHBIN1",174,0)
 ....;S USR="",USR=$O(^VA(200,"B",USRNME,USR))
"RTN","LRHBIN1",175,0)
 ...I $G(USR)>0 S $P(REC(I),"|",11)=USR_"^"_USRNME
"RTN","LRHBIN1",176,0)
 ...S ORNP=$P(MSGNDE,"|",13) D PROXY^RAHBIN2(.ORNP,.ORNPNME)
"RTN","LRHBIN1",177,0)
 ...;S ORNPNME=$P($P(MSGNDE,"|",13),"^",2,3)
"RTN","LRHBIN1",178,0)
 ...;I ORNPNME["^" S ORNPNME=$TR(ORNPNME,"^",",")
"RTN","LRHBIN1",179,0)
 ...;I $D(^VA(200,"B",ORNPNME)) D
"RTN","LRHBIN1",180,0)
 ....;S ORNP="",ORNP=$O(^VA(200,"B",ORNPNME,ORNP))
"RTN","LRHBIN1",181,0)
 ...S $P(REC(I),"|",13)=ORNP_"^"_ORNPNME
"RTN","LRHBIN1",182,0)
 ...;S DTDSIRED=$P(MSGNDE,"|",16)
"RTN","LRHBIN1",183,0)
 ...;S URG=$P($P(MSGNDE,"|",8),"^",6)
"RTN","LRHBIN1",184,0)
 ...;I $G(URG)'="" S URIEN="",URIEN=$O(^ORD(101.42,"C",URG,URIEN))
"RTN","LRHBIN1",185,0)
 ...;I $G(URIEN)'="" S URG=URIEN
"RTN","LRHBIN1",186,0)
 ...S REAS=$P($P(MSGNDE,"|",17),"^",4)
"RTN","LRHBIN1",187,0)
 ...I REAS="" S REAS=$P($P(MSGNDE,"|",17),"^",5)
"RTN","LRHBIN1",188,0)
 ...I REAS?.N S REAS=$$GET1^DIQ(75.2,REAS,.01,"E")
"RTN","LRHBIN1",189,0)
 ...;I REAS="" S REAS=$P($P(MSGNDE,"|",17),"^",5)
"RTN","LRHBIN1",190,0)
 Q
"RTN","LRHBIN1",191,0)
 ;--------------------------------------------------------------------
"RTN","LRHBIN1",192,0)
LAB ;
"RTN","LRHBIN1",193,0)
 N DA,NDE,TMP,CTYP,CTYPE,OI,JVORD,D,UR,HL,HO
"RTN","LRHBIN1",194,0)
 S ERR=0,(OI,OR)=""
"RTN","LRHBIN1",195,0)
 Q:$G(ORIT)'>0
"RTN","LRHBIN1",196,0)
 K ORDIALOG D BLDARY(ORIT,.OR,.ORT)
"RTN","LRHBIN1",197,0)
 K ORDIALOG ;M ORDIALOG=ORD K ORD
"RTN","LRHBIN1",198,0)
 S VAL="" F  S VAL=$O(ORT(VAL)) Q:VAL=""!(ERR)  D
"RTN","LRHBIN1",199,0)
 .S (CTYP,CTYPE)=""
"RTN","LRHBIN1",200,0)
 .S STRG=VAL
"RTN","LRHBIN1",201,0)
 .I $TR(STRG," ")="LABTEST" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRHBIN1",202,0)
 ..Q:$G(LABTEST)'>0
"RTN","LRHBIN1",203,0)
 ..S TST=LABTEST_";99LRT"
"RTN","LRHBIN1",204,0)
 ..D GETOINUM^ORWDCN32(.OI,TST)
"RTN","LRHBIN1",205,0)
 ..I $G(OI)="" S ERR=1,LSTN=LSTN+1,REC(LSTN)="Error: Laboratory order number is missing or invalid." Q
"RTN","LRHBIN1",206,0)
 ..S ORDIALOG(NN,1)=$G(OI)
"RTN","LRHBIN1",207,0)
 ..K ORT(STRG)
"RTN","LRHBIN1",208,0)
 .;I $TR(STRG," ")="COLLECTIONDATE/TIME" S STRG=$TR(STRG,"/","")
"RTN","LRHBIN1",209,0)
 .I $TR(STRG," ")="COLLECTIONDATE/TIME" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRHBIN1",210,0)
 ..S ORDIALOG(NN,1)=$G(START)
"RTN","LRHBIN1",211,0)
 ..K ORT(STRG)
"RTN","LRHBIN1",212,0)
 .;I $TR(STRG," ")="COMMENTS" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRHBIN1",213,0)
 ..;S ORDIALOG(NN,1)=COMMENT ;I COMMENT'="" D BLDWP(NN,COMMENT)
"RTN","LRHBIN1",214,0)
 .I $TR(STRG," ")="COLLECTEDBY" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRHBIN1",215,0)
 ..S ORDIALOG(NN,1)="SP"
"RTN","LRHBIN1",216,0)
 .I $TR(STRG," ")="HOWOFTEN" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRHBIN1",217,0)
 ..S ORDIALOG(NN,1)=28
"RTN","LRHBIN1",218,0)
 ..K ORT(STRG)
"RTN","LRHBIN1",219,0)
 .I $TR(STRG," ")="SPECIMEN" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRHBIN1",220,0)
 ..S ORDIALOG(NN,1)=SAMPLE
"RTN","LRHBIN1",221,0)
 ..K ORT(STRG)
"RTN","LRHBIN1",222,0)
 .I $TR(STRG," ")="COLLECTIONSAMPLE" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRHBIN1",223,0)
 ..S ORDIALOG(NN,1)=SPECIMEN
"RTN","LRHBIN1",224,0)
 ..K ORT(STRG)
"RTN","LRHBIN1",225,0)
 .I $TR(STRG," ")="URGENCY" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRHBIN1",226,0)
 ..S ORDIALOG(NN,1)=$G(URGENCY)
"RTN","LRHBIN1",227,0)
 ..K ORT(STRG)
"RTN","LRHBIN1",228,0)
 .I $TR(STRG," ")="LOCATION" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRHBIN1",229,0)
 ..S ORDIALOG(NN,1)=$G(LOCNME)
"RTN","LRHBIN1",230,0)
 ;
"RTN","LRHBIN1",231,0)
 Q
"RTN","LRHBIN1",232,0)
 ;-----------------------------------------------------------------------
"RTN","LRHBIN1",233,0)
BLDWP(NN,COMMENT) ;
"RTN","LRHBIN1",234,0)
 N I
"RTN","LRHBIN1",235,0)
 F I=1:1:$L(COMMENT,$C(10)) D
"RTN","LRHBIN1",236,0)
 .S ORDIALOG("WP",NDE,1,I,0)=$P(COMMENT,$C(10),I)
"RTN","LRHBIN1",237,0)
 .S ORDIALOG(NDE,1)="ORDIALOG(""WP"","_NDE_",1)"
"RTN","LRHBIN1",238,0)
 Q
"RTN","LRHBIN1",239,0)
 ;--------------------------------------------------------------------
"RTN","LRHBIN1",240,0)
BLDARY(ORIT,OR,ORT) ;
"RTN","LRHBIN1",241,0)
 Q:$G(ORIT)'>0
"RTN","LRHBIN1",242,0)
 N TXT,TMP,NM
"RTN","LRHBIN1",243,0)
 D GETDLG^ORCD(ORIT)
"RTN","LRHBIN1",244,0)
 S TXT="" F  S TXT=$O(ORDIALOG("B",TXT)) Q:TXT=""  D
"RTN","LRHBIN1",245,0)
 .S TMP=$TR(TXT," "),ORDT("B",TMP)=ORDIALOG("B",TXT)
"RTN","LRHBIN1",246,0)
 S TXT="" F  S TXT=$O(ORDT("B",TXT)) Q:TXT=""  D
"RTN","LRHBIN1",247,0)
 .I $D(ORDT("B",$TR(TXT," "))) S NM=$P($G(ORDT("B",$TR(TXT," "))),U,2)
"RTN","LRHBIN1",248,0)
 .S ORD(NM,1)="" S ORD(NM,1)=ORDT("B",TXT) S ORT(TXT,NM)="" S ORT(TXT,NM)=ORD(NM,1)
"RTN","LRHBIN1",249,0)
 ;
"RTN","LRHBIN1",250,0)
 Q
"RTN","LRHBIN1",251,0)
 ;-----------------------------------------------------------------------
"RTN","LRHBIN1",252,0)
END ;
"RTN","LRHBIN1",253,0)
 ;
"RTN","LRHBIN1",254,0)
 K REC,MSG,MSGNDE,MSGTYP
"RTN","LRHBIN1",255,0)
 ;
"RTN","LRHBIN1",256,0)
 Q
"RTN","LRHBIN2")
0^3^B261445475
"RTN","LRHBIN2",1,0)
LRHBIN2 ;SAIC/TCK- Orders Portability - Laboratory Results - main driver ; 6/14/16 1:12pm
"RTN","LRHBIN2",2,0)
 ;;1.0;Orders Portability;;March 1, 2010;Build 19
"RTN","LRHBIN2",3,0)
 ;
"RTN","LRHBIN2",4,0)
 Q
"RTN","LRHBIN2",5,0)
 ;
"RTN","LRHBIN2",6,0)
EN(JVOROUT,REC) ;
"RTN","LRHBIN2",7,0)
 K JVOROUT
"RTN","LRHBIN2",8,0)
 S D1="|",D2="^"
"RTN","LRHBIN2",9,0)
 S U=$G(D1)
"RTN","LRHBIN2",10,0)
 ;D DBG
"RTN","LRHBIN2",11,0)
 ;I '$D(REC) S JVOROUT(1)="-1^Error: No Results Array Received" Q
"RTN","LRHBIN2",12,0)
 ;
"RTN","LRHBIN2",13,0)
 N HLARY,ORC1,ORC5,XMT,XME
"RTN","LRHBIN2",14,0)
 N JVNCNT S JVNCNT=1 ; counter for JVOROUT
"RTN","LRHBIN2",15,0)
 D PARSE
"RTN","LRHBIN2",16,0)
 ;
"RTN","LRHBIN2",17,0)
MAIN ;  main driver for laboratory results
"RTN","LRHBIN2",18,0)
 ;
"RTN","LRHBIN2",19,0)
 N X,Y,Z
"RTN","LRHBIN2",20,0)
 ; Cancellation
"RTN","LRHBIN2",21,0)
 ; Accession
"RTN","LRHBIN2",22,0)
 I ORC1="SC",ORC5="SC" D
"RTN","LRHBIN2",23,0)
 . D ACC ; Tom's Stuff
"RTN","LRHBIN2",24,0)
 ; Results
"RTN","LRHBIN2",25,0)
 I ORC1="RE",ORC5="CM" D
"RTN","LRHBIN2",26,0)
 . N OK S OK=1
"RTN","LRHBIN2",27,0)
 . D RSLT^LRHBIN6 Q:'OK  ; parse HL7 message and set variable file results
"RTN","LRHBIN2",28,0)
 ;
"RTN","LRHBIN2",29,0)
 I $G(DBKIND)["O" D DBGOUT ; capture JVOROUT
"RTN","LRHBIN2",30,0)
 D END
"RTN","LRHBIN2",31,0)
 QUIT
"RTN","LRHBIN2",32,0)
 K JVOROUT
"RTN","LRHBIN2",33,0)
 ;
"RTN","LRHBIN2",34,0)
PARSE ;
"RTN","LRHBIN2",35,0)
 N JVCNT,FLG,XT,XC,OBRCT,OBXCT
"RTN","LRHBIN2",36,0)
 ;
"RTN","LRHBIN2",37,0)
 S JVCNT="",FLG=0
"RTN","LRHBIN2",38,0)
 F  S JVCNT=$O(REC(JVCNT)) Q:JVCNT=""  D  Q:FLG=2
"RTN","LRHBIN2",39,0)
 . S XT=$P(REC(JVCNT),D1,1) Q:XT=""
"RTN","LRHBIN2",40,0)
 . S XC=$G(HLARY(XT))+1,HLARY(XT)=XC
"RTN","LRHBIN2",41,0)
 . S HLARY(XT,XC)=$P(REC(JVCNT),D1,2,999)
"RTN","LRHBIN2",42,0)
 ;   set some basic variables:
"RTN","LRHBIN2",43,0)
 ; Next line looks like dead code.
"RTN","LRHBIN2",44,0)
 S X=HLARY("MSH",1),X=$P(X,D1,8),XMT=$P(X,D1,1),XME=$P(X,D1,2)
"RTN","LRHBIN2",45,0)
 S MSHSEG=HLARY("MSH",1),PIDSEG=$G(HLARY("PID",1)),ORCSEG=$G(HLARY("ORC",1))
"RTN","LRHBIN2",46,0)
 S ORC1=$P(HLARY("ORC",1),D1,1),ORC5=$P(HLARY("ORC",1),D1,5)
"RTN","LRHBIN2",47,0)
 ;  create array HLOBX of ordered OBR and OBX segments.
"RTN","LRHBIN2",48,0)
 S JVCNT="",FLG=0,OBRCT=0,OBXCT=0
"RTN","LRHBIN2",49,0)
 F  S JVCNT=$O(REC(JVCNT)) Q:JVCNT=""  D  ;
"RTN","LRHBIN2",50,0)
 . S XT=$P(REC(JVCNT),D1,1) Q:XT=""
"RTN","LRHBIN2",51,0)
 . S XC=$G(HLARY(XT))+1,HLARY(XT)=XC
"RTN","LRHBIN2",52,0)
 . I XT="OBR" S OBRCT=OBRCT+1,OBXCT=0
"RTN","LRHBIN2",53,0)
 . I XT="OBR" S HLOBX(OBRCT)=$P(REC(JVCNT),D1,2,999)
"RTN","LRHBIN2",54,0)
 . I XT="OBX" S OBXCT=OBXCT+1,HLOBX(OBRCT,OBXCT)=$P(REC(JVCNT),D1,2,999)
"RTN","LRHBIN2",55,0)
 Q
"RTN","LRHBIN2",56,0)
 ;
"RTN","LRHBIN2",57,0)
CHKORID(ID) ;Checks to see if order number sent exists in VistA.
"RTN","LRHBIN2",58,0)
 I '$D(ID) S ID=0 Q ID
"RTN","LRHBIN2",59,0)
 S LRFILE=100,LRIEN=ID_","
"RTN","LRHBIN2",60,0)
 S ID=$$GET1^DIQ(LRFILE,LRIEN,.01,"I") I ID="" S ID=0
"RTN","LRHBIN2",61,0)
 Q ID
"RTN","LRHBIN2",62,0)
 ;
"RTN","LRHBIN2",63,0)
ACC ;
"RTN","LRHBIN2",64,0)
 M ^XTMP("REC")=REC
"RTN","LRHBIN2",65,0)
 N LRADD,ORNM,ID
"RTN","LRHBIN2",66,0)
 S PNLTST=0
"RTN","LRHBIN2",67,0)
 S (LRADD,ORNM,LRURG,IFN,I,ACCN)=""
"RTN","LRHBIN2",68,0)
 K DIR,JVOROUT,LRACC
"RTN","LRHBIN2",69,0)
 S LRPARAM="^^^",(ST,LRACC)=0
"RTN","LRHBIN2",70,0)
 I $D(LROESTAT) D:$P(LRPARAM,D1,14) ^LRCAPV I $G(LREND) K LRLONG,LRPANEL Q
"RTN","LRHBIN2",71,0)
 S (LRODT,X,DT)=$$DT^XLFDT(),LRODT0=$$FMTE^XLFDT(DT,5)
"RTN","LRHBIN2",72,0)
 I '$D(^LRO(69,DT,1,0)) S ^LRO(69,DT,0)=DT,^LRO(69,DT,1,0)="^69.01PA^^",^LRO(69,"B",DT,DT)=""
"RTN","LRHBIN2",73,0)
 S X="T-7",%DT="" D ^%DT S LRTM7=+Y
"RTN","LRHBIN2",74,0)
 K DIC,LRSNDD,LRSN,LRODT,DA
"RTN","LRHBIN2",75,0)
 ; Capture DMIS number from HL7 message
"RTN","LRHBIN2",76,0)
 ;S ID=$P($G(HLARY("OBR",1)),D1,34)
"RTN","LRHBIN2",77,0)
 ;S DMIS=$P(ID,D2,4)
"RTN","LRHBIN2",78,0)
 ;S LBTECH=$P(ID,D2,1),LBTECH=+LBTECH
"RTN","LRHBIN2",79,0)
 ; Clinical order number ORDNM from ORC-2
"RTN","LRHBIN2",80,0)
 ;S ORDPROV=$P($G(HLARY("ORC",1)),D1,12),ORDPROV=+ORDPROV
"RTN","LRHBIN2",81,0)
 S ORNP="" D PROXY^RAHBIN2(.ORNP,.ORNPNME)
"RTN","LRHBIN2",82,0)
 S ORDNM=""
"RTN","LRHBIN2",83,0)
 S ORDNM=$P(HLARY("ORC",1),D1,2),ORDNM=+ORDNM
"RTN","LRHBIN2",84,0)
 ;D CHKDUP(ORDNM)
"RTN","LRHBIN2",85,0)
 ; Remote site RSITE from ORC-13
"RTN","LRHBIN2",86,0)
 S X=HLARY("ORC",1),RSITE=$P($G(X),D1,13) K X
"RTN","LRHBIN2",87,0)
 I RSITE="" S RSITE=0
"RTN","LRHBIN2",88,0)
 I RSITE S SITE=$$GET1^DIQ(4,RSITE,.01,"E")
"RTN","LRHBIN2",89,0)
 ; Local site SITE taken from current user
"RTN","LRHBIN2",90,0)
 ;S SITE=DUZ(2)
"RTN","LRHBIN2",91,0)
 I ORDNM="" S JVOROUT(1)="-1^Error: No Lab order number not found in HL7 message" Q
"RTN","LRHBIN2",92,0)
 S LRFILE=100,LRIEN=ORDNM_","
"RTN","LRHBIN2",93,0)
 ;S ORDNM=$$GET1^DIQ(LRFILE,LRIEN,.01,"I"),ORDNM=+ORDNM
"RTN","LRHBIN2",94,0)
 I ORDNM="" S JVOROUT(1)="-1^Error: No Lab order number not found in HL7 message" Q
"RTN","LRHBIN2",95,0)
 ; Get location and provider for discontinue if needed
"RTN","LRHBIN2",96,0)
 S REAS=5
"RTN","LRHBIN2",97,0)
 S ORVP=+$$GET1^DIQ(LRFILE,LRIEN,.02,"I")
"RTN","LRHBIN2",98,0)
 S ORL=+$$GET1^DIQ(LRFILE,LRIEN,6,"I")
"RTN","LRHBIN2",99,0)
 S ORNP=$$GET1^DIQ(LRFILE,LRIEN,1,"I")
"RTN","LRHBIN2",100,0)
 D PROXY^RAHBIN2(.ORNP,.ORNPNME)
"RTN","LRHBIN2",101,0)
 ; Node 4 of record in Order file (100) has three pieces:
"RTN","LRHBIN2",102,0)
 ; Lab Order number LRORD, Order date LRODT, Accession send number LRSND
"RTN","LRHBIN2",103,0)
 ; LRODT and LRSND access entry in Lab Order file (69)
"RTN","LRHBIN2",104,0)
 S LRFILE=100,LRIEN=ORDNM_",",FOUND=0
"RTN","LRHBIN2",105,0)
 S LRDATA=$$GET1^DIQ(LRFILE,LRIEN,33,"I")
"RTN","LRHBIN2",106,0)
 I LRDATA'[";" S JVOROUT(1)="-1^Error: Node 4 of ^OR(100,ORDNM) does not exist" Q
"RTN","LRHBIN2",107,0)
 S LRORD=$P(LRDATA,";"),LRODT=$P(LRDATA,";",2),LRSND=$P(LRDATA,";",3)
"RTN","LRHBIN2",108,0)
 S D="C",DIC="^LRO(69,",DIC(0)="D",X=LRORD D IX^DIC
"RTN","LRHBIN2",109,0)
 I Y<0 S JVOROUT(1)="-1^Error: Order number not found in VistA" Q
"RTN","LRHBIN2",110,0)
 S X=HLARY("OBR",1) D
"RTN","LRHBIN2",111,0)
 .S LRTST=$P($P(X,D1,4),D2)
"RTN","LRHBIN2",112,0)
 .I LRTST["."!(LRTST="") S LRTST=$P($P(X,D1,4),D2,4)
"RTN","LRHBIN2",113,0)
 .S LRSD("RUID")=$P(X,D1,20)
"RTN","LRHBIN2",114,0)
 .S JVTST=LRTST
"RTN","LRHBIN2",115,0)
 I $E(LRSD("RUID"),1,2)?.A S ACCN=LRSD("RUID"),LRSD("RUID")=$P(X,D1,21)
"RTN","LRHBIN2",116,0)
 I LRADD="A",ACCN'="" S UID=$TR(LRSD("RUID")," ","")
"RTN","LRHBIN2",117,0)
 I $P(X,D1,46)'="" S JVTST=$P($P(X,D1,46),D2),PNLTST=LRTST
"RTN","LRHBIN2",118,0)
 ; Lab test number LRTST from OBR.4.1
"RTN","LRHBIN2",119,0)
 ; Accesses entry in Lab Test file (60)
"RTN","LRHBIN2",120,0)
 S %DT="EP",X=$E(DT,2,3) D ^%DT S LRAD=Y
"RTN","LRHBIN2",121,0)
 K %DT
"RTN","LRHBIN2",122,0)
 S P2="L"
"RTN","LRHBIN2",123,0)
 S LRSTATUS="C",%DT("B")=""
"RTN","LRHBIN2",124,0)
 ; Collection date/time LRCDT from OBR-7
"RTN","LRHBIN2",125,0)
 S LRCDT="",LRCDT=$P(HLARY("OBR",1),D1,7)
"RTN","LRHBIN2",126,0)
 S LRNT="",LRNT=$$NOW^XLFDT
"RTN","LRHBIN2",127,0)
 I LRCDT="" S JVOROUT(1)="-1^Error: Collection DATE/TIME is not in HL7 message" Q
"RTN","LRHBIN2",128,0)
 I LRCDT["-" D
"RTN","LRHBIN2",129,0)
 .I $E(LRCDT,9,12)="0000" S LRCDT=$E(LRCDT,1,8)
"RTN","LRHBIN2",130,0)
 S P3="",LRCDT=$$HL7TFM^XLFDT(LRCDT,P2,P3)
"RTN","LRHBIN2",131,0)
 I $G(LRCDT)<1 S JVOROUT(1)="-1^Error: Collection Date/Time missing or invalid" Q
"RTN","LRHBIN2",132,0)
 ; Update Collection Date and Time in the Order file, (#100)
"RTN","LRHBIN2",133,0)
 S JVCDT=LRCDT
"RTN","LRHBIN2",134,0)
 S LRFILE=100,LRIEN=ORDNM_",",LRFDA(1,LRFILE,LRIEN,21)=LRCDT
"RTN","LRHBIN2",135,0)
 D UPDATE^DIE("","LRFDA(1)","LRIENS","LRMSG")
"RTN","LRHBIN2",136,0)
 S LRTIM=$P($P(HLARY("ORC",1),D1,7),D2,4),LRUN=$P($G(LRCDT),D1,2)
"RTN","LRHBIN2",137,0)
 S P2="L",P3="",LRTIM=$$HL7TFM^XLFDT(LRTIM,P2,P3)
"RTN","LRHBIN2",138,0)
 S LRSN(LRSND)=LRSND,LRSN=LRSND
"RTN","LRHBIN2",139,0)
 I '$D(^LRO(69,LRODT,1,LRSN,1)) S ^LRO(69,LRODT,1,LRSN,1)="^^^^^^^^^^"
"RTN","LRHBIN2",140,0)
 ; GETACC entry point finds matching Accession
"RTN","LRHBIN2",141,0)
 S LRFILE=69.01,LRIEN=LRSND_","_LRODT_","
"RTN","LRHBIN2",142,0)
 S COLST=$$GET1^DIQ(LRFILE,LRIEN,13,"I")
"RTN","LRHBIN2",143,0)
 ; Check if this is an ATA
"RTN","LRHBIN2",144,0)
 S JVODT=LRODT
"RTN","LRHBIN2",145,0)
 ;IF DIFFERENT LAB ORDER #, SET LRADD TO "A"
"RTN","LRHBIN2",146,0)
 ;I $G(LRADD)'="A" D CHKATA(LRSD("RUID"),LRORD,.LRADD)
"RTN","LRHBIN2",147,0)
 ;I $G(LRADD)="A" D  Q
"RTN","LRHBIN2",148,0)
 .;I $G(UID)'>0 S UID=$G(LRSD("RUID"))
"RTN","LRHBIN2",149,0)
 .;I '$D(^LRO(68,"C",UID)),ACCN'="" D
"RTN","LRHBIN2",150,0)
 ..;D GTVAUID^LRBHIN3(ACCN,.UID)
"RTN","LRHBIN2",151,0)
 .I LRSD("RUID")'=UID S LRSD("RUID")=UID
"RTN","LRHBIN2",152,0)
 .;D CHKATA(UID,LRORD,.LRFLG)
"RTN","LRHBIN2",153,0)
 .I $G(LRFLG)="A" D
"RTN","LRHBIN2",154,0)
 ..S JVOD=1,XQY0="JV VISTALINK USER",(DCORIG,ISNEWORD)=0
"RTN","LRHBIN2",155,0)
 ..S ORDNM=ORDNM_";1",REAS="OTHER CANCEL REASON"
"RTN","LRHBIN2",156,0)
 ..D DC^JVORD(.REC,ORDNM,ORVP,ORNP,ORL,REAS,DCORIG,ISNEWORD)
"RTN","LRHBIN2",157,0)
 .;S JVOD=1,(JVAA,JVAD,JVAN)=""
"RTN","LRHBIN2",158,0)
 .;D EN^JVHLLR3(LRSD("RUID"),LRTST,.JVAA,.JVAD,.JVAN,.ORNM)
"RTN","LRHBIN2",159,0)
 .;S LRACC=^LRO(68,JVAA,1,JVAD,1,JVAN,.2)
"RTN","LRHBIN2",160,0)
 .;S JVSN=$P(^LRO(68,JVAA,1,JVAD,1,JVAN,0),U,5)
"RTN","LRHBIN2",161,0)
 .;S LIEN=JVAN_","_JVAD_","_JVAA_","
"RTN","LRHBIN2",162,0)
 .;S JVODT=$$GET1^DIQ(68.02,LIEN,3,"I")
"RTN","LRHBIN2",163,0)
 .;S JVSND="",JVSND=$O(^LRO(69,JVODT,1,JVSN,2,"B",JVTST,JVSND))
"RTN","LRHBIN2",164,0)
 .;S ORNM=$P(^LRO(69,JVODT,1,JVSN,2,JVSND,0),U,7)
"RTN","LRHBIN2",165,0)
 .;S JVOROUT(1)=ORNM_";1^"_LRACC_"^"_LRSD("RUID")_"^RS"
"RTN","LRHBIN2",166,0)
 .;K LRSND,DA,JVAA,JVAD,JVAN,JVSN,JVSND,JVODT,LRDATA,HLARY,REC
"RTN","LRHBIN2",167,0)
 ; Accession the order on the VA side
"RTN","LRHBIN2",168,0)
 I $G(LRADD)'="A" D
"RTN","LRHBIN2",169,0)
 .S DA=LRSND D LROE2
"RTN","LRHBIN2",170,0)
 .K LRAA D Q15 S LRSND=LRSN K LRSN
"RTN","LRHBIN2",171,0)
 S LRACC=0,LRSEND=""
"RTN","LRHBIN2",172,0)
 I JVTST S LRTST=JVTST
"RTN","LRHBIN2",173,0)
 S LRACC=$$GETACC(ORDNM,LRODT,LRORD,.LRSND,LRTST) I LRACC=0 S JVOROUT(1)="1^Error: This order did not accession properly" Q
"RTN","LRHBIN2",174,0)
 ; DODUID entry point will update Files 68 (Accession), 69 (Lab Orders)to record the CHCS Accession number.
"RTN","LRHBIN2",175,0)
 ;I $D(LRSD) D DODUID(RSITE,LRODT,LRSND,.LRSEND,.LRUID)
"RTN","LRHBIN2",176,0)
 ;add code to stop overwriting the UID with the Vista accession #
"RTN","LRHBIN2",177,0)
 I $D(LRSD) D DODUID(RSITE,LRODT,LRSND,.LRSEND,.LRUID)
"RTN","LRHBIN2",178,0)
 .;I $E(LRSD("RUID"),1,2)?.A D
"RTN","LRHBIN2",179,0)
 ..;if the Vista acc # is the same as the UID, do not file but get the correct UID to return in the JVOROUT reference variable.
"RTN","LRHBIN2",180,0)
 ..;S LRFIL=69.03,LRIEN=LRSEND_","_LRSND_","_LRODT_","
"RTN","LRHBIN2",181,0)
 ..;S LRSD("RUID")=$$GET1^DIQ(LRFIL,LRIEN,13,"I")
"RTN","LRHBIN2",182,0)
 ;I ST S DUZ(2)=TMPDUZ
"RTN","LRHBIN2",183,0)
 ;FILE THE LAB TECH
"RTN","LRHBIN2",184,0)
 I $G(LBTECH)>0,$G(LRORD)>0 D
"RTN","LRHBIN2",185,0)
 .S LRFILE=69.03,LRIEN=LRSEND_","_LRSND_","_LRODT_","
"RTN","LRHBIN2",186,0)
 .S LRAD=$$GET1^DIQ(LRFILE,LRIEN,2,"I")
"RTN","LRHBIN2",187,0)
 .S LRAA=$$GET1^DIQ(LRFILE,LRIEN,3,"I")
"RTN","LRHBIN2",188,0)
 .S LRAN=$$GET1^DIQ(LRFILE,LRIEN,4,"I")
"RTN","LRHBIN2",189,0)
 .S LRFILE=68.04,LRIEN=LRTST_","_LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN2",190,0)
 .S LRFDA(4,LRFILE,LRIEN,3)=$G(LBTECH)
"RTN","LRHBIN2",191,0)
 .D UPDATE^DIE("","LRFDA(4)","LRIENS","LRMSG")
"RTN","LRHBIN2",192,0)
 S JVOROUT(1)=ORDNM_";1^"_LRACC_"^"_LRSD("RUID")_"^RS"
"RTN","LRHBIN2",193,0)
 S JVOROUT(2)=""
"RTN","LRHBIN2",194,0)
 ;D RSORST(LRORD)
"RTN","LRHBIN2",195,0)
 K LRSND,DA,LRODT,LRORD,LRDATA,HLARY,REC
"RTN","LRHBIN2",196,0)
 Q
"RTN","LRHBIN2",197,0)
 ;
"RTN","LRHBIN2",198,0)
CHKATA(DODID,LBORD,LRADD) ;
"RTN","LRHBIN2",199,0)
 N LRAA,LRAD,LRAN,LRIEN,LRORD
"RTN","LRHBIN2",200,0)
 S (LRAA,LRAD,LRAN,LRADD)=""
"RTN","LRHBIN2",201,0)
 I '$D(^LRO(68,"C",DODID)) Q
"RTN","LRHBIN2",202,0)
 S LRAA=$O(^LRO(68,"C",DODID,LRAA)) I LRAA="" Q
"RTN","LRHBIN2",203,0)
 S LRAD=$O(^LRO(68,"C",DODID,LRAA,LRAD)) I LRAD="" Q
"RTN","LRHBIN2",204,0)
 S LRAN=$O(^LRO(68,"C",DODID,LRAA,LRAD,LRAN)) I LRAN="" Q
"RTN","LRHBIN2",205,0)
 S LRIEN=LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN2",206,0)
 S LRORD=$$GET1^DIQ(68.02,LRIEN,14,"I")
"RTN","LRHBIN2",207,0)
 I LRORD'=LBORD S LRADD="A"
"RTN","LRHBIN2",208,0)
 Q
"RTN","LRHBIN2",209,0)
 ;
"RTN","LRHBIN2",210,0)
DODUID(RSITE,LRODT,LRSND,LRSEND,LRUID) ;STORE CHCS ACCESSION NUMBER
"RTN","LRHBIN2",211,0)
 S FLAG=0
"RTN","LRHBIN2",212,0)
 ; Type of test LRSS from Lab Test file (60).  Expect SP, CY, AP, or AU.
"RTN","LRHBIN2",213,0)
 S LRFILE=60,LRIEN=LRTST_",",LRSS=$$GET1^DIQ(LRFILE,LRIEN,4,"I")
"RTN","LRHBIN2",214,0)
 S SITE=DUZ(2)
"RTN","LRHBIN2",215,0)
 I SITE="" S JVOROUT="-1^Error: Could not find accession number." Q
"RTN","LRHBIN2",216,0)
 ; Accession area LRAA taken from Lab Test file (60)
"RTN","LRHBIN2",217,0)
 I LRAA="" S LRFILE=60.11,LRIEN=SITE_","_LRTST_",",LRAA=$$GET1^DIQ(LRFILE,LRIEN,1,"I")
"RTN","LRHBIN2",218,0)
 ;GET LRAD, LRAN FROM ACCESSION FILE (68) entry matching Lab Test
"RTN","LRHBIN2",219,0)
 I $G(LRSEND)="" D
"RTN","LRHBIN2",220,0)
 .S LRSEND=0 F  S LRSEND=$O(^LRO(69,LRODT,1,LRSND,2,LRSEND)) Q:LRSEND'?.N  D  Q:FLAG
"RTN","LRHBIN2",221,0)
 ..S LRFILE=69.03,LRIEN=LRSEND_","_LRSND_","_LRODT_","
"RTN","LRHBIN2",222,0)
 ..S LT=$$GET1^DIQ(LRFILE,LRIEN,.01,"I") I LT=LRTST D
"RTN","LRHBIN2",223,0)
 ...S X=$$GET1^DIQ(LRFILE,LRIEN,14)
"RTN","LRHBIN2",224,0)
 ...I X="" S LRUID=$$GET1^DIQ(LRFILE,LRIEN,13)
"RTN","LRHBIN2",225,0)
 ...S LRAD=$$GET1^DIQ(LRFILE,LRIEN,2,"I")
"RTN","LRHBIN2",226,0)
 ...S LRAN=$$GET1^DIQ(LRFILE,LRIEN,4,"I"),FLAG=1
"RTN","LRHBIN2",227,0)
 ; Update Accession file (68)
"RTN","LRHBIN2",228,0)
 I $G(LRUID)="" D
"RTN","LRHBIN2",229,0)
 .S X=$$GET1^DIQ(69.03,LRSEND_","_LRSND_","_LRODT_",",14)
"RTN","LRHBIN2",230,0)
 .I X="" S X=$$GET1^DIQ(69.03,LRSEND_","_LRSND_","_LRODT_",",13)
"RTN","LRHBIN2",231,0)
 .I X'="" S LRUID=X
"RTN","LRHBIN2",232,0)
 S LRRSITE("RSITE")=RSITE,LRRSITE("RPSITE")=500
"RTN","LRHBIN2",233,0)
 S DR="16////"_LRSD("RUID")_";16.1////"_+$G(LRRSITE("RSITE"))_";16.2////"_+$G(LRRSITE("RPSITE"))_";16.3////"_$G(LRUID)_";16.4////"_LRSD("RUID")
"RTN","LRHBIN2",234,0)
 S DA=LRAN,DA(1)=LRAD,DA(2)=LRAA,DIE="^LRO(68,"_DA(2)_",1,"_DA(1)_",1,",DLAYGO=68
"RTN","LRHBIN2",235,0)
 D ^DIE
"RTN","LRHBIN2",236,0)
 ; Update Lab Order file (69)
"RTN","LRHBIN2",237,0)
 S DLAYGO=69
"RTN","LRHBIN2",238,0)
 S DA=LRSEND,DA(1)=LRSND,DA(2)=LRODT,DIC="^LRO(69,"_DA(2)_",1,"_DA(1)_",2,"
"RTN","LRHBIN2",239,0)
 S DIE=DIC,DR="13////"_$G(LRSD("RUID"))_";14////"_$G(LRRSITE("RSITE"))_";15////"_$G(LRRSITE("RPSITE"))_";16////"_$G(LRUID)_";17////"_$G(LRSD("RUID"))
"RTN","LRHBIN2",240,0)
 D ^DIE
"RTN","LRHBIN2",241,0)
 ; Update Lab data file (63)
"RTN","LRHBIN2",242,0)
 S LRFILE=69.01,LRIEN=LRSND_","_LRODT_","
"RTN","LRHBIN2",243,0)
 S LRDFN=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN2",244,0)
 S LRFILE=68.02,LRIEN=LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN2",245,0)
 S LRIDT=$$GET1^DIQ(LRFILE,LRIEN,13.5,"I")
"RTN","LRHBIN2",246,0)
 S LRFILE=63.04
"RTN","LRHBIN2",247,0)
 I LRSS="MI" S LRFILE=63.05
"RTN","LRHBIN2",248,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRHBIN2",249,0)
 S LRFDA(LRFILE,LRIEN,.31)=$G(LRSD("RUID"))
"RTN","LRHBIN2",250,0)
 S LRFDA(LRFILE,LRIEN,.32)=$G(LRRSITE("RSITE"))
"RTN","LRHBIN2",251,0)
 S LRFDA(LRFILE,LRIEN,.33)=$G(LRRSITE("RPSITE"))
"RTN","LRHBIN2",252,0)
 S LRFDA(LRFILE,LRIEN,.34)=$G(LRUID)
"RTN","LRHBIN2",253,0)
 S LRFDA(LRFILE,LRIEN,.342)=$G(LRSD("LRUID"))
"RTN","LRHBIN2",254,0)
 D FILE^DIE("","LRFDA") K LRFDA,LRFILE,LRIEN
"RTN","LRHBIN2",255,0)
 Q
"RTN","LRHBIN2",256,0)
 ;
"RTN","LRHBIN2",257,0)
GETACC(ORDNM,LRODT,LRORD,LRSND,LRTST) ; Get Accession
"RTN","LRHBIN2",258,0)
 N FLG
"RTN","LRHBIN2",259,0)
 S (FLG,LRACC)=0
"RTN","LRHBIN2",260,0)
 S LRFILE=69.01,LRIEN=LRSND_","_LRODT_","
"RTN","LRHBIN2",261,0)
 I $$GET1^DIQ(LRFILE,LRIEN,.001,"I")'=LRSND S JVOROUT(1)="-1^Error: Laborder does not exist." Q LRACC
"RTN","LRHBIN2",262,0)
 S COMB=$$GET1^DIQ(LRFILE,LRIEN,22,"I")
"RTN","LRHBIN2",263,0)
 ; If this order was merged into another Lab Order, get new LRSND and LRSEND
"RTN","LRHBIN2",264,0)
 S COMB=$P(COMB,"/",1)
"RTN","LRHBIN2",265,0)
 I COMB D GETLRSND(ORDNM,LRODT,COMB,.LRSND,.LRSEND,.FLG)
"RTN","LRHBIN2",266,0)
 ; Loop over Lab Order entries to match Clinical Order number
"RTN","LRHBIN2",267,0)
 I '$G(LRSEND) D
"RTN","LRHBIN2",268,0)
 .S LRFILE=69.03
"RTN","LRHBIN2",269,0)
 .S LRSEND="",LRSEND=$O(^LRO(69,LRODT,1,LRSND,2,"B",LRTST,LRSEND))
"RTN","LRHBIN2",270,0)
 .Q:$D(LRSEND)
"RTN","LRHBIN2",271,0)
 .S LRSEND=0 F  S LRSEND=$O(^LRO(69,LRODT,1,LRSND,2,LRSEND)) Q:'LRSEND  D  Q:FLG
"RTN","LRHBIN2",272,0)
 ..S LRIEN=LRSEND_","_LRSND_","_LRODT_","
"RTN","LRHBIN2",273,0)
 ..S ORN=$$GET1^DIQ(LRFILE,LRIEN,6,"I") I ORN=ORDNM S FLG=1 Q
"RTN","LRHBIN2",274,0)
 I COMB="" S FLG=1
"RTN","LRHBIN2",275,0)
 I 'FLG S JVOROUT(1)="-1^Error: Lab test could not be found for this order." Q
"RTN","LRHBIN2",276,0)
 ; Accession area LRAA taken from matching entry if test has been accessioned
"RTN","LRHBIN2",277,0)
 S LRFILE=69.03,LRIEN=LRSEND_","_LRSND_","_LRODT_","
"RTN","LRHBIN2",278,0)
 S LRURG=$$GET1^DIQ(LRFILE,LRIEN,1,"I")
"RTN","LRHBIN2",279,0)
 S LRAD=$$GET1^DIQ(LRFILE,LRIEN,2,"I")
"RTN","LRHBIN2",280,0)
 S LRAN=$$GET1^DIQ(LRFILE,LRIEN,4,"I")
"RTN","LRHBIN2",281,0)
 S LRAA=$$GET1^DIQ(LRFILE,LRIEN,3,"I")
"RTN","LRHBIN2",282,0)
 I LRAA="" D
"RTN","LRHBIN2",283,0)
 .S SITE=DUZ(2)
"RTN","LRHBIN2",284,0)
 .I SITE="" S JVOROUT="-1^Error: Could not find accession number." Q
"RTN","LRHBIN2",285,0)
 .; If  Accession Area not in File 69 entry, take from File 60
"RTN","LRHBIN2",286,0)
 .S LRFILE=60.11,LRIEN=SITE_","_LRTST_",",LRAA=$$GET1^DIQ(LRFILE,LRIEN,1,"I")
"RTN","LRHBIN2",287,0)
 ; Get Accession date LRAD from File 69 entry, subnode 0 or 2
"RTN","LRHBIN2",288,0)
 I LRAD="" D
"RTN","LRHBIN2",289,0)
 .S LRFILE=69.03,LRIEN=LRSEND_","_LRSND_","_LRODT_",",LRAD=$$GET1^DIQ(LRFILE,LRIEN,2,"I")
"RTN","LRHBIN2",290,0)
 ; Get Accession number LRAN
"RTN","LRHBIN2",291,0)
 ; First try from File 69 entry, subnode 0
"RTN","LRHBIN2",292,0)
 I LRAD="" Q LRACC
"RTN","LRHBIN2",293,0)
 I LRAN="" D
"RTN","LRHBIN2",294,0)
 .S LRORD=$P(LRDATA,";"),LRFILE=68.02,LRIEN=LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN2",295,0)
 . ; Second try:  Search File 68 for entry matching Lab Order
"RTN","LRHBIN2",296,0)
 .S LRAN=0 F  S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:LRAN'?.N  D  Q:$P(LRACC," ",3)>0
"RTN","LRHBIN2",297,0)
 ..S LRORN=$$GET1^DIQ(LRFILE,LRIEN,14,"I") I LRORN=LRORD S LRACC=$$GET1^DIQ(LRFILE,LRIEN,15,"I")
"RTN","LRHBIN2",298,0)
 I $P(LRACC," ",3)>0 Q LRACC
"RTN","LRHBIN2",299,0)
 ; Get Accession from Accession file (68)
"RTN","LRHBIN2",300,0)
 S LRFILE=68.02,LRIEN=LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN2",301,0)
 S LRACC=$$GET1^DIQ(LRFILE,LRIEN,15,"I") I LRACC="" S LRACC=0
"RTN","LRHBIN2",302,0)
 Q LRACC
"RTN","LRHBIN2",303,0)
 ;
"RTN","LRHBIN2",304,0)
GETLRSND(ORDNM,LRODT,COMB,LRSND,LRSEND,FLG) ;
"RTN","LRHBIN2",305,0)
 S LRSND="" F  S LRSND=$O(^LRO(69,"C",+COMB,LRODT,LRSND)) Q:LRSND=""  D  Q:FLG
"RTN","LRHBIN2",306,0)
 .S LRFILE=69.01,LRIEN=LRSND_","_LRODT_",",COMB=$$GET1^DIQ(LRFILE,LRIEN,22,"I")
"RTN","LRHBIN2",307,0)
 .Q:COMB
"RTN","LRHBIN2",308,0)
 .S LRSEND=0 F  S LRSEND=$O(^LRO(69,LRODT,1,LRSND,2,LRSEND)) Q:LRSEND=""  D  Q:FLG
"RTN","LRHBIN2",309,0)
 ..S LRFILE=69.03,LRIEN=LRSEND_","_LRSND_","_LRODT_",",ORN=$$GET1^DIQ(LRFILE,LRIEN,6,"I")
"RTN","LRHBIN2",310,0)
 ..I ORN=ORDNM S FLG=1
"RTN","LRHBIN2",311,0)
 Q
"RTN","LRHBIN2",312,0)
 ;
"RTN","LRHBIN2",313,0)
Q15 ;from LROE1
"RTN","LRHBIN2",314,0)
 N X,Y
"RTN","LRHBIN2",315,0)
 S LRFILE=69.01,LRIEN=LRSND_","_LRODT_","
"RTN","LRHBIN2",316,0)
 I '$$GET1^DIQ(LRFILE,LRIEN,.01,"I") Q
"RTN","LRHBIN2",317,0)
 I M9>1 D
"RTN","LRHBIN2",318,0)
 .D LRSPEC^LROE1
"RTN","LRHBIN2",319,0)
 .S LRFILE=61,S1=$$GET1^DIQ(LRFILE,+LRSPEC,.01,"I")
"RTN","LRHBIN2",320,0)
 .S LRFILE=62,S2=$$GET1^DIQ(LRFILE,LRSAMP,.01,"I"),S4=$$GET1^DIQ(LRFILE,LRSAMP,3,"I")
"RTN","LRHBIN2",321,0)
 .S S3=S1_$S(S1'=S2:"  "_S2,1:"")
"RTN","LRHBIN2",322,0)
 ; LRDPF is the Parent file that the .03 field of the Lab data file (#63) is a pointer to
"RTN","LRHBIN2",323,0)
 S LRFILE=69.01,LRIEN=LRSND_","_LRODT_",",LRDFN=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN2",324,0)
 S LRFILE=63,LRDPF=$$GET1^DIQ(LRFILE,LRDFN,.02,"I")
"RTN","LRHBIN2",325,0)
 S LRFILE=69.01,LRIEN=LRSND_","_LRODT_","
"RTN","LRHBIN2",326,0)
 I '$$GET1^DIQ(LRFILE,LRIEN,10,"I") S LRSTATUS="C",DA=LRODT I '$D(LRSND) D P15^LROE1 Q:LRCDT<1
"RTN","LRHBIN2",327,0)
 ; Checks to see if collection method is a scheduled Lab Collect
"RTN","LRHBIN2",328,0)
 ; LRLLOC = Report Routing Location, LROLLOC = Ordering Location
"RTN","LRHBIN2",329,0)
 I $D(LRSND),$$GET1^DIQ(LRFILE,LRIEN,4,"I")="LC",$$GET1^DIQ(LRFILE,LRIEN,10,"I") D
"RTN","LRHBIN2",330,0)
 .S LRLLOC=$$GET1^DIQ(LRFILE,LRIEN,8,"I"),LROLLOC=$$GET1^DIQ(LRFILE,LRIEN,23,"I"),LRNT=$S($D(LRNT):LRNT,$D(LRTIM):LRTIM,$D(LRCDT):+LRCDT,1:"") D P15^LRPHITEM G Q16
"RTN","LRHBIN2",331,0)
 ; If COMB is defined, this order was combined with other tests on a different Lab Order entry in file (#69)
"RTN","LRHBIN2",332,0)
 ; Add parameter to the GTSPACC call and pass DMIS number.
"RTN","LRHBIN2",333,0)
 ;D GTSPACC(LRTST,.ST,DMIS)
"RTN","LRHBIN2",334,0)
 ;I ST D
"RTN","LRHBIN2",335,0)
 .;S TMPDUZ=DUZ(2)
"RTN","LRHBIN2",336,0)
 .;S DUZ(2)=ST
"RTN","LRHBIN2",337,0)
 I $D(LRSND) D
"RTN","LRHBIN2",338,0)
 .N COMB
"RTN","LRHBIN2",339,0)
 .S COMB=$$GET1^DIQ(LRFILE,LRIEN,22,"I")
"RTN","LRHBIN2",340,0)
 .S LRFDA(LRFILE,LRIEN,10)=$G(LRCDT)
"RTN","LRHBIN2",341,0)
 .S LRFDA(LRFILE,LRIEN,11)=$G(LRUN)
"RTN","LRHBIN2",342,0)
 .S LRFDA(LRFILE,LRIEN,12)=$G(ORNP)
"RTN","LRHBIN2",343,0)
 .S LRFDA(LRFILE,LRIEN,13)=$G(LRSTATUS)
"RTN","LRHBIN2",344,0)
 .S LRFDA(LRFILE,LRIEN,15)=""
"RTN","LRHBIN2",345,0)
 .S LRFDA(LRFILE,LRIEN,22)=$G(COMB)
"RTN","LRHBIN2",346,0)
 .S LRFDA(LRFILE,LRIEN,25)=$G(DUZ(2))
"RTN","LRHBIN2",347,0)
 .D FILE^DIE("","LRFDA")
"RTN","LRHBIN2",348,0)
 .S:LRSTATUS="C" ^LRO(69,"AA",+$$GET1^DIQ(LRFILE,LRIEN,9.5,"I"),LRODT_"|"_LRSND)=""
"RTN","LRHBIN2",349,0)
 ;
"RTN","LRHBIN2",350,0)
Q16 ;
"RTN","LRHBIN2",351,0)
 ; Checks to see if LRDFN matches the LRDFN found when going through "C" cross reference in file (#69)
"RTN","LRHBIN2",352,0)
 S J=0 D CHECK^LROW2 I J D BAD^LROW2
"RTN","LRHBIN2",353,0)
 ;
"RTN","LRHBIN2",354,0)
Q16A ;
"RTN","LRHBIN2",355,0)
 I $D(LRLONG),$D(LRSND) S LRSN=LRSND,^TMP("LROE",$J,"LRORD")=LRORD_U_LRODT_U_LRTIM_U_PNM_U_SSN
"RTN","LRHBIN2",356,0)
 K DR S LRTSTS=0
"RTN","LRHBIN2",357,0)
 S LRSND=0 F  S LRSND=$O(LRSN(LRSND)) Q:'LRSND  D Q17
"RTN","LRHBIN2",358,0)
 ; I LRLONG, this will set the performing lab when requirements are released
"RTN","LRHBIN2",359,0)
 I $D(LRLONG),$D(LRSND) S LRSN=LRSND D LROE^LRFAST S X=^TMP("LROE",$J,"LRORD"),LRORD=+X,LRODT=$P(X,D1,2),LRTIM=$P(X,D1,3),LRLONG="",PNM=$P(X,D1,4),SSN=$P(X,D1,5)
"RTN","LRHBIN2",360,0)
 Q
"RTN","LRHBIN2",361,0)
 ;
"RTN","LRHBIN2",362,0)
Q17 ;
"RTN","LRHBIN2",363,0)
 ; Checks for Ward comments on specimen and will never be found on orders coming from CHCS.
"RTN","LRHBIN2",364,0)
 S I=$O(^LRO(69,LRODT,1,LRSND,6,0)),J=$O(^(1)) S:'$D(IOM) IOM=80 K LRSPCDSC S:J LRSPCDSC=^(J,0) S:I DA=LRSND,DA(1)=LRODT,DR=6,DIC="^LRO(69,"_LRODT_",1," D EN^DIQ:I D LRSPEC^LROE1
"RTN","LRHBIN2",365,0)
 ; Accessions the Lab order
"RTN","LRHBIN2",366,0)
 D OLD(LRSD("RUID")) K ^TMP("LR",$J,"TMP")
"RTN","LRHBIN2",367,0)
 S LRFILE=69.01,LRIEN=LRSND_","_LRODT_","
"RTN","LRHBIN2",368,0)
 ; Sets the Lab order collection status to "collected"
"RTN","LRHBIN2",369,0)
 S LRFDA(1,LRFILE,LRIEN,13)="C"
"RTN","LRHBIN2",370,0)
 S LRFDA(1,LRFILE,LRIEN,12)=$G(LBTECH)
"RTN","LRHBIN2",371,0)
 ; Sets the site number in piece 8 of the Lab order file (#69)
"RTN","LRHBIN2",372,0)
 S LRFDA(1,LRFILE,LRIEN,25)=$G(DUZ(2))
"RTN","LRHBIN2",373,0)
 D FILE^DIE("","LRFDA(1)")
"RTN","LRHBIN2",374,0)
 ; Gets the Lab order Number
"RTN","LRHBIN2",375,0)
 S ORNUM=$$GET1^DIQ(LRFILE,LRIEN,9.5,"I")
"RTN","LRHBIN2",376,0)
 ; Builds the "AA" cross reference and sets it to the Urgency of the test ordered
"RTN","LRHBIN2",377,0)
 S ^LRO(69,"AA",+ORNUM,LRODT_"|"_LRSND)=$G(LRURG)
"RTN","LRHBIN2",378,0)
 Q
"RTN","LRHBIN2",379,0)
 ;
"RTN","LRHBIN2",380,0)
LROE2 ;
"RTN","LRHBIN2",381,0)
 ; Initialize Collection info in Node 1 under Order date and accession send number in File 69
"RTN","LRHBIN2",382,0)
 S LRFILE=69.01,LRIEN=DA_","_LRODT_","
"RTN","LRHBIN2",383,0)
 I '$$GET1^DIQ(LRFILE,LRIEN,.01,"I") S ^LRO(69,LRODT,1,DA,1)="^^^^^^^^^^^^^^^^"
"RTN","LRHBIN2",384,0)
 K LRSND
"RTN","LRHBIN2",385,0)
 S (LRSND,LRSND(DA))=+DA
"RTN","LRHBIN2",386,0)
 ; LRDFN points into Lab Results file (63).
"RTN","LRHBIN2",387,0)
 ; LRDPF identifies parent file; DFN points to patient in this file.
"RTN","LRHBIN2",388,0)
 S M9=$G(M9)+1
"RTN","LRHBIN2",389,0)
 S LRIEN=LRSND_","_LRODT_",",LRDFN=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN2",390,0)
 S LRFILE=63,LRIEN=LRDFN_","
"RTN","LRHBIN2",391,0)
 S LRDPF=$$GET1^DIQ(LRFILE,LRIEN,.02,"I"),DFN=$$GET1^DIQ(LRFILE,LRIEN,.03,"I")
"RTN","LRHBIN2",392,0)
 S LRSVSN=LRSND D ORDER S LRSND=LRSVSN
"RTN","LRHBIN2",393,0)
 Q
"RTN","LRHBIN2",394,0)
 ;
"RTN","LRHBIN2",395,0)
ORDER ;call with LRSND, from LROE, LROE1, LRORD1, LROW2, LROR1
"RTN","LRHBIN2",396,0)
 K D,LRTT S LREND=0
"RTN","LRHBIN2",397,0)
 S LRFILE=69.01,LRIEN=LRSND_","_LRODT_","
"RTN","LRHBIN2",398,0)
 S X=$$GET1^DIQ(LRFILE,LRIEN,3,"I")
"RTN","LRHBIN2",399,0)
 S LRFILE=62,LRIEN=X,X=$$GET1^DIQ(LRFILE,LRIEN,.01,"I") I X="" S X4=""
"RTN","LRHBIN2",400,0)
 S LRSEND=1,LRFILE=69.02,LRIEN=LRSEND_","_LRSND_","_LRODT_","
"RTN","LRHBIN2",401,0)
 S X=$$GET1^DIQ(LRFILE,LRIEN,.01,"I") I X="" S X4=""
"RTN","LRHBIN2",402,0)
 I X'="" S LRFILE=61,LRIEN=X,X4=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN2",403,0)
 S LRACN=0 F  S LRACN=$O(^LRO(69,LRODT,1,LRSND,2,LRACN)) Q:LRACN<1!($G(LREND))  I $D(^(LRACN,0))#2 S LRACN0=^(0)
"RTN","LRHBIN2",404,0)
 Q
"RTN","LRHBIN2",405,0)
 ;
"RTN","LRHBIN2",406,0)
GTSPACC(LRTEST,ST,DMIS) ;
"RTN","LRHBIN2",407,0)
 ;Add third parameter to GTSPACC line tag for DMIS number passed in.
"RTN","LRHBIN2",408,0)
 S ST=0,(AREA,TDMIS,DIV,ENT)=""
"RTN","LRHBIN2",409,0)
 I '$D(^LAB(60,LRTEST,8)) Q
"RTN","LRHBIN2",410,0)
 S DIV=0 F  S DIV=$O(^LAB(60,LRTEST,8,DIV)) Q:DIV=""  D
"RTN","LRHBIN2",411,0)
 .I DIV="" Q
"RTN","LRHBIN2",412,0)
 .S ENT=DIV_";DIC(4,"
"RTN","LRHBIN2",413,0)
 .S TDMIS=$$GET^XPAR(ENT,"JV SPECIAL ACCESSION AREA",1,"E")
"RTN","LRHBIN2",414,0)
 .I TDMIS="" Q
"RTN","LRHBIN2",415,0)
 .I DMIS="" Q
"RTN","LRHBIN2",416,0)
 .I DMIS'=TDMIS Q
"RTN","LRHBIN2",417,0)
 .S AREA=$P($G(^LAB(60,LRTEST,8,DIV,0)),D1,2)
"RTN","LRHBIN2",418,0)
 .I AREA="" Q
"RTN","LRHBIN2",419,0)
 .I '$D(^LRO(68,AREA)) Q
"RTN","LRHBIN2",420,0)
 .S ST=DIV
"RTN","LRHBIN2",421,0)
 Q
"RTN","LRHBIN2",422,0)
 ;
"RTN","LRHBIN2",423,0)
OLD(LRID) ;
"RTN","LRHBIN2",424,0)
 I LRNT="" D
"RTN","LRHBIN2",425,0)
 .N LRNT
"RTN","LRHBIN2",426,0)
 .S DT=$$DT^XLFDT()
"RTN","LRHBIN2",427,0)
 .D NOW^%DTC
"RTN","LRHBIN2",428,0)
 .S LRNT=%
"RTN","LRHBIN2",429,0)
 I $P(LRPARAM,U,4),'$D(LRNOLABL),'$D(LRTJ) D ^LRLABLIO
"RTN","LRHBIN2",430,0)
 D EN^LRHBIN4(LRID,LRTST,JVCDT)
"RTN","LRHBIN2",431,0)
 Q
"RTN","LRHBIN2",432,0)
 ;
"RTN","LRHBIN2",433,0)
RSORST(LRORD) ;
"RTN","LRHBIN2",434,0)
 N JVSN,JVSND,FLG
"RTN","LRHBIN2",435,0)
 S JVSN="",(FLG,JVSND)=0
"RTN","LRHBIN2",436,0)
 S JVSN=$O(^LRO(69,"C",LRORD,LRODT,JVSN)) Q:JVSN=""  D
"RTN","LRHBIN2",437,0)
 .S JVSND=0
"RTN","LRHBIN2",438,0)
 .F  S JVSND=$O(^LRO(69,LRODT,1,JVSN,2,JVSND)) Q:JVSND<1  D
"RTN","LRHBIN2",439,0)
 ..S JVX=^LRO(69,LRODT,1,JVSN,2,JVSND,0)
"RTN","LRHBIN2",440,0)
 ..I $P(JVX,U,4)="" D  Q:FLG
"RTN","LRHBIN2",441,0)
 ...;CHECK IF THIS TEST IS A PANEL TEST
"RTN","LRHBIN2",442,0)
 ...S JVT=$P(JVX,U)
"RTN","LRHBIN2",443,0)
 ...I $P($G(^LAB(60,JVT,2,0)),"^",3)>1 S FLG=1
"RTN","LRHBIN2",444,0)
 ..I $P(JVX,U,4)'="" Q
"RTN","LRHBIN2",445,0)
 ..S JVORN=$P(JVX,U,7)
"RTN","LRHBIN2",446,0)
 ..I $P(^OR(100,JVORN,3),U,3)=6 S $P(^OR(100,JVORN,3),U,3)=5
"RTN","LRHBIN2",447,0)
 K JVORN,JVSN,JVSND,JVX
"RTN","LRHBIN2",448,0)
 Q
"RTN","LRHBIN2",449,0)
 ;
"RTN","LRHBIN2",450,0)
END ;
"RTN","LRHBIN2",451,0)
 K AREA,CNT,COLST,D1,D2,DFN,DIC,DIE,DIV,DMIS,DLAYGO,DIR,DIRUT,ENT,FLAG,GOT,HLOBX,I,INST,J,LRACC,LRACN,LRACN0,LRAD,ARIV
"RTN","LRHBIN2",452,0)
 K LRAN,LRCDT,LRDA1,LRDFN,LRDPF,LRDT,LREND,LRLABLIO,LRLLOC,LRNT,LRCNT,LRIDT,LRNT,LRORN,LROD0,%,LRNOLABL,LRTJ
"RTN","LRHBIN2",453,0)
 K LROD1,LROD3,LROESTAT,LRORU3,LRPARAM,LRRSITE,LRSAMP,LRSD,LRSND,LRSEND,LRSPED,LRSS,LRSTATUS,LRODT0,LROLLOC
"RTN","LRHBIN2",454,0)
 K DMIS,LRSPEC,LRSVSN,LRTIM,LRTM7,LRTS,LRTST,LRTSTS,LRUID,LRUN,LRURG,LRX,LRZX,LT,M9,MSHSEG,ORCSEG,ORN,ORNUM
"RTN","LRHBIN2",455,0)
 K ORDNM,P2,P3,PIDSEG,PNM,RSITE,S1,S2,S3,S4,SITE,ST,STE,SUB,SSN,TDMIS,TMPDUZ,X4,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
"RTN","LRHBIN2",456,0)
 K DCORIG,IFN,ISNEWORD,JVTST,ORL,ORVP,ORNP,REAS,JVT,JVCDT,PNLTST,UID
"RTN","LRHBIN2",457,0)
 K COM,ORDATA,R,SIEN,TEST,TST
"RTN","LRHBIN2",458,0)
 Q
"RTN","LRHBIN2",459,0)
 ;
"RTN","LRHBIN2",460,0)
DBG ;
"RTN","LRHBIN2",461,0)
 K DBKIND,DBCNT
"RTN","LRHBIN2",462,0)
 D INT^JVHLDBG("JVLR",.DBKIND,.DBCNT)
"RTN","LRHBIN2",463,0)
 I DBKIND["I" D JVIN^JVHLDBG("JVLR",DBCNT,.REC)
"RTN","LRHBIN2",464,0)
 Q
"RTN","LRHBIN2",465,0)
 ;
"RTN","LRHBIN2",466,0)
DBGOUT ;
"RTN","LRHBIN2",467,0)
 I $D(JVOROUT),$G(DBCNT) D JVOUT^JVHLDBG("JVLR",DBCNT,.JVOROUT)
"RTN","LRHBIN2",468,0)
 Q
"RTN","LRHBIN2",469,0)
 ;
"RTN","LRHBIN3")
0^4^B46092527
"RTN","LRHBIN3",1,0)
LRHBIN3 ;SAIC/TCK- Orders Portability - Delete a test ; 4/19/16 8:33am
"RTN","LRHBIN3",2,0)
 ;;1.0;Orders Portability;;March 1, 2010;Build 19
"RTN","LRHBIN3",3,0)
 Q
"RTN","LRHBIN3",4,0)
ADD ;
"RTN","LRHBIN3",5,0)
 Q
"RTN","LRHBIN3",6,0)
 ;
"RTN","LRHBIN3",7,0)
 ;
"RTN","LRHBIN3",8,0)
EN(CHUID,JVTST,JVAA,JVAD,JVAN,ORNM) ;
"RTN","LRHBIN3",9,0)
 N LRACC,LRADL,LRTSAD,LRNATURE,LRORDTYP
"RTN","LRHBIN3",10,0)
 K LRPARAM D EN^LRPARAM
"RTN","LRHBIN3",11,0)
 I '$D(LRPARAM) D END Q
"RTN","LRHBIN3",12,0)
 ; Initialize flag for test added for auto download
"RTN","LRHBIN3",13,0)
 S LRADL=0
"RTN","LRHBIN3",14,0)
 ; If test added then check for automatic downloading
"RTN","LRHBIN3",15,0)
 I LRADL D EN^LA7ADL($P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3),0),"^")) S LRADL=0
"RTN","LRHBIN3",16,0)
 S (LRAA,LRAD,LRAN,LRSS)=""
"RTN","LRHBIN3",17,0)
 S LRACC=1
"RTN","LRHBIN3",18,0)
 I '$D(^LRO(68,"C",CHUID)) S JVOROUT(1)="-1^Error: No CHCS UID in HL7 MESSAGE" Q
"RTN","LRHBIN3",19,0)
 ;Populate LRAA,LRAD and LRAN with data from merge-to accession.
"RTN","LRHBIN3",20,0)
 K LRACC,LRTSAD,LRNATURE
"RTN","LRHBIN3",21,0)
 S LRAA=$O(^LRO(68,"C",CHUID,LRAA)),JVAA=LRAA
"RTN","LRHBIN3",22,0)
 S LRSS=$P(^LRO(68,LRAA,0),"^",2)
"RTN","LRHBIN3",23,0)
 S LRAD=$O(^LRO(68,"C",CHUID,LRAA,LRAD)),JVAD=LRAD
"RTN","LRHBIN3",24,0)
 S LRAN=$O(^LRO(68,"C",CHUID,LRAA,LRAD,LRAN)),JVAN=LRAN
"RTN","LRHBIN3",25,0)
 I LRAN<1 D END Q
"RTN","LRHBIN3",26,0)
 ;
"RTN","LRHBIN3",27,0)
 ;L +^LRO(68,LRAA,1,LRAD,1,LRAN):1 I '$T W !?5,"Someone else is editing this entry ",!,$C(7) G ADD1
"RTN","LRHBIN3",28,0)
 ;
"RTN","LRHBIN3",29,0)
 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRDFN=$P(X,U),LRAODT=$P(X,U,3),LRODT=$P(X,U,4),LRSN=$P(X,U,5),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
"RTN","LRHBIN3",30,0)
 S LRNATURE="4^SERVICE CORRECTION^99ORN",LRDPF=2
"RTN","LRHBIN3",31,0)
 ;
"RTN","LRHBIN3",32,0)
 S I=0
"RTN","LRHBIN3",33,0)
 F  S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1  W !,?5,$P(^LAB(60,I,0),U,1) S LRTSAD(1,I)=""
"RTN","LRHBIN3",34,0)
 ;
"RTN","LRHBIN3",35,0)
LRTSP ;
"RTN","LRHBIN3",36,0)
 S I="",I=$O(LRTSAD(1,I))
"RTN","LRHBIN3",37,0)
 S LRTSP=I
"RTN","LRHBIN3",38,0)
 ;
"RTN","LRHBIN3",39,0)
ADDTST ;
"RTN","LRHBIN3",40,0)
 S (LRTS,I)=JVTST I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0)) W !,"The accession already has this test."
"RTN","LRHBIN3",41,0)
 S LRTSUB=1 D EXPLD^LRTSTJM1 I $D(LRTSAD(1,LRTS)) W !,"The accession already has this test."
"RTN","LRHBIN3",42,0)
 S LRFLG=1 S (LRURG,Y)=6
"RTN","LRHBIN3",43,0)
 I LRURG'="" G SETTST
"RTN","LRHBIN3",44,0)
 ;
"RTN","LRHBIN3",45,0)
 ;
"RTN","LRHBIN3",46,0)
SETTST ;
"RTN","LRHBIN3",47,0)
 ; LRORDTYP=1(add)/2(reflex)^file #64.061 ien for code^if reflex parent test^if reflex parent NLT^
"RTN","LRHBIN3",48,0)
 S LRORDTYP="1^432"
"RTN","LRHBIN3",49,0)
 I $P(LRORDTYP,"^")=2 S $P(LRORDTYP,"^",3)=LRTSP,$P(LRORDTYP,"^",4)=$$NLT^LRVER1(LRTSP)
"RTN","LRHBIN3",50,0)
 I +LRDPF=2,$G(LRSS)'="BB",'$$CHKINP^LRBEBA4(LRDFN,LRODT) S LRBERF=$S(LRORDTYP>0:LRORDTYP-1,1:-1) ;CIDC
"RTN","LRHBIN3",51,0)
 D EN1
"RTN","LRHBIN3",52,0)
 Q
"RTN","LRHBIN3",53,0)
 ;
"RTN","LRHBIN3",54,0)
EN1 ;
"RTN","LRHBIN3",55,0)
 S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTS,0)=LRTS_"^"_LRURG,$P(^(0),U,9)=$G(LRTSP)
"RTN","LRHBIN3",56,0)
 S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",LRTS,LRTS)="",$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,4)=""
"RTN","LRHBIN3",57,0)
 S $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),U,3)=LRTS,$P(^(0),U,4)=$P(^(0),U,4)+1
"RTN","LRHBIN3",58,0)
 I $P(LRPARAM,U,14),$P(^LRO(68,LRAA,0),U,16) D CAP^LRWLST12
"RTN","LRHBIN3",59,0)
 S LRACD=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),"^",3),LRTSAD(1,LRTS)=""
"RTN","LRHBIN3",60,0)
 I LRACD,LRACD'=LRAD D
"RTN","LRHBIN3",61,0)
 .S ^LRO(68,LRAA,1,LRACD,1,LRAN,4,LRTS,0)=LRTS_"^"_LRURG,$P(^(0),U,9)=+LRTS
"RTN","LRHBIN3",62,0)
 .S ^LRO(68,LRAA,1,LRACD,1,LRAN,4,"B",LRTS,LRTS)="",$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),"^",4)=""
"RTN","LRHBIN3",63,0)
 .I $P(LRPARAM,U,14),$P(^LRO(68,LRAA,0),U,16) D CAP^LRWLST12
"RTN","LRHBIN3",64,0)
 D ORUT^LRTSTJM1(LRDFN,LRAA,LRAD,LRAN,LRTS,LRORDTYP,LRURG,LRODT,LRSN)
"RTN","LRHBIN3",65,0)
 S LRADL=1
"RTN","LRHBIN3",66,0)
 S DIC="^LRO(69,"_LRODT_",1,"_LRSN_",2,",DA(2)=LRODT,DA(1)=LRSN
"RTN","LRHBIN3",67,0)
 S DIC(0)="LOX",DLAYGO=69,X=$P(^LAB(60,LRTS,0),"^")
"RTN","LRHBIN3",68,0)
 D ^DIC
"RTN","LRHBIN3",69,0)
 ;
"RTN","LRHBIN3",70,0)
FILE69 ;
"RTN","LRHBIN3",71,0)
 I Y>0 D
"RTN","LRHBIN3",72,0)
 .N LRDIE,LRFDA,LRIENS,I
"RTN","LRHBIN3",73,0)
 .S LRXDA=+Y,LRIENS=LRXDA_","_LRSN_","_LRODT_","
"RTN","LRHBIN3",74,0)
 .S LRXDA(3)=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3))
"RTN","LRHBIN3",75,0)
 .S LRFDA(1,69.03,LRIENS,1)=$G(LRURG)
"RTN","LRHBIN3",76,0)
 .S LRFDA(1,69.03,LRIENS,2)=$G(LRAODT)
"RTN","LRHBIN3",77,0)
 .S LRFDA(1,69.03,LRIENS,3)=$G(LRAA)
"RTN","LRHBIN3",78,0)
 .S LRFDA(1,69.03,LRIENS,4)=$G(LRAN)
"RTN","LRHBIN3",79,0)
 .S LRFDA(1,69.03,LRIENS,8)="IP"
"RTN","LRHBIN3",80,0)
 .S LRFDA(1,69.03,LRIENS,9)="L"
"RTN","LRHBIN3",81,0)
 .I $P(LRXDA(3),"^")'="" D
"RTN","LRHBIN3",82,0)
 ..S LRFDA(1,69.03,LRIENS,13)=$P(LRXDA(3),"^")
"RTN","LRHBIN3",83,0)
 ..I $P(LRXDA(3),"^",2) F I=2:1:5 S LRFDA(1,69.03,LRIENS,I+12)=$P(LRXDA(3),"^",I)
"RTN","LRHBIN3",84,0)
 .D FILE^DIE("","LRFDA(1)","LRDIE(1)")
"RTN","LRHBIN3",85,0)
 .D:$G(LRTSP)
"RTN","LRHBIN3",86,0)
 ..S LRBETN=$O(^LRO(69,LRODT,1,LRSN,2,"B",LRTSP,""))
"RTN","LRHBIN3",87,0)
 ..I LRBETN D DADD^LRBEBA31(LRODT,LRSN,LRBETN,LRXDA,LRTS,$G(LRBERF))
"RTN","LRHBIN3",88,0)
 .K LRBETN,LRBERF
"RTN","LRHBIN3",89,0)
 ;
"RTN","LRHBIN3",90,0)
 I $G(LRXDA) D
"RTN","LRHBIN3",91,0)
 .N X
"RTN","LRHBIN3",92,0)
 .S X=1+$S($D(^LRO(69,LRODT,1,LRSN,2,LRXDA,1,0)):$P(^(0),"^",3),1:0),^(0)="^^"_X_"^"_DT,^(X,0)=" Added by "_$G(DUZ)_" on "_$$HTE^XLFDT($H,"M")
"RTN","LRHBIN3",93,0)
 .S ^LRO(69,"AA",+$G(^LRO(69,LRODT,1,LRSN,.1)),LRODT_"|"_LRSN)=""
"RTN","LRHBIN3",94,0)
 ;
"RTN","LRHBIN3",95,0)
 ;
"RTN","LRHBIN3",96,0)
SETOR ;
"RTN","LRHBIN3",97,0)
 N LTS S LTS(LRTS)=""
"RTN","LRHBIN3",98,0)
 D NEW^LR7OB1(LRODT,LRSN,"SN",$G(LRNATURE),.LTS,6)
"RTN","LRHBIN3",99,0)
 K DLAYGO,DA,DIC,DIE,DR,LRBERF,LRBEFN,LRBEX
"RTN","LRHBIN3",100,0)
 Q
"RTN","LRHBIN3",101,0)
 ;
"RTN","LRHBIN3",102,0)
END ;
"RTN","LRHBIN3",103,0)
 I $G(LRAA),$G(LRAD),$G(LRAN) L -^LRO(68,LRAA,1,LRAD,1,LRAN)
"RTN","LRHBIN3",104,0)
 K %,A,AGE,DD,DFN,DIC,DIE,DO,DOB,DR,I,K,LRAA,LRAD,LRACD,LRAN,LRCCOM,LRDFN,LRDPF,LREND,LRIDT,LRODT,LRSN,LRSS,LRTNM,LRTS,LRWRD,PNM,SEX,SSN,X,Y,Z,LRUSNM
"RTN","LRHBIN3",105,0)
 K %DT,%H,%X,%Y,DA,J,LRBED,LRCS,LRCSS,LRDTM,LRDTO,LRGVP,LRIDENT,LRIOZERO,LRLLOC,LRLWC,LRNOP,LRONE,LRORD,LRORDTIM,LROWLE,LRPR,LRTST,LRTP,LRTSN,LRUR,LRUSNM,LRWDT1,LRWL1,LRXD,POP,T
"RTN","LRHBIN3",106,0)
 K LRTSAD,LRTSUB,LRDATE,D,D0,D1,DN,LRAODT,LRFLG,LRRB,LRSAMP,LRTREA,LRTSP
"RTN","LRHBIN3",107,0)
 K LRURG,VA,LRX,LRBERF,LRBETN
"RTN","LRHBIN3",108,0)
 Q
"RTN","LRHBIN3",109,0)
 ;
"RTN","LRHBIN3",110,0)
CHK1 ;
"RTN","LRHBIN3",111,0)
 I $D(^LRO(68,LRWL1,1,LRWDT1,1,LRAN,3)),$P(^(3),U,4) S LREND=1 Q
"RTN","LRHBIN3",112,0)
 I $D(^LRO(69,LRODT,1,LRSN,3)),$P(^(3),U,2) S LREND=1 Q
"RTN","LRHBIN3",113,0)
 S LRTST=0 F  S LRTST=$O(^LRO(68,LRWL1,1,LRWDT1,1,LRAN,4,LRTST)) Q:LRTST<1  I $D(^(LRTST,0)),$P(^(0),U,5) S LREND=1 Q
"RTN","LRHBIN3",114,0)
 Q
"RTN","LRHBIN3",115,0)
 ;
"RTN","LRHBIN3",116,0)
CHKUID(ACCN,UID) ;
"RTN","LRHBIN3",117,0)
 B
"RTN","LRHBIN3",118,0)
 N FLG
"RTN","LRHBIN3",119,0)
 S FLG=0
"RTN","LRHBIN3",120,0)
 I $G(UID)'[" " S LUID=UID
"RTN","LRHBIN3",121,0)
 I '$D(^LRO(68,"B",JVLAA1)),ACCN'="" D GTVAUID(ACCN,.UID)
"RTN","LRHBIN3",122,0)
 Q:'UID
"RTN","LRHBIN3",123,0)
 S JVLAD=$P(UID," ",2),JVYR=$E(DT,1,3),JVLAD=JVYR_JVLAD
"RTN","LRHBIN3",124,0)
 S JVLAN=$P(UID," ",3)
"RTN","LRHBIN3",125,0)
 S JVACC=^LRO(68,JVLAA,1,JVLAD,1,JVLAN,.2)
"RTN","LRHBIN3",126,0)
 I JVACC'=UID S JVOROUT(1)="-1^ERROR: Accession number does not exist" Q
"RTN","LRHBIN3",127,0)
 S UID=$P(^LRO(68,JVLAA,1,JVLAD,1,JVLAN,.3),U)
"RTN","LRHBIN3",128,0)
 Q
"RTN","LRHBIN3",129,0)
 ;
"RTN","LRHBIN3",130,0)
GTVAUID(ACCN,UID) ;
"RTN","LRHBIN3",131,0)
 N SUB,JVDT,JVN
"RTN","LRHBIN3",132,0)
 S (UID,SUB,JVDT,JVN)=0
"RTN","LRHBIN3",133,0)
 Q:ACCN=""
"RTN","LRHBIN3",134,0)
 S SUB=$P(ACCN," ")
"RTN","LRHBIN3",135,0)
 S JVDT=$P(ACCN," ",2)
"RTN","LRHBIN3",136,0)
 S JVN=$P(ACCN," ",3)
"RTN","LRHBIN3",137,0)
 Q:SUB=""
"RTN","LRHBIN3",138,0)
 I $D(^LRO(68,"B",SUB)) S JVA=$O(^LRO(68,"B",SUB,""))
"RTN","LRHBIN3",139,0)
 I $L((JVDT)'>2) S JVYR=$E(DT,1,3),JVD=JVYR_"0000"
"RTN","LRHBIN3",140,0)
 I $L((JVDT)>2) S JVYR=$E(DT,1,3),JVDT=JVYR_JVDT
"RTN","LRHBIN3",141,0)
 Q:'$D(^LRO(68,JVA,1,JVDT,1,JVN))
"RTN","LRHBIN3",142,0)
 S IEN=JVN_","_JVDT_","_JVA_","
"RTN","LRHBIN3",143,0)
 S UID=$$GET1^DIQ(68.02,IEN,16,"I")
"RTN","LRHBIN3",144,0)
 Q
"RTN","LRHBIN3",145,0)
 ;
"RTN","LRHBIN3",146,0)
GTACC(RUID,JORD,JVACC,JVOLAD) ;
"RTN","LRHBIN3",147,0)
 N LRAA,LRAD,LRAN,LRORD
"RTN","LRHBIN3",148,0)
 S JVACC=0
"RTN","LRHBIN3",149,0)
 S LRAA="",LRAA=$O(^LRO(68,"C",RUID,LRAA))
"RTN","LRHBIN3",150,0)
 I LRAA'="" S LRAD="",LRAD=$O(^LRO(68,"C",RUID,LRAA,LRAD))
"RTN","LRHBIN3",151,0)
 I LRAD'="" S LRAN="",LRAN=$O(^LRO(68,"C",RUID,LRAA,LRAD,LRAN))
"RTN","LRHBIN3",152,0)
 I LRAN'="" S JVACC=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.2))
"RTN","LRHBIN3",153,0)
 S LRORD=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,.1))
"RTN","LRHBIN3",154,0)
 I LRORD=JORD S JVACC=0
"RTN","LRHBIN3",155,0)
 S JVOLAD=$O(^LRO(69,"C",LRORD,JVOLAD))
"RTN","LRHBIN3",156,0)
 Q
"RTN","LRHBIN3",157,0)
 ;
"RTN","LRHBIN3",158,0)
GETEXEC(EXEC) ;
"RTN","LRHBIN3",159,0)
 I EXEC=22 S EXEC=7
"RTN","LRHBIN3",160,0)
 I EXEC=25 S EXEC=7
"RTN","LRHBIN3",161,0)
 I EXEC=26 S EXEC=10
"RTN","LRHBIN3",162,0)
 I EXEC=27 S EXEC=9
"RTN","LRHBIN3",163,0)
 I EXEC=28 S EXEC=8
"RTN","LRHBIN3",164,0)
 I EXEC=59 S EXEC=8
"RTN","LRHBIN3",165,0)
 I EXEC=60 S EXEC=7
"RTN","LRHBIN3",166,0)
 I EXEC=61 S EXEC=23
"RTN","LRHBIN3",167,0)
 I EXEC=62 S EXEC=9
"RTN","LRHBIN3",168,0)
 I EXEC=63 S EXEC=10
"RTN","LRHBIN3",169,0)
 I EXEC=83 S EXEC=8
"RTN","LRHBIN3",170,0)
 Q
"RTN","LRHBIN3",171,0)
 ;
"RTN","LRHBIN3",172,0)
QUIT ;
"RTN","LRHBIN3",173,0)
 K AA,AN,AD,ARAY,COMP,D1,D2,DA,DFN,EXEC,HLARY,LVACC,JVLAA,JVLAA1,LVLAD
"RTN","LRHBIN3",174,0)
 K JVDATA,JVNDE,JVLAN,JVYR,JVTSP,LR1ODT,LR1SN,LRAODT,LRBERF,LRCCOM,LRDPT
"RTN","LRHBIN3",175,0)
 K LRDPF,LR1AA,LR1AD,LR1AN,LRAA,LRAD,LRAN,LRBETN,LRDATA,LRDFN,LRIDT1,LRIDT
"RTN","LRHBIN3",176,0)
 K LRLABKY,LRMSTATI,LRNATURE,JVACC,JVLAD
"RTN","LRHBIN3",177,0)
 K LRODT,LRORD,LRSEND,LRSN,LRT1SAD,LRTEST,LRTNM,LRTOACC,LRTS,LRSS,LRTSAD
"RTN","LRHBIN3",178,0)
 K LRTSN,LRTSP,LRURG,LRX1,LRXDA
"RTN","LRHBIN3",179,0)
 K ORDNM,OREND,ORGY,ORNATR,ORNDO,ORPK,ORSTS,SPEC,SPEC1,SS,SUBSC,X,Y
"RTN","LRHBIN3",180,0)
 Q
"RTN","LRHBIN3",181,0)
 ;
"RTN","LRHBIN4")
0^5^B55889278
"RTN","LRHBIN4",1,0)
LRHBIN4 ;LEIDOS/TCK- REMOTE ORDERING- Laboratory Accessioning process - main driver ; 6/15/16 5:32pm
"RTN","LRHBIN4",2,0)
 ;;1.0;Orders Portability;;March 1, 2010;Build 19
"RTN","LRHBIN4",3,0)
 ;
"RTN","LRHBIN4",4,0)
 Q
"RTN","LRHBIN4",5,0)
 ;
"RTN","LRHBIN4",6,0)
EN(LRID,JVTST,LRCDT) ;
"RTN","LRHBIN4",7,0)
 N LRPWL,LRPWDT,LRPWLE
"RTN","LRHBIN4",8,0)
 S (FLG,FLG1,DTIM)=0
"RTN","LRHBIN4",9,0)
 D DT^LRX
"RTN","LRHBIN4",10,0)
 Q:$G(LRKIL)
"RTN","LRHBIN4",11,0)
 D:$D(XRTL) T0^%ZOSV ; START RESPONSE TIME LOGGING
"RTN","LRHBIN4",12,0)
 ;CHECK IF LRSN POINTS TO A COMBINED ORDER
"RTN","LRHBIN4",13,0)
 S LRCDT=+^LRO(69,LRODT,1,LRSN,1),LREAL=$P(^(1),U,2),X=^(0),LRLLOC=$P(X,U,7),LROLLOC=$P(X,U,9),LRORIFN=$P(X,"^",11)
"RTN","LRHBIN4",14,0)
 I 'LRCDT S LRCDT=JVCDT
"RTN","LRHBIN4",15,0)
 S JVOD=1
"RTN","LRHBIN4",16,0)
 I '$D(^LRO(69,LRODT,1,LRSN,2,"B",JVTST)) D
"RTN","LRHBIN4",17,0)
 .I PNLTST S FLG1=1
"RTN","LRHBIN4",18,0)
 I FLG1 D FWL,FL69
"RTN","LRHBIN4",19,0)
 S LRSEND="",LRSEND=$O(^LRO(69,LRODT,1,LRSN,2,"B",JVTST,LRSEND))
"RTN","LRHBIN4",20,0)
 I $P(^LRO(69,LRODT,1,LRSN,2,LRSEND,0),U,6)'="" D
"RTN","LRHBIN4",21,0)
 .S LRTSN=""
"RTN","LRHBIN4",22,0)
 .F  S LRTSN=$O(^LRO(69,"C",LRORD,LRODT,LRTSN)) Q:LRTSN<1  D  Q:FLG
"RTN","LRHBIN4",23,0)
 ..S LBORY(LRORD,LRTSN)=""
"RTN","LRHBIN4",24,0)
 .S LRTSN="" F  S LRTSN=$O(LBORY(LRORD,LRTSN)) Q:LRTSN<1  D  Q:FLG
"RTN","LRHBIN4",25,0)
 ..I '$D(^LRO(69,LRODT,1,LRTSN,2,"B",JVTST)) S FLG=1 Q
"RTN","LRHBIN4",26,0)
 ..S LRSEND="",LRSEND=$O(^LRO(69,LRODT,1,LRTSN,2,"B",JVTST,LRSEND))
"RTN","LRHBIN4",27,0)
 ..S LRBACK=$P(^LRO(69,LRODT,1,LRTSN,2,LRSEND,0),U,14) I LRBACK="" Q
"RTN","LRHBIN4",28,0)
 ..S LRSN=LRTSN,FLG=1
"RTN","LRHBIN4",29,0)
 I $P(^LRO(69,LRODT,1,LRSN,2,0),U,3)>1 D
"RTN","LRHBIN4",30,0)
 .S FLG=0,LRSEND=0
"RTN","LRHBIN4",31,0)
 .F  S LRSEND=$O(^LRO(69,LRODT,1,LRSN,2,LRSEND)) Q:LRSEND<1  D  Q:FLG
"RTN","LRHBIN4",32,0)
 ..S LTACC=$G(^LRO(69,LRODT,1,LRSN,2,LRSEND,.3)) I LTACC="" Q
"RTN","LRHBIN4",33,0)
 ..S CHACC=$P(^LRO(69,LRODT,1,LRSN,2,LRSEND,.3),U)
"RTN","LRHBIN4",34,0)
 ..I CHACC'=LRID Q
"RTN","LRHBIN4",35,0)
 ..S LTX=^LRO(69,LRODT,1,LRSN,2,LRSEND,0)
"RTN","LRHBIN4",36,0)
 ..S TEST=$P(LTX,U),LRURG=$P(LTX,U,2),LRAD=$P(LTX,U,3),LRAA=$P(LTX,U,4),LRAN=$P(LTX,U,5),FLG=1
"RTN","LRHBIN4",37,0)
 ..I $D(^LAB(60,JVTST,8,DUZ(2))) S LRAA1=$P(^LAB(60,JVTST,8,DUZ(2),0),U,2)
"RTN","LRHBIN4",38,0)
 ..I LRAA="" S FLG=0 Q
"RTN","LRHBIN4",39,0)
 ..I LRAA1'=LRAA S FLG=0
"RTN","LRHBIN4",40,0)
 I FLG D
"RTN","LRHBIN4",41,0)
 .S LRACC=^LRO(68,LRAA,1,LRAD,1,LRAN,.2)
"RTN","LRHBIN4",42,0)
 .D LRAA
"RTN","LRHBIN4",43,0)
 .I LRAA="" S LRAA=0,LRAA=$O(LRTSTS(LRWLC,0,LRAA))
"RTN","LRHBIN4",44,0)
 .S LRIDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,5)
"RTN","LRHBIN4",45,0)
 .S LRPRAC=$P(^LRO(69,LRODT,1,LRSN,0),U,6)
"RTN","LRHBIN4",46,0)
 .S LRLBLBP=""
"RTN","LRHBIN4",47,0)
 .D:$G(LRTSTS)>0 ^LRWLST11
"RTN","LRHBIN4",48,0)
 .D EN^LA7ADL(LRID)
"RTN","LRHBIN4",49,0)
 I 'FLG D
"RTN","LRHBIN4",50,0)
 .D LRAA,EN^LRHBIN5(LRID)
"RTN","LRHBIN4",51,0)
 S LRCDT=(+LRCDT)_"^"_LREAL
"RTN","LRHBIN4",52,0)
 I '$L($P($G(^LRO(69,LRODT,1,LRSN,1)),"^",7)) S CONTROL=$S($L(LRORIFN):"SC",1:"SN") D NEW^LR7OB1(LRODT,LRSN,CONTROL,,,6)
"RTN","LRHBIN4",53,0)
 K LRTSTS,^TMP("LR",$J,"TMP"),LRNM,DIC,I,LRORIFN,LRBACK
"RTN","LRHBIN4",54,0)
 I $D(XRT0) S XRTN=$T(+0) D T1^%ZOSV ; STOP RESPONSE TIME LOGGING
"RTN","LRHBIN4",55,0)
 Q
"RTN","LRHBIN4",56,0)
 ;
"RTN","LRHBIN4",57,0)
GTTST() ;
"RTN","LRHBIN4",58,0)
 N ORN,FND,TST1,LRSND
"RTN","LRHBIN4",59,0)
 S (FND,TST,ORN,LRSND)=0
"RTN","LRHBIN4",60,0)
 I '$D(^LRO(69,LRODT,1,LRSN,2)) Q TST
"RTN","LRHBIN4",61,0)
 F  S LRSND=$O(^LRO(69,LRODT,1,LRSN,2,LRSND)) Q:LRSND=""!(FND)  D
"RTN","LRHBIN4",62,0)
 .S TST1=$P($G(^LRO(69,LRODT,1,LRSN,2,LRSND,0)),"^")
"RTN","LRHBIN4",63,0)
 .S ORN=$P($G(^LRO(69,LRODT,1,LRSN,2,LRSND,0)),"^",7)
"RTN","LRHBIN4",64,0)
 .I ORN=ORDNM S TST=TST1,FND=1
"RTN","LRHBIN4",65,0)
 Q TST
"RTN","LRHBIN4",66,0)
 ;
"RTN","LRHBIN4",67,0)
LRAA ;
"RTN","LRHBIN4",68,0)
 K LRTSTS,^TMP("LR",$J,"TMP")
"RTN","LRHBIN4",69,0)
 S LRTSTS=0,LRIX=0,S5=0,LRTN=0
"RTN","LRHBIN4",70,0)
 S LRTN="",LRTN=$O(^LRO(69,LRODT,1,LRSN,2,"B",JVTST,LRTN))
"RTN","LRHBIN4",71,0)
 I LRTN="" S LRTN=$G(LRSND)
"RTN","LRHBIN4",72,0)
 S LRX=^LRO(69,LRODT,1,LRSN,2,LRTN,0)
"RTN","LRHBIN4",73,0)
 I '$P(LRX,U,3),'$P(LRX,U,6),'$P(LRX,U,11) S LRORIFN=$P(LRX,"^",7),LRBACK=$P(LRX,"^",14) D SET
"RTN","LRHBIN4",74,0)
 ;
"RTN","LRHBIN4",75,0)
WL1 ;
"RTN","LRHBIN4",76,0)
 ; LRDAA is used by POC interface to specify the POC accession area.
"RTN","LRHBIN4",77,0)
 S LRIX=0
"RTN","LRHBIN4",78,0)
 F  S LRIX=$O(^TMP("LR",$J,"TMP",LRIX)) Q:LRIX<1  D
"RTN","LRHBIN4",79,0)
 . S X=^(LRIX),LRTSTS=+X,LRURG=$P(X,"^",2),LRORIFN=$P(X,"^",4),LRBACK=$P(X,"^",5)
"RTN","LRHBIN4",80,0)
 . S LRST=^LAB(60,LRTSTS,0)
"RTN","LRHBIN4",81,0)
 . S LRAA=$S($G(LRDAA)>0:LRDAA,$D(^LAB(60,LRTSTS,8,$S($G(LRDUZ(2))>0:LRDUZ(2),1:DUZ(2)),0)):$P(^(0),U,2),1:"")
"RTN","LRHBIN4",82,0)
 . S LRNM=$P(LRST,U),LRUNQ=+$P(LRST,U,7)
"RTN","LRHBIN4",83,0)
 . D WL2
"RTN","LRHBIN4",84,0)
 Q
"RTN","LRHBIN4",85,0)
 ;
"RTN","LRHBIN4",86,0)
WL2 ;
"RTN","LRHBIN4",87,0)
 I 'PNLTST,LRAA="" D GTLRAA(JVTST,.LRAA)
"RTN","LRHBIN4",88,0)
 D FWL:$G(LRAA)="" Q:LRAA=""
"RTN","LRHBIN4",89,0)
 S LRWL0=^LRO(68,LRAA,0),LRSS=$P(LRWL0,U,2),LRIDIV=$S($L($P(LRWL0,U,19)):$P(LRWL0,U,19),1:"CP")
"RTN","LRHBIN4",90,0)
 S LRPWL=$P($G(^LRO(68,LRAA,0)),U,4)
"RTN","LRHBIN4",91,0)
 S LRWLC=$P(LRWL0,U,4)
"RTN","LRHBIN4",92,0)
 S:'LRWLC LRWLC=LRAA
"RTN","LRHBIN4",93,0)
 S LRTSTS(LRWLC,LRUNQ,LRAA)=LRSS_U_$P(LRWL0,U,12),LRTSTS(LRWLC,LRUNQ,LRAA,LRIX)=^TMP("LR",$J,"TMP",LRIX)
"RTN","LRHBIN4",94,0)
 Q
"RTN","LRHBIN4",95,0)
 ;
"RTN","LRHBIN4",96,0)
GTLRAA(JVTST,LRAA) ;
"RTN","LRHBIN4",97,0)
 N CMPTST
"RTN","LRHBIN4",98,0)
 S CMPTST=0,LRAA=""
"RTN","LRHBIN4",99,0)
 I $O(^LAB(60,JVTST,2,0))>0 D
"RTN","LRHBIN4",100,0)
 .S I=0,I=$O(^LAB(60,JVTST,2,I)) Q:I=""
"RTN","LRHBIN4",101,0)
 .;GET ACCESSION AREA FROM 8 NODE OF FILE 60
"RTN","LRHBIN4",102,0)
 .S CMPTST=^LAB(60,JVTST,2,I,0)
"RTN","LRHBIN4",103,0)
 .Q:CMPTST=""
"RTN","LRHBIN4",104,0)
 .S LRAA=$P($G(^LAB(60,CMPTST,8,DUZ(2),0)),"^",2)
"RTN","LRHBIN4",105,0)
 Q
"RTN","LRHBIN4",106,0)
 ;
"RTN","LRHBIN4",107,0)
SET ;
"RTN","LRHBIN4",108,0)
 I $G(LRORDRR)="R" S LRTEST(LRTN)=$G(^LRO(69,LRODT,1,LRSN,2,LRTN,0))
"RTN","LRHBIN4",109,0)
 S S5=S5+1,I5=$G(^LRO(69,LRODT,1,LRSN,2,LRTN,0))
"RTN","LRHBIN4",110,0)
 I I5 S ^TMP("LR",$J,"TMP",S5)=$P(I5,U)_U_$P(I5,U,2)_U_LRTN_U_LRORIFN_U_LRBACK_U_$S($G(LRTSP):LRTSP,1:$P(I5,U)),I5=LRTN
"RTN","LRHBIN4",111,0)
 Q
"RTN","LRHBIN4",112,0)
 ;
"RTN","LRHBIN4",113,0)
FWL ;
"RTN","LRHBIN4",114,0)
 ;Get panel IEN from order number
"RTN","LRHBIN4",115,0)
 S LRIX=1
"RTN","LRHBIN4",116,0)
 I $O(^LAB(60,PNLTST,2,0))>0 D EXP S $P(^LRO(69,LRODT,1,LRSN,2,$P(^TMP("LR",$J,"TMP",LRIX),U,3),0),U,8)=1 Q
"RTN","LRHBIN4",117,0)
 Q
"RTN","LRHBIN4",118,0)
 ;
"RTN","LRHBIN4",119,0)
EXP ;
"RTN","LRHBIN4",120,0)
 N LRSEN
"RTN","LRHBIN4",121,0)
 S (I,I5,S5)=0,LRSEN=""
"RTN","LRHBIN4",122,0)
 F  S I=$O(^LAB(60,PNLTST,2,I)) Q:I<1!(S5)  D
"RTN","LRHBIN4",123,0)
 .S J=+^LAB(60,PNLTST,2,I,0)
"RTN","LRHBIN4",124,0)
 .Q:J'=JVTST
"RTN","LRHBIN4",125,0)
 .S S5=S5+1,I5=I5+1
"RTN","LRHBIN4",126,0)
 .S ^TMP("LR",$J,"TMP",S5)=J_"^"_LRURG_"^"_I5_"^"_ORDNM_"^^"_PNLTST
"RTN","LRHBIN4",127,0)
 .;Get panel test comment date and comments to add to component
"RTN","LRHBIN4",128,0)
 .I $D(^LRO(69,LRODT,1,LRSN,2,"B",PNLTST)) D
"RTN","LRHBIN4",129,0)
 ..S LRSEN="",LRSEN=$O(^LRO(69,LRODT,1,LRSN,2,"B",PNLTST,LRSEN))
"RTN","LRHBIN4",130,0)
 ..Q:$G(LRSEN)=""
"RTN","LRHBIN4",131,0)
 ..Q:'$D(^LRO(69,LRODT,1,LRSN,2,LRSEN,1.1))
"RTN","LRHBIN4",132,0)
 ..S CMTDT=$P(^LRO(69,LRODT,1,LRSN,2,LRSEN,1.1,0),"^",5)
"RTN","LRHBIN4",133,0)
 ..S CNT=0 F  S CNT=$O(^LRO(69,LRODT,1,LRSN,2,LRSEN,1.1,CNT)) Q:CNT<1  D
"RTN","LRHBIN4",134,0)
 ...Q:'$D(^LRO(69,LRODT,1,LRSN,2,LRSEN,1.1,CNT))
"RTN","LRHBIN4",135,0)
 ...S CMT(CNT)=^LRO(69,LRODT,1,LRSN,2,LRSEN,1.1,CNT,0)
"RTN","LRHBIN4",136,0)
 S LRIX=1
"RTN","LRHBIN4",137,0)
 Q
"RTN","LRHBIN4",138,0)
 ;
"RTN","LRHBIN4",139,0)
PRESET ;
"RTN","LRHBIN4",140,0)
 I '($D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))#2) K ^LRO(68,LRAA,1,LRAD,1,LRAN) Q
"RTN","LRHBIN4",141,0)
 S LROLRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
"RTN","LRHBIN4",142,0)
 I $L($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,5)) S LRDPF=$P(^LR(LROLRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
"RTN","LRHBIN4",143,0)
 S LRIDT=9999999-^LRO(68,LRAA,1,LRAD,1,LRAN,3)
"RTN","LRHBIN4",144,0)
 Q:'$D(^LR(LROLRDFN,LRSS,LRIDT,0))
"RTN","LRHBIN4",145,0)
 ;
"RTN","LRHBIN4",146,0)
PR2 ;
"RTN","LRHBIN4",147,0)
 S LRNIDT=9999999-LRCDT
"RTN","LRHBIN4",148,0)
 F  Q:'$D(^LR(LRDFN,LRSS,LRNIDT,0))  D
"RTN","LRHBIN4",149,0)
 . S LRCDT=$$FMADD^XLFDT(LRCDT,,,,1)
"RTN","LRHBIN4",150,0)
 . S LRNIDT=9999999-LRCDT
"RTN","LRHBIN4",151,0)
 I $P(^LR(LROLRDFN,LRSS,LRIDT,0),U,3) S LREND=1 W !,$C(7),"CAN'T DO IT. The data has been verified for that log number." Q
"RTN","LRHBIN4",152,0)
 S ^LR(LRDFN,LRSS,LRNIDT,0)=LRCDT_U_LREAL_U_$P(^LR(LROLRDFN,LRSS,LRIDT,0),U,3,4)_U_U_$P(^(0),U,6,99)
"RTN","LRHBIN4",153,0)
 S J=0 F  S J=$O(^LR(LROLRDFN,LRSS,LRIDT,J)) Q:J<1  S ^LR(LRDFN,LRSS,LRNIDT,J)=^LR(LROLRDFN,LRSS,LRIDT,J)
"RTN","LRHBIN4",154,0)
 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LROSN=$P(X,U,5),LROID=$P(X,U,6),LROCN=$S($D(^(.1)):$P(^(.1),U),1:"")
"RTN","LRHBIN4",155,0)
 K:$L(LROID) ^LRO(68,LRAA,1,LRAD,1,"C",LROID,LRAN)
"RTN","LRHBIN4",156,0)
 K:$L(LROCN) ^LRO(68,LRAA,1,LRAD,1,"D",LROCN,LRAN)
"RTN","LRHBIN4",157,0)
 K ^LRO(68,LRAA,1,LRAD,1,LRAN),^LR(LROLRDFN,LRSS,LRIDT)
"RTN","LRHBIN4",158,0)
 Q
"RTN","LRHBIN4",159,0)
 ;
"RTN","LRHBIN4",160,0)
OR ;from LRPHITEM
"RTN","LRHBIN4",161,0)
 I $G(LRORDRR)="R" S LRTEST(LRTN)=$G(^LRO(69,LRODT,1,LRSN,2,LRTN,0)) Q
"RTN","LRHBIN4",162,0)
 Q
"RTN","LRHBIN4",163,0)
 ;
"RTN","LRHBIN4",164,0)
FL69 ;
"RTN","LRHBIN4",165,0)
 N Y
"RTN","LRHBIN4",166,0)
 S (CNT,Y)=""
"RTN","LRHBIN4",167,0)
 F  S Y=$O(^TMP("LR",$J,"TMP",Y)) Q:Y=""  D
"RTN","LRHBIN4",168,0)
 .K LRIENS,LRMSG
"RTN","LRHBIN4",169,0)
 .S TST=$P($G(^TMP("LR",$J,"TMP",Y)),"^")
"RTN","LRHBIN4",170,0)
 .S LRURG=6
"RTN","LRHBIN4",171,0)
 .S IEN="?+1,"_LRSN_","_LRODT_","
"RTN","LRHBIN4",172,0)
 .S LRFDA(2,69.03,IEN,.01)=TST
"RTN","LRHBIN4",173,0)
 .S LRFDA(2,69.03,IEN,1)=$G(LRURG)
"RTN","LRHBIN4",174,0)
 .S LRFDA(2,69.03,IEN,6)=+ORDNM
"RTN","LRHBIN4",175,0)
 .D UPDATE^DIE("","LRFDA(2)","LRIENS","LRMSG")
"RTN","LRHBIN4",176,0)
 .;Set panel test comments into new component test nodes
"RTN","LRHBIN4",177,0)
 .I $G(LRIENS(1)) S LRIENS=LRIENS(1) D
"RTN","LRHBIN4",178,0)
 ..S ^LRO(69,LRODT,1,LRSN,2,LRIENS,1,0)=$G(CMTDT)
"RTN","LRHBIN4",179,0)
 ..Q:'$D(CMT)
"RTN","LRHBIN4",180,0)
 ..S CNT="" F  S CNT=$O(CMT(CNT)) Q:CNT<1  D
"RTN","LRHBIN4",181,0)
 ...S ^LRO(69,LRODT,1,LRSN,2,LRIENS,1,CNT,0)=$G(CMT(CNT))
"RTN","LRHBIN4",182,0)
 Q
"RTN","LRHBIN4",183,0)
 K JVOD
"RTN","LRHBIN4",184,0)
 ;
"RTN","LRHBIN4",185,0)
EXIT ;
"RTN","LRHBIN4",186,0)
 K CHACC,CONTROL,DFN,DTOUT,DUOUT,FLG,I5,J,LBORY,LRAA,LRACC,LRAA1,LRAN,LRDAA,LRDFN,LRCDT,LRAD
"RTN","LRHBIN4",187,0)
 K IEN,CMT,CNT,FLG1,IEN,LRDUZ,LREAL,LREND,LRIDIV,LRIDT,LRIEN,LRIFN,LRDPF,LRIX,LRKILL,LRKIL
"RTN","LRHBIN4",188,0)
 K JVCDT,LRFDA,ORDNM,PNLTST,TST,LRNIDT,LRNCWL,LRLLOC,LROCN,LRODT,LROID,LROLLOC,LROLRDFN,LRPHSET,LRPRAC
"RTN","LRHBIN4",189,0)
 K LRQUIET,LRORD,LRORDRR,LROSN,LRSEND,LRSN,LRSS,LRST,LRTEST,LRTN,LRTSN,LRTSP,LRX,LTACC,LTX
"RTN","LRHBIN4",190,0)
 K CMTDT,LRUNQ,LRURG,LRWLC,LRWL0,LRWO,PNM,SSN,S5,TEST,X,XRT0,XRTL,XRTN,XRTO,Y
"RTN","LRHBIN4",191,0)
 Q
"RTN","LRHBIN4",192,0)
 ;
"RTN","LRHBIN5")
0^6^B60470966
"RTN","LRHBIN5",1,0)
LRHBIN5 ;SAIC/TCK- Orders Portability - Laboratory Accessioning Process ; 4/19/16 8:34am
"RTN","LRHBIN5",2,0)
 ;;1.0;Orders Portability;;March 1, 2010;Build 19
"RTN","LRHBIN5",3,0)
 ;
"RTN","LRHBIN5",4,0)
 Q
"RTN","LRHBIN5",5,0)
 ;
"RTN","LRHBIN5",6,0)
EN(LRID) ;
"RTN","LRHBIN5",7,0)
 S (DTIME,LRWLC)=0
"RTN","LRHBIN5",8,0)
 F  S LRWLC=$O(LRTSTS(LRWLC)) Q:LRWLC<1  S LRAD=DT D SPLIT
"RTN","LRHBIN5",9,0)
 ;
"RTN","LRHBIN5",10,0)
 ;If LEDI and comments came with order then copy to order in #69
"RTN","LRHBIN5",11,0)
 I $G(LRORDRR)="R",$G(LR696),$D(^LRO(69.6,LR696,99)) D
"RTN","LRHBIN5",12,0)
 . N LRDIE
"RTN","LRHBIN5",13,0)
 . D WP^DIE(69.01,LRSN_","_LRODT_",",16,"A","^LRO(69.6,LR696,99)","LRDIE(16)")
"RTN","LRHBIN5",14,0)
 ;
"RTN","LRHBIN5",15,0)
 K DIC,DLAYGO,DR,DA,DIE,LRIXX
"RTN","LRHBIN5",16,0)
 Q:$G(LRORDR)="P"
"RTN","LRHBIN5",17,0)
 K LRNM,LRTSTS
"RTN","LRHBIN5",18,0)
 K ^TMP("LR",$J,"TMP")
"RTN","LRHBIN5",19,0)
 Q
"RTN","LRHBIN5",20,0)
 ;
"RTN","LRHBIN5",21,0)
SPLIT ;
"RTN","LRHBIN5",22,0)
 N LRAA,LRX
"RTN","LRHBIN5",23,0)
 ; Setup regular accessions (LRUNQ=0)
"RTN","LRHBIN5",24,0)
 S LRUNQ=0,LREND=0
"RTN","LRHBIN5",25,0)
 I $D(LRTSTS(LRWLC,0)) D
"RTN","LRHBIN5",26,0)
 . D GTWLN
"RTN","LRHBIN5",27,0)
 . I LREND Q
"RTN","LRHBIN5",28,0)
 . S LRAA=0
"RTN","LRHBIN5",29,0)
 . F  S LRAA=$O(LRTSTS(LRWLC,0,LRAA)) Q:LRAA<1  D
"RTN","LRHBIN5",30,0)
 . . S LRSS=LRTSTS(LRWLC,0,LRAA)
"RTN","LRHBIN5",31,0)
 . . D STWLN,ST2,^LRWLST11,EN^LA7ADL(LRID)
"RTN","LRHBIN5",32,0)
 . . ;S LRTS="",LRIX=0
"RTN","LRHBIN5",33,0)
 . . ;F  S LRIX=$O(LRTSTS(LRWLC,LRUNQ,LRAA,LRIX)) Q:LRIX<1  D
"RTN","LRHBIN5",34,0)
 . . . ;D SET^LRWLST11 Q:LRUNQ
"RTN","LRHBIN5",35,0)
 . . . ;D SCDT^LRWLST11,SLRSS^LRWLST11,COMMON^LRWLST11,EN^LA7ADL(LRID)
"RTN","LRHBIN5",36,0)
 . D SICA^LRWLST11
"RTN","LRHBIN5",37,0)
 ;
"RTN","LRHBIN5",38,0)
 ; Setup accessions requiring 'unique' accession numbers (LRUNQ=1)
"RTN","LRHBIN5",39,0)
 S LRUNQ=1,LRAA=0
"RTN","LRHBIN5",40,0)
 F  S LRAA=$O(LRTSTS(LRWLC,1,LRAA)) Q:LRAA<1  D
"RTN","LRHBIN5",41,0)
 . S LRSS=LRTSTS(LRWLC,1,LRAA)
"RTN","LRHBIN5",42,0)
 . F  D GTWLN Q:LREND  D   Q:$O(LRTSTS(LRWLC,1,LRAA,0))<1
"RTN","LRHBIN5",43,0)
 . . D STWLN,ST2,^LRWLST11,EN^LA7ADL(LRUID),SICA^LRWLST11
"RTN","LRHBIN5",44,0)
 Q
"RTN","LRHBIN5",45,0)
 ;
"RTN","LRHBIN5",46,0)
 ;
"RTN","LRHBIN5",47,0)
STWLN ; Set accession number
"RTN","LRHBIN5",48,0)
 ;
"RTN","LRHBIN5",49,0)
 D GETLOCK(LRAA,LRAD)
"RTN","LRHBIN5",50,0)
 D CHECK68(LRAA,LRAD)
"RTN","LRHBIN5",51,0)
 ;
"RTN","LRHBIN5",52,0)
 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
"RTN","LRHBIN5",53,0)
 ;
"RTN","LRHBIN5",54,0)
 ; Handle 'in common' area that was not setup in GTWLN call.
"RTN","LRHBIN5",55,0)
 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN)) D SETAN(LRAA,LRAD,LRAN)
"RTN","LRHBIN5",56,0)
 ;
"RTN","LRHBIN5",57,0)
 S LREND=0,LRLBLBP=1-$P(LRSS,U,2),LRSS=$P(LRSS,U)
"RTN","LRHBIN5",58,0)
 S LRACC=$P(^LRO(68,LRAA,0),U,11)_" "_$S(LRAD["0000":$E(LRAD,2,3),1:$E(LRAD,4,7))_" "_LRAN
"RTN","LRHBIN5",59,0)
 S LRPRAC=""
"RTN","LRHBIN5",60,0)
 I $D(^LRO(69,LRODT,1,LRSN,0)) S LRPRAC=$P(^(0),U,6) S:$D(LRNT) ^(3)=LRNT
"RTN","LRHBIN5",61,0)
 ;
"RTN","LRHBIN5",62,0)
 ; Location type
"RTN","LRHBIN5",63,0)
 S LRCAPLOC=$P($G(^SC(+LROLLOC,0)),U,3)
"RTN","LRHBIN5",64,0)
 I LRCAPLOC="" S LRCAPLOC="Z"
"RTN","LRHBIN5",65,0)
 ;
"RTN","LRHBIN5",66,0)
 ; File information in file #68 for this accession
"RTN","LRHBIN5",67,0)
 N LRFDA,LR6802,LRDIE
"RTN","LRHBIN5",68,0)
 S LR6802=LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN5",69,0)
 S LRFDA(1,68.02,LR6802,.01)=LRDFN
"RTN","LRHBIN5",70,0)
 S LRFDA(1,68.02,LR6802,1)=LRDPF
"RTN","LRHBIN5",71,0)
 S LRFDA(1,68.02,LR6802,2)=LRAD
"RTN","LRHBIN5",72,0)
 S LRFDA(1,68.02,LR6802,3)=LRODT
"RTN","LRHBIN5",73,0)
 S LRFDA(1,68.02,LR6802,4)=LRSN
"RTN","LRHBIN5",74,0)
 S LRFDA(1,68.02,LR6802,6)=LRLLOC
"RTN","LRHBIN5",75,0)
 S X=$G(^LRO(69,LRODT,1,LRSN,.1)) I X'="" S LRFDA(1,68.02,LR6802,14)=X
"RTN","LRHBIN5",76,0)
 ;
"RTN","LRHBIN5",77,0)
 ; No ordering provider/location on controls
"RTN","LRHBIN5",78,0)
 I LRDPF'=62.3 D
"RTN","LRHBIN5",79,0)
 . S LRFDA(1,68.02,LR6802,6.5)=LRPRAC
"RTN","LRHBIN5",80,0)
 . S LRFDA(1,68.02,LR6802,94)=LROLLOC
"RTN","LRHBIN5",81,0)
 ;
"RTN","LRHBIN5",82,0)
 ; Only store treating specialty on file #2 patients
"RTN","LRHBIN5",83,0)
 ; If no treating specialty then use specialty from file #44 location
"RTN","LRHBIN5",84,0)
 I LRDPF=2 D
"RTN","LRHBIN5",85,0)
 . S LRTREA=$P($G(^DPT(DFN,.103)),U)
"RTN","LRHBIN5",86,0)
 . I 'LRTREA S LRTREA=$P($G(^SC(+LROLLOC,0)),U,20)
"RTN","LRHBIN5",87,0)
 . I LRTREA S LRFDA(1,68.02,LR6802,6.6)=LRTREA
"RTN","LRHBIN5",88,0)
 ;
"RTN","LRHBIN5",89,0)
 S LRFDA(1,68.02,LR6802,6.7)=DUZ
"RTN","LRHBIN5",90,0)
 S LRFDA(1,68.02,LR6802,15)=LRACC
"RTN","LRHBIN5",91,0)
 S LRFDA(1,68.02,LR6802,26)=DUZ(2)
"RTN","LRHBIN5",92,0)
 S LRFDA(1,68.02,LR6802,92)=LRCAPLOC
"RTN","LRHBIN5",93,0)
 D FILE^DIE("","LRFDA(1)","LRDIE(1)")
"RTN","LRHBIN5",94,0)
 I $D(LRDIE(1)) D MAILALRT^LRWLST12("STWLN~LRWLST1")
"RTN","LRHBIN5",95,0)
 ;
"RTN","LRHBIN5",96,0)
 ; If specimen defined then set nodes, force to ien=1 since many lab
"RTN","LRHBIN5",97,0)
 ; routines expect the specimen to be record number 1.
"RTN","LRHBIN5",98,0)
 I $G(LRSPEC) D
"RTN","LRHBIN5",99,0)
 . N LRFDAIEN,LRLOCKOK,LRLOOPCT
"RTN","LRHBIN5",100,0)
 . S LRFDAIEN(1)=1
"RTN","LRHBIN5",101,0)
 . S LRFDA(2,68.05,"+1,"_LR6802,.01)=LRSPEC
"RTN","LRHBIN5",102,0)
 . S LRFDA(2,68.05,"+1,"_LR6802,1)=$P(LRSAMP,";",1)
"RTN","LRHBIN5",103,0)
 . ;
"RTN","LRHBIN5",104,0)
 . ; Modification to prevent lock failures - loop 10 times to give system a chance to get lock
"RTN","LRHBIN5",105,0)
 . S LRLOCKOK=0
"RTN","LRHBIN5",106,0)
 . F LRLOOPCT=1:1:10 D  Q:LRLOCKOK
"RTN","LRHBIN5",107,0)
 . . D UPDATE^DIE("","LRFDA(2)","LRFDAIEN","LRDIE(2)")
"RTN","LRHBIN5",108,0)
 . . I $G(LRDIE(2,"DIERR")),LRDIE(2,"DIERR",1)<120  H 5 K:LRLOOPCT<10 LRDIE(2)
"RTN","LRHBIN5",109,0)
 . . E  S LRLOCKOK=1
"RTN","LRHBIN5",110,0)
 . ;
"RTN","LRHBIN5",111,0)
 . I $D(LRDIE(2)) D MAILALRT^LRWLST12("STWLN~LRWLST1")
"RTN","LRHBIN5",112,0)
 ;
"RTN","LRHBIN5",113,0)
 ; If no specimen defined then use specimen values from file #69.
"RTN","LRHBIN5",114,0)
 I $G(LRSPEC)="",$D(^LRO(69,LRODT,1,LRSN,4,0)) D
"RTN","LRHBIN5",115,0)
 . N LRFDA,LRFDAIEN,LRI,LRX
"RTN","LRHBIN5",116,0)
 . S LRI=0
"RTN","LRHBIN5",117,0)
 . F  S LRI=$O(^LRO(69,LRODT,1,LRSN,4,LRI)) Q:'LRI  D
"RTN","LRHBIN5",118,0)
 . . S LRFDAIEN(1)=LRI,LRX=$G(^LRO(69,LRODT,1,LRSN,4,LRI,0))
"RTN","LRHBIN5",119,0)
 . . S LRFDA(LRI,68.05,"+1,"_LR6802,.01)=$P(LRX,"^")
"RTN","LRHBIN5",120,0)
 . . D UPDATE^DIE("","LRFDA(LRI)","LRFDAIEN","LRDIE(LRI)")
"RTN","LRHBIN5",121,0)
 . . I $D(LRDIE(LRI)) D MAILALRT^LRWLST12("STWLN~LRWLST1")
"RTN","LRHBIN5",122,0)
 ;
"RTN","LRHBIN5",123,0)
 ; Create UID.
"RTN","LRHBIN5",124,0)
 S LRUID=$$LRUID^LRX(LRAA,LRAD,LRAN)
"RTN","LRHBIN5",125,0)
 I '$D(LRPHSET),('$G(LRQUIET)) W !!,"ACCESSION:  ",LRACC,"  <",LRUID,">"
"RTN","LRHBIN5",126,0)
 D UPD696
"RTN","LRHBIN5",127,0)
 ;
"RTN","LRHBIN5",128,0)
 L -^LRO(68,LRAA,1,LRAD,1,0)
"RTN","LRHBIN5",129,0)
 Q
"RTN","LRHBIN5",130,0)
 ;
"RTN","LRHBIN5",131,0)
 ;
"RTN","LRHBIN5",132,0)
UPD696 ; Update file #69.6 if LEDI referral patient and no existing entry
"RTN","LRHBIN5",133,0)
 K LR696IEN
"RTN","LRHBIN5",134,0)
 I $G(LRORDRR)="R" D
"RTN","LRHBIN5",135,0)
 . S LR696IEN=0
"RTN","LRHBIN5",136,0)
 . I $G(LRRSITE("SMID"))'="",$G(LRSD("RUID"))'="" S LR696IEN=+$O(^LRO(69.6,"AD",LRRSITE("SMID"),LRSD("RUID"),0))
"RTN","LRHBIN5",137,0)
 . I LR696IEN Q
"RTN","LRHBIN5",138,0)
 . I '$G(LRRSTAT(0)) S LRRSTAT(0)=$$FIND1^DIC(64.061,"","OMX","Specimenin process","","I $P(^LAB(64.061,Y,0),U,7)=""U""")
"RTN","LRHBIN5",139,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","LRHBIN5",140,0)
 Q
"RTN","LRHBIN5",141,0)
 ;
"RTN","LRHBIN5",142,0)
 ;
"RTN","LRHBIN5",143,0)
ST2 ; Find next available node in LR global
"RTN","LRHBIN5",144,0)
 ;
"RTN","LRHBIN5",145,0)
 N LRFDA,LRFDAIEN,LRDIE,LRX,LRXIDT
"RTN","LRHBIN5",146,0)
 ; Autopsy ("AU") is not a multiple - do not attempt to set in ^LR global
"RTN","LRHBIN5",147,0)
 I LRSS="AU" S LRIDT=0 Q
"RTN","LRHBIN5",148,0)
 ;
"RTN","LRHBIN5",149,0)
 S LRIDT=0
"RTN","LRHBIN5",150,0)
 F  D  Q:LRIDT
"RTN","LRHBIN5",151,0)
 . S LRXIDT=9999999-LRCDT
"RTN","LRHBIN5",152,0)
 . L +^LR(LRDFN,LRSS,LRXIDT,0):5
"RTN","LRHBIN5",153,0)
 . I '$T S LRCDT=$$FMADD^XLFDT(LRCDT,0,0,0,1) Q
"RTN","LRHBIN5",154,0)
 . I '$D(^LR(LRDFN,LRSS,LRXIDT,0)) S LRIDT=LRXIDT Q
"RTN","LRHBIN5",155,0)
 . L -^LR(LRDFN,LRSS,LRXIDT,0)
"RTN","LRHBIN5",156,0)
 . S LRCDT=$$FMADD^XLFDT(LRCDT,0,0,0,1)
"RTN","LRHBIN5",157,0)
 ;
"RTN","LRHBIN5",158,0)
 ; Create entry in appropriate subscript in LAB DATA file (#63).
"RTN","LRHBIN5",159,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","LRHBIN5",160,0)
 S LRFDAIEN(1)=LRIDT
"RTN","LRHBIN5",161,0)
 S LRFDA(63,LRX,"+1,"_LRDFN_",",.01)=LRCDT
"RTN","LRHBIN5",162,0)
 S LRFDA(63,LRX,"+1,"_LRDFN_",",.06)=LRACC
"RTN","LRHBIN5",163,0)
 I LRSS'="CH" D
"RTN","LRHBIN5",164,0)
 . S LRFDA(63,LRX,"+1,"_LRDFN_",",.1)=LRNT
"RTN","LRHBIN5",165,0)
 . S LRFDA(63,LRX,"+1,"_LRDFN_",",.08)=LRLLOC
"RTN","LRHBIN5",166,0)
 I LRSS="CH" D
"RTN","LRHBIN5",167,0)
 . S LRFDA(63,LRX,"+1,"_LRDFN_",",.12)=3
"RTN","LRHBIN5",168,0)
 . S LRFDA(63,LRX,"+1,"_LRDFN_",",.11)=LRLLOC
"RTN","LRHBIN5",169,0)
 I LRSS="MI" S LRFDA(63,LRX,"+1,"_LRDFN_",",38)=3
"RTN","LRHBIN5",170,0)
 I "SPCYEM"[LRSS N LRABV S LRABV=$P(LRACC," ")
"RTN","LRHBIN5",171,0)
 I LRX D UPDATE^DIE("","LRFDA(63)","LRFDAIEN","LRDIE(63)")
"RTN","LRHBIN5",172,0)
 I $D(LRDIE(63)) D MAILALRT^LRWLST12("ST2~LRWLST1")
"RTN","LRHBIN5",173,0)
 ;
"RTN","LRHBIN5",174,0)
 ; Uncomment following code when new field .9 in"MI" subscript is released
"RTN","LRHBIN5",175,0)
 ;I LRSS="MI" D
"RTN","LRHBIN5",176,0)
 ;. N LRN,ERR,IENS
"RTN","LRHBIN5",177,0)
 ;. S IENS=LRIDT_","_LRDFN_",",LRN=0
"RTN","LRHBIN5",178,0)
 ;. F  S LRN=$O(^LRO(69,LRODT,1,LRSN,2,LRN)) Q:LRN<1  D
"RTN","LRHBIN5",179,0)
 ;. . I '$D(^LRO(69,LRODT,1,LRSN,2,LRN,1,0)) Q
"RTN","LRHBIN5",180,0)
 ;. . D WP^DIE(63.05,IENS,.9,"A","^LRO(69,"_LRODT_",1,"_LRSN_",2,"_LRN_",1)","ERR")
"RTN","LRHBIN5",181,0)
 ;
"RTN","LRHBIN5",182,0)
 L -^LR(LRDFN,LRSS,LRIDT,0)
"RTN","LRHBIN5",183,0)
 ;
"RTN","LRHBIN5",184,0)
 Q
"RTN","LRHBIN5",185,0)
 ;
"RTN","LRHBIN5",186,0)
 ;
"RTN","LRHBIN5",187,0)
GTWLN ;
"RTN","LRHBIN5",188,0)
 N X
"RTN","LRHBIN5",189,0)
 ;
"RTN","LRHBIN5",190,0)
 ; Execute accession transform for this area.
"RTN","LRHBIN5",191,0)
 S LRAN=0
"RTN","LRHBIN5",192,0)
 S X=$G(^LRO(68,LRWLC,.1)) X:X'="" X
"RTN","LRHBIN5",193,0)
 ;
"RTN","LRHBIN5",194,0)
 D GETLOCK(LRWLC,LRAD)
"RTN","LRHBIN5",195,0)
 D CHECK68(LRWLC,LRAD)
"RTN","LRHBIN5",196,0)
 ;
"RTN","LRHBIN5",197,0)
 S:'LRAN LRAN=1+$P($G(^LRO(68,LRWLC,1,LRAD,1,0)),U,3)
"RTN","LRHBIN5",198,0)
 I "CYEMSP"'[LRSS F  Q:'$D(^LRO(68,LRWLC,1,LRAD,1,LRAN))  S LRAN=LRAN+1
"RTN","LRHBIN5",199,0)
 ; check for AP Accessions
"RTN","LRHBIN5",200,0)
 I "CYEMSP"[LRSS F  Q:'$D(^LRO(68,LRWLC,1,LRAD,1,LRAN))&'$D(^LR("A"_LRSS_"A",$E(LRAD,1,3),LRAN))  S LRAN=LRAN+1
"RTN","LRHBIN5",201,0)
 D SETAN(LRWLC,LRAD,LRAN)
"RTN","LRHBIN5",202,0)
 L -^LRO(68,LRWLC,1,LRAD,1,0)
"RTN","LRHBIN5",203,0)
 Q
"RTN","LRHBIN5",204,0)
 ;
"RTN","LRHBIN5",205,0)
 ;
"RTN","LRHBIN5",206,0)
CHECK68(LRAA,LRAD) ; Check for/set header node of ^LRO(68) 68.01 subfile.
"RTN","LRHBIN5",207,0)
 ;
"RTN","LRHBIN5",208,0)
 ; Call with LRAA = ien of entry in file #68
"RTN","LRHBIN5",209,0)
 ;           LRAD = accession date in fileman format
"RTN","LRHBIN5",210,0)
 ;
"RTN","LRHBIN5",211,0)
 ; Set accession date in file #68 for this accession.
"RTN","LRHBIN5",212,0)
 ; Check for existence of accession number multiple but not accession date multiple,
"RTN","LRHBIN5",213,0)
 ; FileMan DBS call fails when accession number multiple exists but accession date multiple does not.
"RTN","LRHBIN5",214,0)
 ; If this condition found then set missing node directly and quit.
"RTN","LRHBIN5",215,0)
 ;
"RTN","LRHBIN5",216,0)
 I '$D(^LRO(68,LRAA,1,LRAD,0)) D
"RTN","LRHBIN5",217,0)
 . N LRFDA,LRFDAIEN,LRDIE,X
"RTN","LRHBIN5",218,0)
 . S X=$Q(^LRO(68,LRAA,1,LRAD,0))
"RTN","LRHBIN5",219,0)
 . I X'="",$QS(X,4)=LRAD S $P(^LRO(68,LRAA,1,LRAD,0),"^")=LRAD Q
"RTN","LRHBIN5",220,0)
 . S (LRFDAIEN(1),LRFDA(1,68.01,"+1,"_LRAA_",",.01))=LRAD
"RTN","LRHBIN5",221,0)
 . D UPDATE^DIE("","LRFDA(1)","LRFDAIEN","LRDIE(1)")
"RTN","LRHBIN5",222,0)
 . I $D(LRDIE(1)) D MAILALRT^LRWLST12("CHECK~LRWLST1")
"RTN","LRHBIN5",223,0)
 ;
"RTN","LRHBIN5",224,0)
 Q
"RTN","LRHBIN5",225,0)
 ;
"RTN","LRHBIN5",226,0)
 ;
"RTN","LRHBIN5",227,0)
GETLOCK(LRAA,LRAD) ; Obtain lock on zeroth node of this accession date
"RTN","LRHBIN5",228,0)
 ; Call with LRAA = ien of entry in file #68
"RTN","LRHBIN5",229,0)
 ;           LRAD = accession date in fileman format
"RTN","LRHBIN5",230,0)
 ;
"RTN","LRHBIN5",231,0)
 F  L +^LRO(68,LRAA,1,LRAD,1,0):10 Q:$T  D
"RTN","LRHBIN5",232,0)
 . I $D(ZTQUEUED)!($G(LRQUIET)) Q
"RTN","LRHBIN5",233,0)
 . W !!?5,"Accession area ",$P(^LRO(68,LRAA,0),"^")," is locked by another user.",!,$C(7)
"RTN","LRHBIN5",234,0)
 Q
"RTN","LRHBIN5",235,0)
 ;
"RTN","LRHBIN5",236,0)
 ;
"RTN","LRHBIN5",237,0)
SETAN(LRAA,LRAD,LRAN) ; Create stub entry in file #68 for this accession.
"RTN","LRHBIN5",238,0)
 ;
"RTN","LRHBIN5",239,0)
 ; Call with LRAA = ien of entry in file #68
"RTN","LRHBIN5",240,0)
 ;           LRAD = accession date in fileman format
"RTN","LRHBIN5",241,0)
 ;           LRAN = accession number
"RTN","LRHBIN5",242,0)
 ;
"RTN","LRHBIN5",243,0)
 N LR6802,LRFDA,LRFDAIEN,LRDIE,LRLOCKOK,LRLOOPCT
"RTN","LRHBIN5",244,0)
 S LR6802=LRAD_","_LRAA_","
"RTN","LRHBIN5",245,0)
 S LRFDAIEN(1)=LRAN
"RTN","LRHBIN5",246,0)
 S LRFDA(2,68.02,"+1,"_LR6802,.01)=LRDFN
"RTN","LRHBIN5",247,0)
 ;
"RTN","LRHBIN5",248,0)
 ; Modification to prevent lock failures - loop 10 times to give system a chance to get lock
"RTN","LRHBIN5",249,0)
 S LRLOCKOK=0
"RTN","LRHBIN5",250,0)
 F LRLOOPCT=1:1:10 D  Q:LRLOCKOK
"RTN","LRHBIN5",251,0)
 . D UPDATE^DIE("","LRFDA(2)","LRFDAIEN","LRDIE(2)")
"RTN","LRHBIN5",252,0)
 . I $G(LRDIE(2,"DIERR")),LRDIE(2,"DIERR",1)<120  H 5 K:LRLOOPCT<10 LRDIE(2)
"RTN","LRHBIN5",253,0)
 . E  S LRLOCKOK=1
"RTN","LRHBIN5",254,0)
 ;
"RTN","LRHBIN5",255,0)
 I $D(LRDIE(2)) D MAILALRT^LRWLST12("SET~LRWLST1")
"RTN","LRHBIN5",256,0)
 Q
"RTN","LRHBIN5",257,0)
 ;
"RTN","LRHBIN5",258,0)
EXIT ;
"RTN","LRHBIN5",259,0)
 K DFN,LR696,LRACC,LRALL,LRCAPLOC,LRCDT,LRDFN,LRDPF,LREND,LRID,LRIDT
"RTN","LRHBIN5",260,0)
 K LRLBLBP,LRLLOC,LRNT,LRODT,LROLLOC,LRORDR,LRORDRR,LROT,LRPHSET
"RTN","LRHBIN5",261,0)
 K LRPRAC,LRQUIET,LRSD,LRRSITE,LRRSTAT,LRSAMP,LRSPEC,LRSS,LRSN
"RTN","LRHBIN5",262,0)
 K LRTREA,LRUID,LRUNQ,LRWLC,SSN,ZTQUEUED
"RTN","LRHBIN5",263,0)
 Q
"RTN","LRHBIN5",264,0)
 ;
"RTN","LRHBIN6")
0^7^B111317764
"RTN","LRHBIN6",1,0)
LRHBIN6 ;LEIDOS/TCK Remote ordering Lab results ; 9/5/16 11:23am
"RTN","LRHBIN6",2,0)
 ;;1.0;Orders Portability;;March 1, 2010;Build 19
"RTN","LRHBIN6",3,0)
 ;
"RTN","LRHBIN6",4,0)
 ;2809 - check NTE.3 comments for HL7 encoded esc sequences and decode
"RTN","LRHBIN6",5,0)
 Q
"RTN","LRHBIN6",6,0)
 ;
"RTN","LRHBIN6",7,0)
RSLT ; parse results message
"RTN","LRHBIN6",8,0)
 ; Check user keys, site definition, etc...
"RTN","LRHBIN6",9,0)
 K REC
"RTN","LRHBIN6",10,0)
 N TSTARY,LRTST
"RTN","LRHBIN6",11,0)
 D ^LRPARAM
"RTN","LRHBIN6",12,0)
 S (LRAA,LRAD,LRAN,PNL)=0
"RTN","LRHBIN6",13,0)
 S X=HLARY("ORC",1)
"RTN","LRHBIN6",14,0)
 ; GET PROVIDER AND LAB TEST FROM OBR segment.  LRTS points to Lab Test file (60).
"RTN","LRHBIN6",15,0)
 S LRPRV=$P($P(X,D1,12),D2)
"RTN","LRHBIN6",16,0)
 S X=HLARY("OBR",1)
"RTN","LRHBIN6",17,0)
 ;S LRTSPN=$P($P(X,D1,46),D2)
"RTN","LRHBIN6",18,0)
 ;I LRTSPN'="" S LRTS=LRTSPN
"RTN","LRHBIN6",19,0)
 S LRTST=$P(X,D1,4)
"RTN","LRHBIN6",20,0)
 I LRTST["."!(LRTST'?.N) S LRTST=$P($P(X,D1,4),D2,4)
"RTN","LRHBIN6",21,0)
 ; Get VERIFYING PERSON from OBX segment. 11/8/2012 DWA to resolve NCH00002638.
"RTN","LRHBIN6",22,0)
 ;IF THE TEST IS A PANEL, LOOK FOR THE COMPONENT TEST IN OBX.
"RTN","LRHBIN6",23,0)
 I $D(^LAB(60,LRTST,2,0)) S PNL=1
"RTN","LRHBIN6",24,0)
 I PNL,$D(HLARY("OBX")) D
"RTN","LRHBIN6",25,0)
 .S I="" F  S I=$O(HLARY("OBX",I)) Q:I=""  D
"RTN","LRHBIN6",26,0)
 ..S X=HLARY("OBX",I)
"RTN","LRHBIN6",27,0)
 ..S CMPTST=$P(X,D1,3)
"RTN","LRHBIN6",28,0)
 ..I CMPTST["." S CMPTST=$P($P(X,D1,3),D2,4)
"RTN","LRHBIN6",29,0)
 ..Q:$D(ARY(CMPTST))
"RTN","LRHBIN6",30,0)
 ..S JVTECH=+$P($P(X,D1,15),D2)
"RTN","LRHBIN6",31,0)
 ..Q:X["C4"
"RTN","LRHBIN6",32,0)
 ..S ARY(CMPTST)=""
"RTN","LRHBIN6",33,0)
 ..S TSTARY(I)=+CMPTST
"RTN","LRHBIN6",34,0)
 K LTST,ARY
"RTN","LRHBIN6",35,0)
 ;
"RTN","LRHBIN6",36,0)
 ; Get order number from ORC-2.  ORDNM points to Orders file (100).
"RTN","LRHBIN6",37,0)
 S X=HLARY("ORC",1),ORDNM=$P(X,D1,2),ORNUM=+ORDNM,LIEN=ORNUM_","
"RTN","LRHBIN6",38,0)
 S LRDATA=$$GET1^DIQ(100,LIEN,33,"I")
"RTN","LRHBIN6",39,0)
 S LRORD=$P(LRDATA,";"),LRODT=$P(LRDATA,";",2),LRSND=$P(LRDATA,";",3)
"RTN","LRHBIN6",40,0)
 ; Get performing site number from ORC-13 and check if it is in the Institution file ^(DIC(4)
"RTN","LRHBIN6",41,0)
 S RSITE=$P($G(X),D1,13) K X I RSITE="" S RSITE=0
"RTN","LRHBIN6",42,0)
 I RSITE D
"RTN","LRHBIN6",43,0)
 .S LRFILE=4,LRIEN=RSITE_",",SITE=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN6",44,0)
 .I SITE="" S RSITE=0
"RTN","LRHBIN6",45,0)
 S X=HLARY("OBR",1)
"RTN","LRHBIN6",46,0)
 ; Get accession number in OBR-20 and parse the segments
"RTN","LRHBIN6",47,0)
 ;S JVTST=LTST
"RTN","LRHBIN6",48,0)
 S LRACC=$$GETACC^LRHBIN2(ORNUM,LRODT,LRORD,LRSND,LRTST)
"RTN","LRHBIN6",49,0)
 I LRACC="" S JVOROUT(1)="-1^Error: Accession number not found" Q
"RTN","LRHBIN6",50,0)
 S LRX=LRACC
"RTN","LRHBIN6",51,0)
 ; Pieces: Lab type (e.g. CH), date, accession for date
"RTN","LRHBIN6",52,0)
 S (X1,X2,X3)="",X1=$P(LRX," ",1),X2=$P(LRX," ",2),X3=$P(LRX," ",3)
"RTN","LRHBIN6",53,0)
 S:X3=""&(+X2=X2) X3=X2,X2=""
"RTN","LRHBIN6",54,0)
 ; LRAD (Accession date) formatted from X2
"RTN","LRHBIN6",55,0)
 S %DT="EP",X=X2 D ^%DT S LRAD=Y
"RTN","LRHBIN6",56,0)
 ; Build comments array from NTE segments (NTE-3)
"RTN","LRHBIN6",57,0)
 I $D(HLARY("NTE")) D
"RTN","LRHBIN6",58,0)
 .S N="" F  S N=$O(HLARY("NTE",N)) Q:N=""  D
"RTN","LRHBIN6",59,0)
 ..S STOP=0
"RTN","LRHBIN6",60,0)
 ..S X=$P(HLARY("NTE",N),"|",3)
"RTN","LRHBIN6",61,0)
 ..I X["]" D
"RTN","LRHBIN6",62,0)
 ...F I=1:1:STOP D
"RTN","LRHBIN6",63,0)
 ....S Y=$P(X,"]",I)
"RTN","LRHBIN6",64,0)
 ....I Y="" S STOP=1 Q
"RTN","LRHBIN6",65,0)
 ....I Y'="" S LCMMT(I)=Y
"RTN","LRHBIN6",66,0)
 ..I 'STOP S LCMMT(N)=X    ;2809 decode esc seq
"RTN","LRHBIN6",67,0)
 S LRRDT=$$NOW^XLFDT,LRNOW=LRRDT,LRDCMP=LRRDT
"RTN","LRHBIN6",68,0)
 ; Accession number relative to date
"RTN","LRHBIN6",69,0)
 S LRAN=+X3
"RTN","LRHBIN6",70,0)
 ; LRAA = internal value of accession area ^LRO(68,
"RTN","LRHBIN6",71,0)
 S D="B",DIC="^LRO(68,",DIC(0)="D",X=X1 D IX^DIC
"RTN","LRHBIN6",72,0)
 S LRAA=+Y
"RTN","LRHBIN6",73,0)
 ; Lab type
"RTN","LRHBIN6",74,0)
 S LRFILE=68,LRIEN=LRAA_","
"RTN","LRHBIN6",75,0)
 S LRSS=$$GET1^DIQ(LRFILE,LRIEN,.02,"I")
"RTN","LRHBIN6",76,0)
 ; LRDFN = Internal entry in LR( that is being worked on.
"RTN","LRHBIN6",77,0)
 S LRFILE=68.02,LRIEN=LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN6",78,0)
 S LRDFN=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN6",79,0)
 ; Get collection Date/Time
"RTN","LRHBIN6",80,0)
 S LRCDT=$$GET1^DIQ(LRFILE,LRIEN,9,"I")
"RTN","LRHBIN6",81,0)
 ; Get UID number
"RTN","LRHBIN6",82,0)
 S LRUID=$$GET1^DIQ(LRFILE,LRIEN,16,"I")
"RTN","LRHBIN6",83,0)
 ; LRIDT = Inverse date/time that data is stored at. ^LR(LRDFN,"CH",
"RTN","LRHBIN6",84,0)
 S LRIDT=$$GET1^DIQ(LRFILE,LRIEN,13.5,"I")
"RTN","LRHBIN6",85,0)
 I LRIDT<1 S JVOROUT(1)="-1^Error: No Collection Date/Time found" Q
"RTN","LRHBIN6",86,0)
 ; LRORD points to Orders file (100)
"RTN","LRHBIN6",87,0)
 ; LRSN is specimen number, points to TOPOGRAPHY file (61)
"RTN","LRHBIN6",88,0)
 S LRORD=$$GET1^DIQ(LRFILE,LRIEN,14,"I")
"RTN","LRHBIN6",89,0)
 S:LRORD="" LRORD=0
"RTN","LRHBIN6",90,0)
 ; LRODT = IEN of file (#
"RTN","LRHBIN6",91,0)
 S LRODT=$$GET1^DIQ(LRFILE,LRIEN,3,"I")
"RTN","LRHBIN6",92,0)
 S:'LRODT LRODT=$$GET1^DIQ(LRFILE,LRIEN,2,"I")
"RTN","LRHBIN6",93,0)
 S LRSN=$$GET1^DIQ(LRFILE,LRIEN,4,"I")
"RTN","LRHBIN6",94,0)
 ; Add technologist and date to Accession file now, index both. 11/8/2012 DWA changed out LRPRV for JVTECH since file calls for TECHNOLOGIST.  Part of resolution for NCH00002638
"RTN","LRHBIN6",95,0)
 I $G(LRTST)>0,$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",LRTST)) D
"RTN","LRHBIN6",96,0)
 .S LRFILE=68.04,LRIEN=LRTST_","_LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN6",97,0)
 .S LRFDA(4,LRFILE,LRIEN,3)=$G(JVTECH)
"RTN","LRHBIN6",98,0)
 .S LRFDA(4,LRFILE,LRIEN,4)=$G(LRAD)
"RTN","LRHBIN6",99,0)
 .D UPDATE^DIE("","LRFDA(4)","LRIEN","LRMSG")
"RTN","LRHBIN6",100,0)
 .;I $D(TSTARY(1)) S I="" F  S I=$O(TSTARY(I)) Q:I=""  D
"RTN","LRHBIN6",101,0)
 .;S TEST=TSTARY(I)
"RTN","LRHBIN6",102,0)
 .Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,"B",LRTST))
"RTN","LRHBIN6",103,0)
 .;S LRFILE=68.04,LRIEN=LRTS_","_LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN6",104,0)
 .;S LRFDA(4,LRFILE,LRIEN,3)=$G(JVTECH)
"RTN","LRHBIN6",105,0)
 .;S LRFDA(4,LRFILE,LRIEN,4)=$G(LRAD)
"RTN","LRHBIN6",106,0)
 .D UPDATE^DIE("","LRFDA(4)","LRIENS","LRMSG")
"RTN","LRHBIN6",107,0)
 S ^LRO(68,LRAA,1,LRAD,1,"AD",LRAD,+LRAN)="",^LRO(68,LRAA,1,LRAD,1,"AC",LRAD,+LRAN)=""
"RTN","LRHBIN6",108,0)
 S LRVAL=LRTST
"RTN","LRHBIN6",109,0)
 ; I test type is not Chemistry quit
"RTN","LRHBIN6",110,0)
 I LRSS'="CH" D RSLT^LRHBIN7(LRSS,LRAA,LRAD,LRAN) Q
"RTN","LRHBIN6",111,0)
 ; Special case for Chem/Hem.
"RTN","LRHBIN6",112,0)
 ; Get results from OBX segments
"RTN","LRHBIN6",113,0)
 S N="" F  S N=$O(HLARY("OBX",N)) Q:N=""  D
"RTN","LRHBIN6",114,0)
 .S X=HLARY("OBX",N)
"RTN","LRHBIN6",115,0)
 .; LRTS is pointer to ^LAB(60), LRRSLT is the result, LRSB is subscript needed to file results.
"RTN","LRHBIN6",116,0)
 .S TST=$P(X,D1,3)
"RTN","LRHBIN6",117,0)
 .I TST["."!(TST'?.N) S TST=$P($P(X,D1,3),D2,4)
"RTN","LRHBIN6",118,0)
 .S TARY(N)=TST,LRRSLT(N)=$P(X,D1,5)
"RTN","LRHBIN6",119,0)
 .; Get DATA NAME from field 400 of file (#60)
"RTN","LRHBIN6",120,0)
 .S LRFILE=60,LRIEN=TARY(N)_","
"RTN","LRHBIN6",121,0)
 .S LRSB(N)=$$GET1^DIQ(LRFILE,LRIEN,400,"I")
"RTN","LRHBIN6",122,0)
 .; Get High or Low flag
"RTN","LRHBIN6",123,0)
 .S LRHL(N)=$P(X,D1,8)
"RTN","LRHBIN6",124,0)
 .S FLG=LRHL(N)
"RTN","LRHBIN6",125,0)
 .I FLG["H"&(FLG["*") S YYY=3
"RTN","LRHBIN6",126,0)
 .I FLG["L"&(FLG["*") S YYY=3
"RTN","LRHBIN6",127,0)
 .I FLG["H"&(FLG'["*") S YYY=2
"RTN","LRHBIN6",128,0)
 .I FLG["L"&(FLG'["*") S YYY=2
"RTN","LRHBIN6",129,0)
 .I FLG'["H"&(FLG'["L") S YYY=1
"RTN","LRHBIN6",130,0)
 .; Get units of measurement and result range from message
"RTN","LRHBIN6",131,0)
 .S LRUNTS(N)=$P(X,D1,6),LRRNGE(N)=$P(X,D1,7)
"RTN","LRHBIN6",132,0)
 .; Set location from RSITE variable
"RTN","LRHBIN6",133,0)
 .S LRLOC=$G(RSITE)
"RTN","LRHBIN6",134,0)
 .; Get result status
"RTN","LRHBIN6",135,0)
 .S LRSTS=$P(X,D1,11)
"RTN","LRHBIN6",136,0)
 ; Check for entry in Lab Data file (#63) using reverse date.
"RTN","LRHBIN6",137,0)
 S LRFILE=63.04,LRIEN=LRIDT_","_LRDFN_","
"RTN","LRHBIN6",138,0)
 I '$$GET1^DIQ(LRFILE,LRIEN,.01,"I") S JVOROUT(1)="-1^Error: No Data file found" Q
"RTN","LRHBIN6",139,0)
 ; Get specimen type from file Lab Data file, (#63)
"RTN","LRHBIN6",140,0)
 S LRSPT(1)=$$GET1^DIQ(LRFILE,LRIEN,.05,"I")
"RTN","LRHBIN6",141,0)
 S LRFILE=69.01,LRIEN=LRSN_","_LRODT_","
"RTN","LRHBIN6",142,0)
 I $$GET1^DIQ(LRFILE,LRIEN,.01,"I"),'$$GET1^DIQ(LRFILE,LRIEN,10,"I") S JVOROUT(1)="This order has not been collected." Q
"RTN","LRHBIN6",143,0)
 S COLST=$$GET1^DIQ(LRFILE,LRIEN,13,"I")
"RTN","LRHBIN6",144,0)
 I COLST'="C" S JVOROUT(1)="-1^Error^You cannot verify an accession which has not been collected." Q
"RTN","LRHBIN6",145,0)
 Q:$D(JVOROUT)
"RTN","LRHBIN6",146,0)
 ;
"RTN","LRHBIN6",147,0)
CH ;
"RTN","LRHBIN6",148,0)
 N N,XDATA,X5
"RTN","LRHBIN6",149,0)
 S LRFILE=63.04,LRIEN=LRIDT_","_LRDFN_","
"RTN","LRHBIN6",150,0)
 S LRFDA(LRFILE,LRIEN,.03)=$G(LRRDT)
"RTN","LRHBIN6",151,0)
 S LRFDA(LRFILE,LRIEN,.04)=$G(JVTECH)
"RTN","LRHBIN6",152,0)
 ; File Lab result in Chemistry file (63.04), using info in XDATA.
"RTN","LRHBIN6",153,0)
 D FILE^DIE("","LRFDA") K LRFDA,LRIEN,LRFILE,LRMSG,LRIENS
"RTN","LRHBIN6",154,0)
 S N="" F  S N=$O(TARY(N)) Q:N=""  D
"RTN","LRHBIN6",155,0)
 .S $P(XDATA,"^",1)=LRRSLT(N)
"RTN","LRHBIN6",156,0)
 .S $P(XDATA,"^",2)=LRHL(N)
"RTN","LRHBIN6",157,0)
 . ; Need to pull Workload code from Lab Results file, since CHCS doesn't provide.
"RTN","LRHBIN6",158,0)
 . ;Code fix for DJE-NCHICAGO-2790
"RTN","LRHBIN6",159,0)
 .S $P(XDATA,"^",3)=$P($G(^LR(LRDFN,LRSS,LRIDT,"ORUT",1,0)),D2,1)_"!!!!!!"_TARY(N)
"RTN","LRHBIN6",160,0)
 .; Old code S $P(XDATA,"^",3)=$G(^LR(LRDFN,LRSS,LRIDT,"ORUT",1,0))_"!"_TSTARY(N)
"RTN","LRHBIN6",161,0)
 .S $P(XDATA,"^",4)=$G(JVTECH)
"RTN","LRHBIN6",162,0)
 .S $P(XDATA,"^",9)=LRLOC
"RTN","LRHBIN6",163,0)
 .S $P(XDATA,"^",10)=1
"RTN","LRHBIN6",164,0)
 .S $P(XDATA,"^",13)=1
"RTN","LRHBIN6",165,0)
 .S X5=$G(LRSPT(1)),LRSPEC=X5
"RTN","LRHBIN6",166,0)
 .S LRFILE=60.01,LRIEN=LRSPEC_","_TARY(N)_","
"RTN","LRHBIN6",167,0)
 .S S=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN6",168,0)
 .S S1=$$GET1^DIQ(LRFILE,LRIEN,1,"I")
"RTN","LRHBIN6",169,0)
 .S S2=$$GET1^DIQ(LRFILE,LRIEN,2,"I")
"RTN","LRHBIN6",170,0)
 .S S3=$$GET1^DIQ(LRFILE,LRIEN,3,"I")
"RTN","LRHBIN6",171,0)
 .S S4=$$GET1^DIQ(LRFILE,LRIEN,4,"I")
"RTN","LRHBIN6",172,0)
 .S S5="",S6=$$GET1^DIQ(LRFILE,LRIEN,6,"I")
"RTN","LRHBIN6",173,0)
 .S $P(X5,D2)=S_"^"_S1_"^"_S2_"^"_S3_"^"_S4_"^"_S5_"^"_S6
"RTN","LRHBIN6",174,0)
 .S $P(X5,D2,2)=$P(LRRNGE(N),"-"),$P(X5,D2,3)=$P(LRRNGE(N),"-",2),$P(X5,D2,7)=LRUNTS(N)
"RTN","LRHBIN6",175,0)
 .I $P($G(X5),D2,8)="" S X5=X5_"^"
"RTN","LRHBIN6",176,0)
 .S X5=$TR(X5,"^","!")
"RTN","LRHBIN6",177,0)
 .S $P(XDATA,"^",5)=X5
"RTN","LRHBIN6",178,0)
 .; Stuff data into Lab data file
"RTN","LRHBIN6",179,0)
 .S ^LR(LRDFN,LRSS,LRIDT,LRSB(N))=XDATA
"RTN","LRHBIN6",180,0)
 .K XDATA ;Kill XDATA to be ready for component tests. DWA-NCHICAGO-2790
"RTN","LRHBIN6",181,0)
 N CHECK S CHECK=0
"RTN","LRHBIN6",182,0)
 D CHKRSLT(LRDFN,LRSS,LRIDT,.CHECK)
"RTN","LRHBIN6",183,0)
 I $D(LCMMT) D
"RTN","LRHBIN6",184,0)
 .K LRFDA
"RTN","LRHBIN6",185,0)
 .I 'CHECK D CMARY(.LCMMT)
"RTN","LRHBIN6",186,0)
 .N LRFILE,LRFDA,LRIEN
"RTN","LRHBIN6",187,0)
 .S N="" F  S N=$O(LCMMT(N)) Q:N=""  D
"RTN","LRHBIN6",188,0)
 ..S TXT=LCMMT(N)
"RTN","LRHBIN6",189,0)
 ..S LRIENS=N_","_LRIDT_","_LRDFN_","
"RTN","LRHBIN6",190,0)
 ..S TX=$$GET1^DIQ(63.041,LRIENS,.01,"E")
"RTN","LRHBIN6",191,0)
 ..Q:TX=TXT
"RTN","LRHBIN6",192,0)
 ..K LRFDA
"RTN","LRHBIN6",193,0)
 ..S LRFILE=63.041,LRIEN="+"_N_","_LRIDT_","_LRDFN_","
"RTN","LRHBIN6",194,0)
 ..S LRFDA(1,LRFILE,LRIEN,.01)=$G(LCMMT(N))
"RTN","LRHBIN6",195,0)
 ..D UPDATE^DIE("","LRFDA(1)","LRIENS","LRERR(2)")
"RTN","LRHBIN6",196,0)
 ;SEND ALERT TO CPRS
"RTN","LRHBIN6",197,0)
 I $G(YYY)>0 D SNDALRT(LRDFN,LRSS,LRIDT,LRUID,LRTST,YYY)
"RTN","LRHBIN6",198,0)
 S STA=2
"RTN","LRHBIN6",199,0)
 S LRNOW=$$NOW^XLFDT
"RTN","LRHBIN6",200,0)
 ; Get Date/Time ordered from field 5 of Lab order entry file, (#69).
"RTN","LRHBIN6",201,0)
 S LRFILE=69.01,LRIEN=LRSN_","_LRODT_","
"RTN","LRHBIN6",202,0)
 S LRDTO=$$GET1^DIQ(LRFILE,LRIEN,5,"I")
"RTN","LRHBIN6",203,0)
 S LRFDA(3,LRFILE,LRIEN,20)=LRDTO
"RTN","LRHBIN6",204,0)
 S LRFDA(3,LRFILE,LRIEN,21)=LRNOW
"RTN","LRHBIN6",205,0)
 D UPDATE^DIE("","LRFDA(3)","LRIENS","LRMSG")
"RTN","LRHBIN6",206,0)
 S LRFILE=68.02,LRIEN=LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN6",207,0)
 I '$$GET1^DIQ(LRFILE,LRIEN,12,"I") D
"RTN","LRHBIN6",208,0)
 .S LRFDA(3,LRFILE,LRIEN,12)=$G(LRNOW)
"RTN","LRHBIN6",209,0)
 S LRFDA(3,LRFILE,LRIEN,13)=$$NOW^XLFDT
"RTN","LRHBIN6",210,0)
 D UPDATE^DIE("","LRFDA(3)","LRIENS","LRMSG")
"RTN","LRHBIN6",211,0)
 S LRFILE=68.02,LRIEN=LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN6",212,0)
 S LRDFN=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN6",213,0)
 ; This node does not exist on .237 but does on Silver
"RTN","LRHBIN6",214,0)
 S ^LR(LRDFN,"CH",LRIDT,"RF")=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,.3),D2,2)
"RTN","LRHBIN6",215,0)
 S ^LR(LRDFN,"CH",LRIDT,"ORU")=^LRO(68,LRAA,1,LRAD,1,LRAN,.3)
"RTN","LRHBIN6",216,0)
 S LRFILE=100,LRIEN=ORNUM_","
"RTN","LRHBIN6",217,0)
 ;S DATA=$$GET1^DIQ(LRFILE,LRIEN,33,"I")
"RTN","LRHBIN6",218,0)
 I LRDATA'[LRSS D
"RTN","LRHBIN6",219,0)
 .S LRFDA(4,LRFILE,LRIEN,33)=LRDATA_";"_LRSS_";"_LRIDT
"RTN","LRHBIN6",220,0)
 .D UPDATE^DIE("","LRFDA(4)","LRIENS","LRMSG")
"RTN","LRHBIN6",221,0)
 ; Set Order file (#100), field (#22) to LRNOW and field (#5) to "COMPLETED" 
"RTN","LRHBIN6",222,0)
 S DIE="^OR(100,",DA=ORNUM,ST=2,DR="22////"_LRNOW_";5////"_ST_";" D ^DIE K DIE,DA
"RTN","LRHBIN6",223,0)
 S JVOROUT(1)=ORNUM_"^RS"
"RTN","LRHBIN6",224,0)
 D END
"RTN","LRHBIN6",225,0)
 Q
"RTN","LRHBIN6",226,0)
 ;
"RTN","LRHBIN6",227,0)
SNDALRT(LRDFN,LRSS,LRIDT,LRUID,LRTST,YYY) ;SEND ALERTS TO CPRS
"RTN","LRHBIN6",228,0)
 ;  Call with LRDFN = file #63 IEN
"RTN","LRHBIN6",229,0)
 ;             LRSS = file #63 subscript
"RTN","LRHBIN6",230,0)
 ;            LRIDT = inverse d/t of entry in file #63
"RTN","LRHBIN6",231,0)
 ;            LRUID = accession's UID
"RTN","LRHBIN6",232,0)
 ;
"RTN","LRHBIN6",233,0)
 ; Only supports CH and MI. AP subscript handled by separate API.
"RTN","LRHBIN6",234,0)
 ;
"RTN","LRHBIN6",235,0)
 N DFN,DIC,DIR,DIRUT,DTOUT,DUOUT,LRC,LRDOCS,LRMORE,LRQUIT,LRTST,LRTYPE,LRX,LRXQA,LRY,X,Y
"RTN","LRHBIN6",236,0)
 ;
"RTN","LRHBIN6",237,0)
 S (LRTYPE,LRXQA,LRY,CTR)=""
"RTN","LRHBIN6",238,0)
 ;
"RTN","LRHBIN6",239,0)
 ; Select test to alert
"RTN","LRHBIN6",240,0)
 S LRTST=$G(TST)
"RTN","LRHBIN6",241,0)
 S TSTNM=$$GET1^DIQ(60,TST,.01,"E")
"RTN","LRHBIN6",242,0)
 S LRTST=LRTST_"^"_TSTNM_"^"_LRTST
"RTN","LRHBIN6",243,0)
 S CTR=$G(CTR)+1,LRTYPE(1)=3
"RTN","LRHBIN6",244,0)
 I YYY=1 S LRTYPE(CTR)=3
"RTN","LRHBIN6",245,0)
 I YYY>1 D
"RTN","LRHBIN6",246,0)
 .F I="ACT","IN" D
"RTN","LRHBIN6",247,0)
 ..I I="ACT" D
"RTN","LRHBIN6",248,0)
 ...S CTR=$G(CTR)+1
"RTN","LRHBIN6",249,0)
 ...I YYY=2 S LRTYPE(CTR)=14
"RTN","LRHBIN6",250,0)
 ...I YYY=3 S LRTYPE(CTR)=57
"RTN","LRHBIN6",251,0)
 ..I I="IN" D
"RTN","LRHBIN6",252,0)
 ...S CTR=$G(CTR)+1
"RTN","LRHBIN6",253,0)
 ...I YYY=2 S LRTYPE(CTR)=24
"RTN","LRHBIN6",254,0)
 ...I YYY=3 S LRYTPE(CTR)=58
"RTN","LRHBIN6",255,0)
 Q:'$D(LRTYPE)
"RTN","LRHBIN6",256,0)
 S CT="" F  S CT=$O(LRTYPE(CT)) Q:CT=""  D
"RTN","LRHBIN6",257,0)
 .Q:XX=""
"RTN","LRHBIN6",258,0)
 .S LRTYPE=LRTYPE(CT)
"RTN","LRHBIN6",259,0)
 .D GETDOCS^LR7ORB3(.LRDOCS,LRDFN,LRSS,LRIDT)
"RTN","LRHBIN6",260,0)
 .S (LRC,LRXQA)=0
"RTN","LRHBIN6",261,0)
 .S LRC=1,LRDUZ=$P(LRDOCS(LRC),"^")
"RTN","LRHBIN6",262,0)
 .S LRXQA(LRDUZ)=$P(LRDOCS(LRC),"^",3)
"RTN","LRHBIN6",263,0)
 .S LRY=$$OR^LR7ORB3(LRTYPE,LRDFN,LRSS,LRIDT,LRUID,.LRXQA,LRTST)
"RTN","LRHBIN6",264,0)
 Q
"RTN","LRHBIN6",265,0)
 ;
"RTN","LRHBIN6",266,0)
CMARY(ARY) ;
"RTN","LRHBIN6",267,0)
 N Y,X
"RTN","LRHBIN6",268,0)
 ;"AMENDED COMMENT" not required for the RESULT COMMENT(S) section.
"RTN","LRHBIN6",269,0)
 S AFLG=0
"RTN","LRHBIN6",270,0)
 ;
"RTN","LRHBIN6",271,0)
 S X="" F  S X=$O(ARY(X)) Q:X=""  D
"RTN","LRHBIN6",272,0)
 .;check for Result Comment in current array
"RTN","LRHBIN6",273,0)
 .Q:AFLG=1
"RTN","LRHBIN6",274,0)
 .I ARY(X)["RESULT COMMENT(S)" S AFLG=1 Q
"RTN","LRHBIN6",275,0)
 .S Y=X+1,NARY(Y)=ARY(X)
"RTN","LRHBIN6",276,0)
 .K ARY(X)
"RTN","LRHBIN6",277,0)
 ;for results - amended comment not required.
"RTN","LRHBIN6",278,0)
 I AFLG K NARY Q
"RTN","LRHBIN6",279,0)
 ;for other amended comments
"RTN","LRHBIN6",280,0)
 ;S NARY(1)="AMENDED COMMENT"
"RTN","LRHBIN6",281,0)
 ;
"RTN","LRHBIN6",282,0)
 M ARY=NARY K NARY
"RTN","LRHBIN6",283,0)
 Q
"RTN","LRHBIN6",284,0)
 ;
"RTN","LRHBIN6",285,0)
CHKRSLT(LRDFN,LRSS,LRIDT,ANS) ;
"RTN","LRHBIN6",286,0)
 S ANS=0
"RTN","LRHBIN6",287,0)
 S L="" F  S L=$O(^LR(LRDFN,LRSS,LRIDT,L)) Q:L=""  D
"RTN","LRHBIN6",288,0)
 .M XX=^LR(LRDFN,LRSS,LRIDT,L) I XX["!" S ANS=1
"RTN","LRHBIN6",289,0)
 Q ANS
"RTN","LRHBIN6",290,0)
 ;
"RTN","LRHBIN6",291,0)
 ;
"RTN","LRHBIN6",292,0)
GETIEN(R,ORD,JVWRKLD) ;
"RTN","LRHBIN6",293,0)
 N JVDATA,JVDT,JVRN,TST,JVTST
"RTN","LRHBIN6",294,0)
 S (JVDATA,JVDT,JVRN,TST,JVTST)="",R=0
"RTN","LRHBIN6",295,0)
 I '$D(^OR(100,ORD)) S R="" Q
"RTN","LRHBIN6",296,0)
 S JVDATA=^OR(100,ORD,4)
"RTN","LRHBIN6",297,0)
 S JVDT=$P(JVDATA,";",2)
"RTN","LRHBIN6",298,0)
 S JVRN=$P(JVDATA,";",3)
"RTN","LRHBIN6",299,0)
 I '$D(^LRO(69,JVDT,1,JVRN)) S R="" Q
"RTN","LRHBIN6",300,0)
 S TST="" F  S TST=$O(^LRO(69,JVDT,1,JVRN,2,"B",TST)) Q:TST=""  D  Q:R=""
"RTN","LRHBIN6",301,0)
 .S JVTARY(TST)=TST
"RTN","LRHBIN6",302,0)
 I '$D(JVTARY) S R="" Q
"RTN","LRHBIN6",303,0)
 I '$D(^LAM("E",JVWRKLD)) S R="" Q
"RTN","LRHBIN6",304,0)
 S JVWRKIEN="",JVWRKIEN=$O(^LAM("E",JVWRKLD,JVWRKIEN))
"RTN","LRHBIN6",305,0)
 I JVWRKIEN="" S R="" Q
"RTN","LRHBIN6",306,0)
 F  S JVTST=$O(JVTARY(JVTST)) Q:JVTST=""  D  Q:R=""
"RTN","LRHBIN6",307,0)
 .S TEST=JVTST_";LAB(60,"
"RTN","LRHBIN6",308,0)
 .I $D(^LAM(JVWRKIEN,7,"B",TEST)) S R=JVTST Q
"RTN","LRHBIN6",309,0)
 Q
"RTN","LRHBIN6",310,0)
 ;
"RTN","LRHBIN6",311,0)
END ;
"RTN","LRHBIN6",312,0)
 K ARY,TARY,LRTST,TSTARY,LRTST,REC,HLARY
"RTN","LRHBIN6",313,0)
 K %DT,ANS,CHECK,AGE,COLST,CTR,D1,D2,D,DATA,DIC,DFN,DOB,DR,FLAG,HLARY,L,LRAA,LRAD,LRAN,LRBGO,JVTECH
"RTN","LRHBIN6",314,0)
 K LRCCMT,LCMMT,LRDPF,LRDTOLREND,LRFIND,LRCW,LRBGO,LRBG0,LRCCMT,LRCDT,LRDCMP,LRDFN
"RTN","LRHBIN6",315,0)
 K LRDTO,LREN,LRNOW,LRFINO,LRFINO,LRHL,LRI,LRIDT,LRLOC,LRNDISP,LRNG2,LRNG3,LRNG4,LRNG5
"RTN","LRHBIN6",316,0)
 K LRNOW,LRODT,LRORD,LRPANEL,LRRDT,LRRNGE,LRPANEL,LRPRV,LRRSLT,LRSB,LRS,LRSN,LRSPEC
"RTN","LRHBIN6",317,0)
 K LRSPT,LRTM60,LRSS,LRTS,LRSTS,LRUNDO,LRUID,LRUNTS,LRVAL,LRX,MSH,NUM
"RTN","LRHBIN6",318,0)
 K ORDNM,ORNUM,OBR,OBX,REC,RSITE,S,S1,S2,S3,S4,S5,S6,SEX,SITE,ST,STA,TOT,TYPE,VA,XX,X1,X2,X3,XDATA,Y
"RTN","LRHBIN6",319,0)
 Q
"RTN","LRHBIN6",320,0)
 ;
"RTN","LRHBIN7")
0^8^B289743250
"RTN","LRHBIN7",1,0)
LRHBIN7 ;SAIC/TCK- Orders Portability - Laboratory Results - Filer ; 9/5/16 1:00pm
"RTN","LRHBIN7",2,0)
 ;;1.0;Orders Portability;;March 1, 2010;Build 19
"RTN","LRHBIN7",3,0)
 ;
"RTN","LRHBIN7",4,0)
 Q
"RTN","LRHBIN7",5,0)
RSLT(LRSS,LRAA,LRAD,LRAN) ;  file results
"RTN","LRHBIN7",6,0)
 I '$D(LRSS) S JVOROUT(1)="-1^Error: Order was not succesfully accessioned." Q
"RTN","LRHBIN7",7,0)
 I LRSS="MI" D MI(LRAA,LRAD,LRAN) G EXIT
"RTN","LRHBIN7",8,0)
 Q
"RTN","LRHBIN7",9,0)
 ;
"RTN","LRHBIN7",10,0)
MI(LRAA,LRAD,LRAN) ;  file microbiology reports
"RTN","LRHBIN7",11,0)
 S LRCMT="",LRI=1
"RTN","LRHBIN7",12,0)
 S LR6207(23)="",LROK=0 ; rhl  LR6207 is an array of LAB(62.07 entries that have been implmmented
"RTN","LRHBIN7",13,0)
 ; LRDFN = Internal entry in LR( that is being worked on.
"RTN","LRHBIN7",14,0)
 S LRFILE=68.02,LRIEN=LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN7",15,0)
 S LRDFN=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN7",16,0)
 S LRIDT=$$GET1^DIQ(LRFILE,LRIEN,13.5,"I")
"RTN","LRHBIN7",17,0)
 S LRCDT=$$GET1^DIQ(LRFILE,LRIEN,9,"I")
"RTN","LRHBIN7",18,0)
 S LRFILE=63.05,LRIEN=LRIDT_","_LRDFN_","
"RTN","LRHBIN7",19,0)
 I '$$GET1^DIQ(LRFILE,LRIEN,.01,"I") S JVOROUT(1)="-1^Error: No entry in file (#63) for this patient" Q
"RTN","LRHBIN7",20,0)
 ; Pick up specimen
"RTN","LRHBIN7",21,0)
 S LRFILE=68.05,LRSPEC=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN7",22,0)
 S LRCMT=""
"RTN","LRHBIN7",23,0)
 S X=HLARY("ORC",1),RSITE=$P($G(X),D1,13) K X
"RTN","LRHBIN7",24,0)
 I RSITE="" S RSITE=0
"RTN","LRHBIN7",25,0)
 I RSITE D
"RTN","LRHBIN7",26,0)
 .S LRFILE=4,LRIEN=RSITE_",",SITE=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN7",27,0)
 .I SITE="" S RSITE=0
"RTN","LRHBIN7",28,0)
 S X=HLARY("OBR",1),LRTS=$P($P(X,D1,4),D2)
"RTN","LRHBIN7",29,0)
 S LRTSPN=$P($P(X,D1,46),D2)
"RTN","LRHBIN7",30,0)
 I LRTSPN'="" S LRTS=LRTSPN
"RTN","LRHBIN7",31,0)
 I LRTSPN="" S LRTS=$P($P(X,D1,4),D2)
"RTN","LRHBIN7",32,0)
 S LRFILE=68.04,LRIEN=LRTS_","_LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN7",33,0)
 I '$$GET1^DIQ(LRFILE,LRIEN,.01,"I") S JVOROUT(1)="-1^Error: No tests associated with this accession" Q
"RTN","LRHBIN7",34,0)
 S Y=$$NOW^XLFDT
"RTN","LRHBIN7",35,0)
 ; Update Accession file with technologist ID and timestamp
"RTN","LRHBIN7",36,0)
 S LRFILE=68.04,LRIEN=LRTS_","_LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN7",37,0)
 S LRFDA(4,LRFILE,LRIEN,3)=$G(JVTECH)
"RTN","LRHBIN7",38,0)
 S LRFDA(4,LRFILE,LRIEN,4)=$G(Y)
"RTN","LRHBIN7",39,0)
 D UPDATE^DIE("","LRFDA(4)","LRIENS","LRMSG")
"RTN","LRHBIN7",40,0)
 S ^LRO(68,LRAA,1,LRAD,1,"AD",$P(Y,"."),+LRAN)="",^LRO(68,LRAA,1,LRAD,1,"AC",Y,+LRAN)=""
"RTN","LRHBIN7",41,0)
 ; Get Edit Code from Lab Test file (Bacteriology, Mycology, etc.)
"RTN","LRHBIN7",42,0)
 S LRFILE=60,LRIEN=LRTS_",",EXEC=$$GET1^DIQ(LRFILE,LRIEN,98,"I")
"RTN","LRHBIN7",43,0)
 I 'EXEC S JVOROUT(1)="-1^Error: Lab test is not configured correctly" Q
"RTN","LRHBIN7",44,0)
 ; Normalize the value.
"RTN","LRHBIN7",45,0)
 D GETEXEC^JVHLLR3(.EXEC)
"RTN","LRHBIN7",46,0)
 I EXEC D
"RTN","LRHBIN7",47,0)
 .; Get the executable file numbers from the EXECUTE FILE, (#62.07)
"RTN","LRHBIN7",48,0)
 .S LRFILE=62.07,LRIEN=EXEC_",",LRTX(LRI)=$$GET1^DIQ(LRFILE,LRIEN,1,"I")
"RTN","LRHBIN7",49,0)
 .; Set the file node using the LRTX(LRI)
"RTN","LRHBIN7",50,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","LRHBIN7",51,0)
 .D @("MI"_EXEC) ; RHL 20100809
"RTN","LRHBIN7",52,0)
 I LROK=0 S JVOROUT(1)="-1^UNSUCESSFUL MICROBIOLOGY RESULTS SAVE"
"RTN","LRHBIN7",53,0)
 I LROK=1 D
"RTN","LRHBIN7",54,0)
 .S TIM=$$NOW^XLFDT
"RTN","LRHBIN7",55,0)
 .S LRFILE=100,LRIEN=ORDNM_",",LRD=$$GET1^DIQ(LRFILE,LRIEN,33,"I")
"RTN","LRHBIN7",56,0)
 .S LRORD=$P($G(LRD),";"),LRODT=$P($G(LRD),";",2),LRSN=$P($G(LRD),";",3)
"RTN","LRHBIN7",57,0)
 .S LRFILE=69.01,LRIEN=LRSN_","_LRODT_","
"RTN","LRHBIN7",58,0)
 .S LRFDA(3,LRFILE,LRIEN,20)=$G(TIM)
"RTN","LRHBIN7",59,0)
 .S LRFDA(3,LRFILE,LRIEN,21)=$$NOW^XLFDT
"RTN","LRHBIN7",60,0)
 .D UPDATE^DIE("","LRFDA(3)","LRIENS","LRMSG")
"RTN","LRHBIN7",61,0)
 .S LRFILE=68.02,LRIEN=LRAN_","_LRAD_","_LRAA_","
"RTN","LRHBIN7",62,0)
 .S LRSITE=$$GET1^DIQ(LRFILE,LRIEN,16.1,"I")
"RTN","LRHBIN7",63,0)
 .S LRDFN=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN7",64,0)
 .S X=$$GET1^DIQ(LRFILE,LRIEN,12,"I")
"RTN","LRHBIN7",65,0)
 .I X="" S LRFDA(3,LRFILE,LRIEN,12)=$G(TIM)
"RTN","LRHBIN7",66,0)
 .S LRFDA(3,LRFILE,LRIEN,13)=$$NOW^XLFDT
"RTN","LRHBIN7",67,0)
 .D UPDATE^DIE("","LRFDA(3)","LRIENS","LRMSG")
"RTN","LRHBIN7",68,0)
 .S ^LR(LRDFN,"MI",LRIDT,"RF")=LRSITE
"RTN","LRHBIN7",69,0)
 .S ^LR(LRDFN,"MI",LRIDT,"ORU")=^LRO(68,LRAA,1,LRAD,1,LRAN,.3)
"RTN","LRHBIN7",70,0)
 .S LRFILE=100,LRIEN=ORDNM_","
"RTN","LRHBIN7",71,0)
 .S DATA=$$GET1^DIQ(LRFILE,LRIEN,33,"I")
"RTN","LRHBIN7",72,0)
 .I DATA'[LRSS D
"RTN","LRHBIN7",73,0)
 ..S LRFDA(4,LRFILE,LRIEN,33)=DATA_";"_LRSS_";"_LRIDT
"RTN","LRHBIN7",74,0)
 ..D UPDATE^DIE("","LRFDA(4)","LRIENS","LRMSG")
"RTN","LRHBIN7",75,0)
 .I $G(LRSTS)="F" D
"RTN","LRHBIN7",76,0)
 ..S DIE="^OR(100,",DA=ORDNM,ST=2,DR="22////"_$$NOW^XLFDT_";5////"_ST_";" D ^DIE K DIE,DA
"RTN","LRHBIN7",77,0)
 .S JVOROUT(1)=ORDNM_"^RS"
"RTN","LRHBIN7",78,0)
 K HLARY,LRSB,LRTS,LRTX,LRSPEC,REC
"RTN","LRHBIN7",79,0)
 Q
"RTN","LRHBIN7",80,0)
 ; ==================================================================
"RTN","LRHBIN7",81,0)
MI7 ; BACTERIOLOGY
"RTN","LRHBIN7",82,0)
 N DA,DIE,X,X1,X2,LR1,LRFDA,LRFILE,LRIEN,LRPRV,LRIENS,LRMSG
"RTN","LRHBIN7",83,0)
 N RCNT,ORGC,ORG,OBR,OBX,XCNT,ORGNM,CNT,LRANT,LRSUSC,LRRS1,LRRS2
"RTN","LRHBIN7",84,0)
 N LRRS3,LRORG,LRCCNT,LRGRAM,LRIEN,GRMARY,GRMCNT,NUM,NX,ORGIEN,QUIT
"RTN","LRHBIN7",85,0)
 ; File 1 node of Bacteriology results
"RTN","LRHBIN7",86,0)
 S X=HLARY("OBX",1),LRSTS=$P(X,D1,11),LRCMT=""
"RTN","LRHBIN7",87,0)
 S LRFILE=63.05,LRIEN=LRIDT_","_LRDFN_","
"RTN","LRHBIN7",88,0)
 S LRFDA(1,LRFILE,LRIEN,11)=$G(LRCDT)
"RTN","LRHBIN7",89,0)
 S LRFDA(1,LRFILE,LRIEN,11.5)=$G(LRSTS)
"RTN","LRHBIN7",90,0)
 S LRFDA(1,LRFILE,LRIEN,11.55)=$G(JVTECH)
"RTN","LRHBIN7",91,0)
 D UPDATE^DIE("","LRFDA(1)","LRIENS","LRMSG")
"RTN","LRHBIN7",92,0)
 K LRFDA,LRIEN,LRIENS,LRMSG
"RTN","LRHBIN7",93,0)
 S LRIEN=LRIDT_","_LRDFN_",",LRFILE=63.05
"RTN","LRHBIN7",94,0)
 S LRFDA(99,LRFILE,LRIEN,.99)=$G(LRCMT)
"RTN","LRHBIN7",95,0)
 D UPDATE^DIE("","LRFDA(99)","LRIENS","LRMSG")
"RTN","LRHBIN7",96,0)
 ;
"RTN","LRHBIN7",97,0)
 ;  build ORG array of organism  e.g.  ORG(1)=500714\STREPTOCOCCUS SPECIES^<COLONY COUNT>^<GRAM STAIN>
"RTN","LRHBIN7",98,0)
 ;                                      ^piece-1 = ien\organism name
"RTN","LRHBIN7",99,0)
 ;                                      ^piece-2 = colony count, if any
"RTN","LRHBIN7",100,0)
 ;                                      ^piece-3 = gram stain, if any
"RTN","LRHBIN7",101,0)
 ;                                      ORG(1,"PENICILLIN")=<susceptability>
"RTN","LRHBIN7",102,0)
 ; ; CULTURE SUSCEPTIBILTY
"RTN","LRHBIN7",103,0)
 S RCNT=0,ORGC=0,GRMCNT=0
"RTN","LRHBIN7",104,0)
 S (LR1,ORGC,GRMCNT,NX)=0,(VAL,LNC)=""
"RTN","LRHBIN7",105,0)
 F  S NX=$O(HLARY("OBX",NX)) Q:'NX  D
"RTN","LRHBIN7",106,0)
 .S X=HLARY("OBX",NX)
"RTN","LRHBIN7",107,0)
 .I $P(X,D1,2)["CE" D  Q
"RTN","LRHBIN7",108,0)
 ..; Organism
"RTN","LRHBIN7",109,0)
 ..I $P(X,D1,3)["99VA61.2" D
"RTN","LRHBIN7",110,0)
 ...S VAL=$P(X,D1,4),ORGC=ORGC+1
"RTN","LRHBIN7",111,0)
 ...S ORG(VAL,ORGC)=$P($P(X,D1,3),D2,1,2)_D1
"RTN","LRHBIN7",112,0)
 ...S ORGNARY(+ORG(VAL,ORGC))="" Q
"RTN","LRHBIN7",113,0)
 .I $P(X,D1,2)["ST" D
"RTN","LRHBIN7",114,0)
 ..I $P(X,D1,3)["COLONY COUNT" D
"RTN","LRHBIN7",115,0)
 ...S VAL=$P(X,D1,4),LRCCNT(VAL)=$P(X,D1,5)
"RTN","LRHBIN7",116,0)
 ..I $P(X,D1,3)["SUSC" D
"RTN","LRHBIN7",117,0)
 ...S VAL=$P(X,D1,4)
"RTN","LRHBIN7",118,0)
 ...S LNC=$P($P(X,D1,3),D2,1),LRSUSC=$P(X,D1,8)
"RTN","LRHBIN7",119,0)
 ...S LRRS1(VAL,LNC)=LRSUSC
"RTN","LRHBIN7",120,0)
 ..; get BACT RPT REMARKS
"RTN","LRHBIN7",121,0)
 ..I $P(X,D1,3)["93928.0000" D
"RTN","LRHBIN7",122,0)
 ...S LR1=LR1+1,LRRS2(LR1)=$P(X,D1,5)
"RTN","LRHBIN7",123,0)
 ..; get gram stain
"RTN","LRHBIN7",124,0)
 ..I $P(X,D1,3)["664-3" D
"RTN","LRHBIN7",125,0)
 ...S GRMCNT=GRMCNT+1,GRMARY(GRMCNT)=$P(X,D1,5)
"RTN","LRHBIN7",126,0)
 ..I $P(X,D1,3)["87754.0000" D
"RTN","LRHBIN7",127,0)
 ...S GRMCNT=GRMCNT+1,GRMARY(GRMCNT)=$P(X,D1,5)
"RTN","LRHBIN7",128,0)
 ;
"RTN","LRHBIN7",129,0)
 ; NODE-4, FIELD-13 - BACT RPT REMARK -- FILE63.33
"RTN","LRHBIN7",130,0)
 I $D(LRRS2) D
"RTN","LRHBIN7",131,0)
 .S X1="" F  S X1=$O(LRRS2(X1)) Q:X1=""  D
"RTN","LRHBIN7",132,0)
 ..S RSLT=$$GET1^DIQ(63.33,X1_","_LRIDT_","_LRDFN_",",.01,"I")
"RTN","LRHBIN7",133,0)
 ..I LRRS2(X1)=$G(RSLT) Q
"RTN","LRHBIN7",134,0)
 ..S LRIEN="+"_X1_","_LRIDT_","_LRDFN_","
"RTN","LRHBIN7",135,0)
 ..S LRFDA(4,63.33,LRIEN,.01)=$G(LRRS2(X1))
"RTN","LRHBIN7",136,0)
 ..D UPDATE^DIE("","LRFDA(4)","LRIENS","LRMSG")
"RTN","LRHBIN7",137,0)
 K LRFDA,LRIENS,LRMSG,LRFILE,LRIEN
"RTN","LRHBIN7",138,0)
 ;
"RTN","LRHBIN7",139,0)
 ; file gram stain
"RTN","LRHBIN7",140,0)
 I $D(GRMARY) D
"RTN","LRHBIN7",141,0)
 .S X1="" F  S X1=$O(GRMARY(X1)) Q:X1=""  D
"RTN","LRHBIN7",142,0)
 ..S LRFILE=63.29,LRIEN="+"_X1_","_LRIDT_","_LRDFN_","
"RTN","LRHBIN7",143,0)
 ..S RSLT=$$GET1^DIQ(LRFILE,X1_","_LRIDT_","_LRDFN_",",.01,"I")
"RTN","LRHBIN7",144,0)
 ..I GRMARY(X1)=$G(RSLT) Q
"RTN","LRHBIN7",145,0)
 ..S LRFDA(2,LRFILE,LRIEN,.01)=$G(GRMARY(X1))
"RTN","LRHBIN7",146,0)
 ..D UPDATE^DIE("","LRFDA(2)","LRIENS","LRMSG")
"RTN","LRHBIN7",147,0)
 ..K LRFDA,LRIEN,LRMSG,LRIENS
"RTN","LRHBIN7",148,0)
 ;
"RTN","LRHBIN7",149,0)
 ; NODE-3, FIELD-12 - ORGANISM -- FILE 63.3
"RTN","LRHBIN7",150,0)
 N FLG
"RTN","LRHBIN7",151,0)
 S (NUM,DA)=0
"RTN","LRHBIN7",152,0)
 ; file organism
"RTN","LRHBIN7",153,0)
 S QUIT=$P($G(^LR(LRDFN,"MI",LRIDT,3,0)),D1,3)
"RTN","LRHBIN7",154,0)
 I QUIT'="" D
"RTN","LRHBIN7",155,0)
 .F I=1:1:QUIT  D
"RTN","LRHBIN7",156,0)
 ..S LRFILE=63.3,LRIEN=I_","_LRIDT_","_LRDFN_","
"RTN","LRHBIN7",157,0)
 ..S ORGN=$$GET1^DIQ(LRFILE,LRIEN,.01,"I") Q:ORGN=""
"RTN","LRHBIN7",158,0)
 ..I $D(ORGNARY(ORGN)) S ORGARY(ORGN)=I
"RTN","LRHBIN7",159,0)
 ..I '$D(ORGNARY(ORGN)) S LRFDA(3,LRFILE,LRIEN,.01)="@" D UPDATE^DIE("","LRFDA(3)","LRIENS","LRMSG")
"RTN","LRHBIN7",160,0)
 S VAL="" F  S VAL=$O(ORG(VAL)) Q:VAL=""  D
"RTN","LRHBIN7",161,0)
 .S ORGC=0 F  S ORGC=$O(ORG(VAL,ORGC)) Q:ORGC=""  D
"RTN","LRHBIN7",162,0)
 ..S X1=ORGC,NUM=0
"RTN","LRHBIN7",163,0)
 ..S X=ORG(VAL,ORGC),LRORG=+X,LRCCNT=$G(LRCCNT(VAL))  ;BL;ADDED $G TO STOP M ERROR WHERE LRCCNT(VAL) UNDEFINED
"RTN","LRHBIN7",164,0)
 ..; Check if organism is already in file (#63)
"RTN","LRHBIN7",165,0)
 ..; Do not file organsim if it's already in file (#63)
"RTN","LRHBIN7",166,0)
 ..I '$D(ORGARY(LRORG)) D
"RTN","LRHBIN7",167,0)
 ...S QUIT=$P($G(^LR(LRDFN,"MI",LRIDT,3,0)),D1,3) I QUIT="" S QUIT=1
"RTN","LRHBIN7",168,0)
 ...S LRFILE=63.3,LRIEN="+"_QUIT_","_LRIDT_","_LRDFN_","
"RTN","LRHBIN7",169,0)
 ...S LRFDA(3,LRFILE,LRIEN,.01)=$G(LRORG)
"RTN","LRHBIN7",170,0)
 ...S LRFDA(3,LRFILE,LRIEN,1)=$G(LRCCNT(VAL))_" "
"RTN","LRHBIN7",171,0)
 ...D UPDATE^DIE("","LRFDA(3)","LRIENS","LRMSG")
"RTN","LRHBIN7",172,0)
 ...S NUM=$P($G(^LR(LRDFN,"MI",LRIDT,3,0)),D1,3)
"RTN","LRHBIN7",173,0)
 ...K LRFDA,LRIENS,LRMSG,LRIEN
"RTN","LRHBIN7",174,0)
 ...; file antibiotic and susc
"RTN","LRHBIN7",175,0)
 ..S LNC="" F  S LNC=$O(LRRS1(VAL,LNC)) Q:LNC=""  D
"RTN","LRHBIN7",176,0)
 ...I 'NUM S NUM=ORGARY(LRORG)
"RTN","LRHBIN7",177,0)
 ...S LRSUSC=LRRS1(VAL,LNC)
"RTN","LRHBIN7",178,0)
 ...S LNCARY=$$HL2LAH^LA7VHLU6(LNC,"","LN",2.14,"","MI")
"RTN","LRHBIN7",179,0)
 ...S LRCODE=$P(LNCARY,D1,4)
"RTN","LRHBIN7",180,0)
 ...Q:LRCODE=""
"RTN","LRHBIN7",181,0)
 ...I LRCODE'["." D
"RTN","LRHBIN7",182,0)
 ....S LRCODE=+$P(^DD(63.3,LRCODE,0),D1,4)
"RTN","LRHBIN7",183,0)
 ...Q:LRCODE=""
"RTN","LRHBIN7",184,0)
 ...S ^LR(LRDFN,"MI",LRIDT,3,NUM,LRCODE)=LRSUSC
"RTN","LRHBIN7",185,0)
 ...S SUSCARY(LRCODE)=LRSUSC
"RTN","LRHBIN7",186,0)
 ..S LRCODE=0 F  S LRCODE=$O(^LR(LRDFN,"MI",LRIDT,3,NUM,LRCODE)) Q:'LRCODE  D
"RTN","LRHBIN7",187,0)
 ...Q:LRCODE'>1
"RTN","LRHBIN7",188,0)
 ...I '$D(SUSCARY(LRCODE)) S ^LR(LRDFN,"MI",LRIDT,3,NUM,LRCODE)="^^"
"RTN","LRHBIN7",189,0)
 ..K SUSCARY
"RTN","LRHBIN7",190,0)
 S LROK=1
"RTN","LRHBIN7",191,0)
 Q
"RTN","LRHBIN7",192,0)
 ;
"RTN","LRHBIN7",193,0)
MI8 ; TB BACTERIOLOGY
"RTN","LRHBIN7",194,0)
 N FLG,LR1,LR2,LR3,NX,LRIEN,LRRS1,LRRS1,LRRS3,LRMYC,LRCMT,LRQTY
"RTN","LRHBIN7",195,0)
 N MYCC,MYCARY,MYARY,NUM,SUSCARY,QUIT,X1,X2,X,XCT,XX
"RTN","LRHBIN7",196,0)
 ; File 1 node of TB Bacteriology results
"RTN","LRHBIN7",197,0)
 S X=HLARY("OBX",1),LRSTS=$P(X,D1,11),LRCMT=""
"RTN","LRHBIN7",198,0)
 S LRFILE=63.05,LRIEN=LRIDT_","_LRDFN_","
"RTN","LRHBIN7",199,0)
 S LRFDA(11,LRFILE,LRIEN,22)=$G(LRCDT)
"RTN","LRHBIN7",200,0)
 S LRFDA(11,LRFILE,LRIEN,23)=$G(LRSTS)
"RTN","LRHBIN7",201,0)
 S LRFDA(11,LRFILE,LRIEN,25)=$G(LRQTY)
"RTN","LRHBIN7",202,0)
 S LRFDA(11,LRFILE,LRIEN,25.5)=$G(JVTECH)
"RTN","LRHBIN7",203,0)
 D UPDATE^DIE("","LRFDA(11)","LRIENS","LRMSG")
"RTN","LRHBIN7",204,0)
 K LRFDA,LRIEN,LRIENS,LRMSG
"RTN","LRHBIN7",205,0)
 S LRIEN=LRIDT_","_LRDFN_",",LRFILE=63.05
"RTN","LRHBIN7",206,0)
 S LRFDA(99,LRFILE,LRIEN,.99)=$G(LRCMT)
"RTN","LRHBIN7",207,0)
 D UPDATE^DIE("","LRFDA(99)","LRIENS","LRMSG")
"RTN","LRHBIN7",208,0)
 S (LR1,LR2,LR3,LR4,MYCC)=0
"RTN","LRHBIN7",209,0)
 S NX="" F  S NX=$O(HLARY("OBX",NX)) Q:'NX  D
"RTN","LRHBIN7",210,0)
 .S X=HLARY("OBX",NX)
"RTN","LRHBIN7",211,0)
 .I $P(X,D1,2)="CE" D
"RTN","LRHBIN7",212,0)
 ..S VAL=$P(X,D1,4),MYCC=MYCC+1
"RTN","LRHBIN7",213,0)
 ..S LIEN=$P($P(X,D1,3),D2,4),MYC(VAL,MYCC)=LIEN
"RTN","LRHBIN7",214,0)
 ..S MYCOARY(LIEN)=""
"RTN","LRHBIN7",215,0)
 .I $P(X,D1,2)="ST" D
"RTN","LRHBIN7",216,0)
 ..I $P(X,D1,3)["COLONY COUNT" D
"RTN","LRHBIN7",217,0)
 ...S VAL=$P(X,D1,4),LRRS1(VAL)=$P(X,D1,5)
"RTN","LRHBIN7",218,0)
 ..I $P(X,D1,3)["SUSC" D
"RTN","LRHBIN7",219,0)
 ...S ANT=$P($P(X,D1,3),D2,2),ANT=$P(ANT,":")
"RTN","LRHBIN7",220,0)
 ...S SUBSC="",SUBSC=$O(^DD(63.39,"B",ANT,SUBSC))
"RTN","LRHBIN7",221,0)
 ...S VAL=$P(X,D1,4),LRSUSC=$P(X,D1,8)
"RTN","LRHBIN7",222,0)
 ...S LRRS2(VAL,SUBSC)=LRSUSC
"RTN","LRHBIN7",223,0)
 ..I $P(X,D1,3)[87860.0000 D
"RTN","LRHBIN7",224,0)
 ...S LR3=LR3+1,LRCMT=$P(X,D1,5),LRRS3(LR3)=LRCMT
"RTN","LRHBIN7",225,0)
 ..I $P(X,D1,3)[11545 D
"RTN","LRHBIN7",226,0)
 ...S LRACFST=$P(X,D1,5),LR4=LR4+1,LRRS4(LR4)=LRACFST
"RTN","LRHBIN7",227,0)
 ;
"RTN","LRHBIN7",228,0)
 ; NODE-12, FIELD-26 -- 63.39 MYCOBACTERIUM
"RTN","LRHBIN7",229,0)
 ; NODE-12, FIELD-2 -- 63.4 COMMENT
"RTN","LRHBIN7",230,0)
 S NUM=0
"RTN","LRHBIN7",231,0)
 S QUIT=$P($G(^LR(LRDFN,"MI",LRIDT,12,0)),D1,3)
"RTN","LRHBIN7",232,0)
 I QUIT'="" D
"RTN","LRHBIN7",233,0)
 .F I=1:1:QUIT  D
"RTN","LRHBIN7",234,0)
 ..S LRIEN=I_","_LRIDT_","_LRDFN_",",LRFILE=63.39
"RTN","LRHBIN7",235,0)
 ..S MYCO=$$GET1^DIQ(63.39,LRIEN,.01,"I") Q:MYCO=""
"RTN","LRHBIN7",236,0)
 ..I $D(MYCOARY(MYCO)) S MYARY(MYCO)=I
"RTN","LRHBIN7",237,0)
 ..I '$D(MYCOARY(MYCO)) S LRFDA(12,LRFILE,LRIEN,.01)="@" D UPDATE^DIE("","LRFDA(12)","LRIENS","LRMSG")
"RTN","LRHBIN7",238,0)
 S VAL="" F  S VAL=$O(MYC(VAL)) Q:VAL=""  D
"RTN","LRHBIN7",239,0)
 .S MYCC=0 F  S MYCC=$O(MYC(VAL,MYCC)) Q:MYCC=""  D
"RTN","LRHBIN7",240,0)
 ..S X1=MYCC,NUM=0
"RTN","LRHBIN7",241,0)
 ..S X=MYC(VAL,MYCC),LRORG=+X,LRCCNT=LRRS1(VAL)
"RTN","LRHBIN7",242,0)
 ..I '$D(MYARY(LRORG)) D
"RTN","LRHBIN7",243,0)
 ...S QUIT=$P($G(^LR(LRDFN,"MI",LRIDT,12,0)),D1,3) I QUIT="" S QUIT=1
"RTN","LRHBIN7",244,0)
 ...S LRIEN="+"_QUIT_","_LRIDT_","_LRDFN_",",LRFILE=63.39
"RTN","LRHBIN7",245,0)
 ...S LRFDA(12,LRFILE,LRIEN,.01)=$G(MYC(VAL,MYCC))
"RTN","LRHBIN7",246,0)
 ...S LRFDA(12,LRFILE,LRIEN,1)=$G(LRRS1(VAL))
"RTN","LRHBIN7",247,0)
 ...D UPDATE^DIE("","LRFDA(12)","LRIENS","LRMSG")
"RTN","LRHBIN7",248,0)
 ...S NUM=$P($G(^LR(LRDFN,"MI",LRIDT,12,0)),D1,3)
"RTN","LRHBIN7",249,0)
 ..S LNC="" F  S LNC=$O(LRRS2(VAL,LNC)) Q:LNC=""  D
"RTN","LRHBIN7",250,0)
 ...I 'NUM S NUM=MYARY(LRORG)
"RTN","LRHBIN7",251,0)
 ...S LRSUSC=LRRS2(VAL,LNC)
"RTN","LRHBIN7",252,0)
 ...S ^LR(LRDFN,"MI",LRIDT,12,NUM,LNC)=LRSUSC
"RTN","LRHBIN7",253,0)
 ...S SUSCARY(LNC)=LRSUSC
"RTN","LRHBIN7",254,0)
 ..S LRCODE=0 F  S LRCODE=$O(^LR(LRDFN,"MI",LRIDT,12,NUM,LRCODE)) Q:'LRCODE  D
"RTN","LRHBIN7",255,0)
 ...Q:LRCODE'>1
"RTN","LRHBIN7",256,0)
 ...I '$D(SUSCARY(LRCODE)) S ^LR(LRDFN,"MI",LRIDT,12,NUM,LRCODE)="^^"
"RTN","LRHBIN7",257,0)
 ..K SUSCARY
"RTN","LRHBIN7",258,0)
 ;
"RTN","LRHBIN7",259,0)
 ; NODE-13, FIELD-27- -- 63.41 TB RPT REMARK
"RTN","LRHBIN7",260,0)
 S X1="" F  S X1=$O(LRRS3(X1)) Q:X1=""  D
"RTN","LRHBIN7",261,0)
 .S LRFILE=63.41,LRIEN=X1_","_LRIDT_","_LRDFN_","
"RTN","LRHBIN7",262,0)
 .S RSLT=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN7",263,0)
 .I LRRS3(X1)=$G(RSLT) Q
"RTN","LRHBIN7",264,0)
 .S LRIEN="+"_X1_","_LRIDT_","_LRDFN_",",LRFILE=63.41
"RTN","LRHBIN7",265,0)
 .S LRFDA(13,LRFILE,LRIEN,.01)=$G(LRRS3(X1))
"RTN","LRHBIN7",266,0)
 .D UPDATE^DIE("","LRFDA(13)","LRIENS","LRMSG")
"RTN","LRHBIN7",267,0)
 ; File Acid Fast Stain result
"RTN","LRHBIN7",268,0)
 S X1="" F  S X1=$O(LRRS4(X1)) Q:X1=""  D
"RTN","LRHBIN7",269,0)
 .S LRFILE=63.05,LRIEN=LRIDT_","_LRDFN_","
"RTN","LRHBIN7",270,0)
 .S LRFDA(11,LRFILE,LRIEN,24)=$G(LRRS4(1))
"RTN","LRHBIN7",271,0)
 .D UPDATE^DIE("","LRFDA(11)","LRIENS","LRMSG")
"RTN","LRHBIN7",272,0)
 S LROK=1
"RTN","LRHBIN7",273,0)
 Q
"RTN","LRHBIN7",274,0)
 ;
"RTN","LRHBIN7",275,0)
MI9 ; MYCOLOGY -- 9
"RTN","LRHBIN7",276,0)
 N FLG,LR1,LR2,L3,LRIEN,LRFILE,LRRS1,LRRS2,LRRS3,LRSMP,QUIT,X,X1
"RTN","LRHBIN7",277,0)
 S X=HLARY("OBX",1),LRSTS=$P(X,D1,11),LRCMT=""
"RTN","LRHBIN7",278,0)
 S LRIEN=LRIDT_","_LRDFN_",",LRFILE=63.05
"RTN","LRHBIN7",279,0)
 S LRFDA(8,LRFILE,LRIEN,18)=LRCDT
"RTN","LRHBIN7",280,0)
 S LRFDA(8,LRFILE,LRIEN,19)=LRSTS
"RTN","LRHBIN7",281,0)
 S LRFDA(8,LRFILE,LRIEN,19.5)=$G(JVTECH)
"RTN","LRHBIN7",282,0)
 D UPDATE^DIE("","LRFDA(8)","LRIENS","LRMSG")
"RTN","LRHBIN7",283,0)
 K LRFDA,LRIENS,LRMSG
"RTN","LRHBIN7",284,0)
 S LRIEN=LRIDT_","_LRDFN_",",LRFILE=63.05
"RTN","LRHBIN7",285,0)
 S LRFDA(99,LRFILE,LRIEN,.99)=$G(LRCMT)
"RTN","LRHBIN7",286,0)
 D UPDATE^DIE("","LRFDA(99)","LRIENS","LRMSG")
"RTN","LRHBIN7",287,0)
 ;
"RTN","LRHBIN7",288,0)
 S (LR1,LR2,LR3)=0
"RTN","LRHBIN7",289,0)
 ; Capture the Fungas IEN
"RTN","LRHBIN7",290,0)
 S NX="" F  S NX=$O(HLARY("OBX",NX)) Q:'NX  D
"RTN","LRHBIN7",291,0)
 .S X=HLARY("OBX",NX)
"RTN","LRHBIN7",292,0)
 .I $P(X,D1,2)="CE" D
"RTN","LRHBIN7",293,0)
 ..S LIEN=$P($P(X,D1,3),D2)
"RTN","LRHBIN7",294,0)
 ..S LR1=LR1+1,LRRS1(LR1)=LIEN,FNGARY(LIEN)=""
"RTN","LRHBIN7",295,0)
 .I $P(X,D1,2)="ST" D
"RTN","LRHBIN7",296,0)
 ..S XX=$P(X,D1,3) D
"RTN","LRHBIN7",297,0)
 ...I XX["93974.0000" S LR2=LR2+1,LRMCMT=$P(X,D1,5),LRRS2(LR2)=LRMCMT ;Mycology Rpt Remark
"RTN","LRHBIN7",298,0)
 ...I XX["93984.0000" S LR3=LR3+1,LRSMP=$P(X,D1,5),LRRS3(LR3)=LRSMP ; Mycology Smear/Prep
"RTN","LRHBIN7",299,0)
 ; NODE-9, FIELD-63.37 FUNGUS/YEAST
"RTN","LRHBIN7",300,0)
 S QUIT=$P($G(^LR(LRDFN,"MI",LRIDT,9,0)),D1,3)
"RTN","LRHBIN7",301,0)
 I QUIT'="" D  ; If fungus is new, file it, if it's there do not file.
"RTN","LRHBIN7",302,0)
 .F I=1:1:QUIT  D
"RTN","LRHBIN7",303,0)
 ..S LRIEN=I_","_LRIDT_","_LRDFN_",",LRFILE=63.37
"RTN","LRHBIN7",304,0)
 ..S FUNG=$$GET1^DIQ(63.37,LRIEN,.01,"I") Q:FUNG=""
"RTN","LRHBIN7",305,0)
 ..I $D(FNGARY(FUNG)) S FNARY(FUNG)=I
"RTN","LRHBIN7",306,0)
 ..I '$D(FNGARY(FUNG)) S LRFDA(9,LRFILE,LRIEN,.01)="@" D UPDATE^DIE("","LRFDA(9)","LRIENS","LRMSG")
"RTN","LRHBIN7",307,0)
 S X1="" F  S X1=$O(LRRS1(X1)) Q:X1=""  D
"RTN","LRHBIN7",308,0)
 .I '$D(FNARY(LRRS1(X1))) D
"RTN","LRHBIN7",309,0)
 ..S QUIT=$P($G(^LR(LRDFN,"MI",LRIDT,9,0)),D1,3) I QUIT="" S QUIT=1
"RTN","LRHBIN7",310,0)
 ..S LRIEN="+"_QUIT_","_LRIDT_","_LRDFN_",",LRFILE=63.37
"RTN","LRHBIN7",311,0)
 ..S LRFDA(9,LRFILE,LRIEN,.01)=$G(LIEN)
"RTN","LRHBIN7",312,0)
 ..D UPDATE^DIE("","LRFDA(9)","LRIENS","LRMSG")
"RTN","LRHBIN7",313,0)
 ; NODE-10, FIELD-21 MYCOLOGY RPT REMARK
"RTN","LRHBIN7",314,0)
 S X1="" F  S X1=$O(LRRS2(X1)) Q:X1=""  D
"RTN","LRHBIN7",315,0)
 .S LRFILE=63.38
"RTN","LRHBIN7",316,0)
 .S RSLT=$$GET1^DIQ(LRFILE,X1_","_LRIDT_","_LRDFN_",",.01,"I")
"RTN","LRHBIN7",317,0)
 .I LRRS2(X1)=$G(RSLT) Q
"RTN","LRHBIN7",318,0)
 .S LRIEN="+"_X1_","_LRIDT_","_LRDFN_","
"RTN","LRHBIN7",319,0)
 .S LRFDA(10,LRFILE,LRIEN,.01)=$G(LRRS2(X1))
"RTN","LRHBIN7",320,0)
 .D UPDATE^DIE("","LRFDA(10)","LRIENS","LRMSG")
"RTN","LRHBIN7",321,0)
 .K LRIENS,LRMSG
"RTN","LRHBIN7",322,0)
 ; NODE-15, FIELD 19.6 MYCOLOGY SMEAR/PREP
"RTN","LRHBIN7",323,0)
 S X1="" F  S X1=$O(LRRS3(X1)) Q:X1=""  D
"RTN","LRHBIN7",324,0)
 .S LRFILE=63.371
"RTN","LRHBIN7",325,0)
 .S RSLT=$$GET1^DIQ(LRFILE,X1_","_LRIDT_","_LRDFN_",",.01,"I")
"RTN","LRHBIN7",326,0)
 .I LRRS3(X1)=$G(RSLT) Q
"RTN","LRHBIN7",327,0)
 .S LRIEN="+"_X1_","_LRIDT_","_LRDFN_","
"RTN","LRHBIN7",328,0)
 .S LRFDA(15,LRFILE,LRIEN,.01)=$G(LRRS3(X1))
"RTN","LRHBIN7",329,0)
 .D UPDATE^DIE("","LRFDA(15)","LRIENS","LRMSG")
"RTN","LRHBIN7",330,0)
 .K LRIENS,LRMSG
"RTN","LRHBIN7",331,0)
 ;
"RTN","LRHBIN7",332,0)
 S LROK=1
"RTN","LRHBIN7",333,0)
 Q
"RTN","LRHBIN7",334,0)
 ;
"RTN","LRHBIN7",335,0)
MI10 ; PARISITOLOGY LRSB=10
"RTN","LRHBIN7",336,0)
 ;
"RTN","LRHBIN7",337,0)
 N N,DA,X,X2,X3,LRRS1,LRRS2,LRRS3,LRC1,LRC2,LRC3,QUIT
"RTN","LRHBIN7",338,0)
 ;File Provider, Lab test and Collection Date/Time in Lab Data file (#63)
"RTN","LRHBIN7",339,0)
 ; Get status from incoming message, OBX-11.  Final or Prelim.
"RTN","LRHBIN7",340,0)
 S X=HLARY("OBX",1),LRSTS=$P(X,D1,11),LRCMT=""
"RTN","LRHBIN7",341,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRHBIN7",342,0)
 S LRFILE=63.05
"RTN","LRHBIN7",343,0)
 S LRFDA(5,LRFILE,LRIEN,14)=LRCDT
"RTN","LRHBIN7",344,0)
 S LRFDA(5,LRFILE,LRIEN,15)=LRSTS
"RTN","LRHBIN7",345,0)
 S LRFDA(5,LRFILE,LRIEN,15.5)=$G(JVTECH)
"RTN","LRHBIN7",346,0)
 D UPDATE^DIE("","LRFDA(5)","LRIENS","LRMSG")
"RTN","LRHBIN7",347,0)
 K LRFDA,LRIEN,LRIENS,LRMSG
"RTN","LRHBIN7",348,0)
 S LRIEN=LRIDT_","_LRDFN_",",LRFILE=63.05
"RTN","LRHBIN7",349,0)
 S LRFDA(99,LRFILE,LRIEN,.99)=$G(LRCMT)
"RTN","LRHBIN7",350,0)
 D UPDATE^DIE("","LRFDA(99)","LRIENS","LRMSG")
"RTN","LRHBIN7",351,0)
 ; Get the results from multiple OBX segments: Stage, Parasite remark, Parasite ID
"RTN","LRHBIN7",352,0)
 S LRC1=0,LRC2=0,LRC3=0,SUB=""
"RTN","LRHBIN7",353,0)
 S N=0 F  S N=$O(HLARY("OBX",N)) Q:'N  D
"RTN","LRHBIN7",354,0)
 .S X=HLARY("OBX",N),X3=$P($P(X,D1,3),D2,1) I X3="87505.0000" S SUB=$P(X,D1,4),LRRS1(SUB)=$P(X,D1,5) Q
"RTN","LRHBIN7",355,0)
 .S X=HLARY("OBX",N),X3=$P($P(X,D1,3),D2,1) I X3="93929.0000" S LRC2=LRC2+1,LRRS2(LRC2)=$P(X,D1,5) Q
"RTN","LRHBIN7",356,0)
 .S X=HLARY("OBX",N),X3=$P(X,D1,3) I X3["99VA61.2" D
"RTN","LRHBIN7",357,0)
 ..S LRC3=LRC3+1,SUB=$P(X,D1,4),LRRS3(SUB,LRC3)=$P($P(X,D1,5),D2),INCPARY(LRRS3(SUB,LRC3))="" Q
"RTN","LRHBIN7",358,0)
 ;
"RTN","LRHBIN7",359,0)
 ;16 File Parasite and stage of growth in Lab Data file (#63)
"RTN","LRHBIN7",360,0)
 S QUIT=$P($G(^LR(LRDFN,"MI",LRIDT,6,0)),D1,3)
"RTN","LRHBIN7",361,0)
 I QUIT'="" D
"RTN","LRHBIN7",362,0)
 .F I=1:1:QUIT  D
"RTN","LRHBIN7",363,0)
 ..S LRIEN=I_","_LRIDT_","_LRDFN_",",LRFILE=63.34
"RTN","LRHBIN7",364,0)
 ..S PARAS=$$GET1^DIQ(63.34,LRIEN,.01,"I") Q:PARAS=""
"RTN","LRHBIN7",365,0)
 ..I $D(INCPARY(PARAS)) S PARY(PARAS)=I
"RTN","LRHBIN7",366,0)
 ..I '$D(INCPARY(PARAS)) S LRFDA(6,LRFILE,LRIEN,.01)="@" D UPDATE^DIE("","LRFDA(6)","LRIENS","LRMSG")
"RTN","LRHBIN7",367,0)
 .; If no parasite is found in message, delete from file (#63).
"RTN","LRHBIN7",368,0)
 S NUM=0
"RTN","LRHBIN7",369,0)
 S VAL="" F  S VAL=$O(LRRS3(VAL)) Q:VAL=""  D
"RTN","LRHBIN7",370,0)
 .S X1="" F  S X1=$O(LRRS3(VAL,X1)) Q:X1=""  D
"RTN","LRHBIN7",371,0)
 ..S PARAS=LRRS3(VAL,X1),NUM=0
"RTN","LRHBIN7",372,0)
 ..I '$D(PARY(PARAS)) D
"RTN","LRHBIN7",373,0)
 ...S QUIT=$P($G(^LR(LRDFN,"MI",LRIDT,6,0)),D1,3) I QUIT="" S QUIT=1
"RTN","LRHBIN7",374,0)
 ...S LRIEN="+"_QUIT_","_LRIDT_","_LRDFN_",",LRFILE=63.34
"RTN","LRHBIN7",375,0)
 ...S LRFDA(6,63.34,LRIEN,.01)=PARAS
"RTN","LRHBIN7",376,0)
 ...D UPDATE^DIE("","LRFDA(6)","LRIENS","LRMSG")
"RTN","LRHBIN7",377,0)
 ...S NUM=$P($G(^LR(LRDFN,"MI",LRIDT,6,0)),"^",3)
"RTN","LRHBIN7",378,0)
 ..I $D(LRRS1) D  ;Stage of growth
"RTN","LRHBIN7",379,0)
 ...S LRFILE=63.35
"RTN","LRHBIN7",380,0)
 ...S STAGE=LRRS1(VAL),STAGE=$E(STAGE,1)
"RTN","LRHBIN7",381,0)
 ...I 'NUM S NUM=PARY(PARAS)
"RTN","LRHBIN7",382,0)
 ...S NUM1=$P($G(^LR(LRDFN,"MI",LRIDT,6,NUM,1,0)),"^",3)
"RTN","LRHBIN7",383,0)
 ...I NUM1="" S NUM1=1 D
"RTN","LRHBIN7",384,0)
 ....S LRIEN="+"_NUM1_","_NUM_","_LRIDT_","_LRDFN_",",LRFILE=63.35
"RTN","LRHBIN7",385,0)
 ....S LRFDA(6,63.35,LRIEN,.01)=$G(STAGE)
"RTN","LRHBIN7",386,0)
 ....D UPDATE^DIE("","LRFDA(6)","LRIENS","LRMSG")
"RTN","LRHBIN7",387,0)
 ...I NUM1'="" D
"RTN","LRHBIN7",388,0)
 ....S RSLT=$$GET1^DIQ(LRFILE,NUM1_","_NUM_","_LRIDT_","_LRDFN_",",.01)
"RTN","LRHBIN7",389,0)
 ....S RSLT=$E(RSLT,1) I RSLT=STAGE Q
"RTN","LRHBIN7",390,0)
 ....S LRIEN="+"_NUM1_","_NUM_","_LRIDT_","_LRDFN_",",LRFILE=63.35
"RTN","LRHBIN7",391,0)
 ....S LRFDA(6,63.35,LRIEN,.01)=$G(STAGE)
"RTN","LRHBIN7",392,0)
 ....D UPDATE^DIE("","LRFDA(6)","LRIENS","LRMSG")
"RTN","LRHBIN7",393,0)
 ;17   File Parasite Report Remark in Lab Data file (#63)
"RTN","LRHBIN7",394,0)
 I $D(LRRS2) D
"RTN","LRHBIN7",395,0)
 .S X1="" F  S X1=$O(LRRS2(X1)) Q:X1=""  D
"RTN","LRHBIN7",396,0)
 ..S LRFILE=63.36
"RTN","LRHBIN7",397,0)
 ..S RSLT=$$GET1^DIQ(LRFILE,X1_","_LRIDT_","_LRDFN_",",.01,"I")
"RTN","LRHBIN7",398,0)
 ..I LRRS2(X1)=$G(RSLT) Q
"RTN","LRHBIN7",399,0)
 ..S LRIEN="+"_X1_","_LRIDT_","_LRDFN_","
"RTN","LRHBIN7",400,0)
 ..S LRFDA(7,63.36,LRIEN,.01)=$G(LRRS2(X1))
"RTN","LRHBIN7",401,0)
 ..D UPDATE^DIE("","LRFDA(7)","LRIENS","LRMSG")
"RTN","LRHBIN7",402,0)
 K LRIEN,LRFDA,LRFILE
"RTN","LRHBIN7",403,0)
 S LROK=1
"RTN","LRHBIN7",404,0)
 Q
"RTN","LRHBIN7",405,0)
 ;
"RTN","LRHBIN7",406,0)
MI16 ; VIROLOGY LRBS=16
"RTN","LRHBIN7",407,0)
 ;
"RTN","LRHBIN7",408,0)
 N LR1,LR2,LRIEN,LRFILE,LRRS1,LRRS2,NX,QUIT,X,XCT
"RTN","LRHBIN7",409,0)
 S X=HLARY("OBX",1),LRSTS=$P(X,D1,11),LRCMT="",LRCMT=""
"RTN","LRHBIN7",410,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRHBIN7",411,0)
 S LRFILE=63.05
"RTN","LRHBIN7",412,0)
 S LRFDA(16,LRFILE,LRIEN,33)=LRCDT
"RTN","LRHBIN7",413,0)
 S LRFDA(16,LRFILE,LRIEN,34)=LRSTS
"RTN","LRHBIN7",414,0)
 S LRFDA(16,LRFILE,LRIEN,35)=$G(JVTECH)
"RTN","LRHBIN7",415,0)
 D UPDATE^DIE("","LRFDA(16)","LRIENS","LRMSG")
"RTN","LRHBIN7",416,0)
 K LRFDA,LRIEN,LRIENS,LRMSG
"RTN","LRHBIN7",417,0)
 S LRIEN=LRIDT_","_LRDFN_",",LRFILE=63.05
"RTN","LRHBIN7",418,0)
 S LRFDA(99,LRFILE,LRIEN,.99)=$G(LRCMT)
"RTN","LRHBIN7",419,0)
 D UPDATE^DIE("","LRFDA(99)","LRIENS","LRMSG")
"RTN","LRHBIN7",420,0)
 S (LR1,LR2)=0
"RTN","LRHBIN7",421,0)
 K LRRS1
"RTN","LRHBIN7",422,0)
 S NX="" F  S NX=$O(HLARY("OBX",NX)) Q:'NX  D
"RTN","LRHBIN7",423,0)
 .S X=HLARY("OBX",NX)
"RTN","LRHBIN7",424,0)
 .I $P(X,D1,2)="CE" S LR1=LR1+1 D
"RTN","LRHBIN7",425,0)
 ..S LRIEN=$P($P(X,D1,3),D2)
"RTN","LRHBIN7",426,0)
 ..S LRRS1(LR1)=LRIEN,VIRARY(LRIEN)=""
"RTN","LRHBIN7",427,0)
 .I $P(X,D1,2)="ST" S LR2=LR2+1 D
"RTN","LRHBIN7",428,0)
 ..S LRCMT=$P(X,D1,5)
"RTN","LRHBIN7",429,0)
 ..S LRRS2(LR2)=LRCMT
"RTN","LRHBIN7",430,0)
 ;
"RTN","LRHBIN7",431,0)
 S QUIT=$P($G(^LR(LRDFN,"MI",LRIDT,17,0)),D1,3)
"RTN","LRHBIN7",432,0)
 I QUIT'="" D
"RTN","LRHBIN7",433,0)
 .F I=1:1:QUIT  D
"RTN","LRHBIN7",434,0)
 ..S LRIEN=I_","_LRIDT_","_LRDFN_",",LRFILE=63.43
"RTN","LRHBIN7",435,0)
 ..S VIRUS=$$GET1^DIQ(LRFILE,LRIEN,.01,"I") Q:VIRUS=""
"RTN","LRHBIN7",436,0)
 ..I $D(VIRARY(VIRUS)) S VARY(VIRUS)=I
"RTN","LRHBIN7",437,0)
 ..I '$D(VIRARY(VIRUS)) S LRFDA(17,LRFILE,LRIEN,.01)="@" D UPDATE^DIE("","LRFDA(17)","LRIENS","LRMSG")
"RTN","LRHBIN7",438,0)
 S LR1="" F  S LR1=$O(LRRS1(LR1)) Q:'LR1  D
"RTN","LRHBIN7",439,0)
 .I '$D(VARY(LRRS1(LR1))) D
"RTN","LRHBIN7",440,0)
 ..S QUIT=$P($G(^LR(LRDFN,"MI",LRIDT,17,0)),D1,3) I QUIT="" S QUIT=1
"RTN","LRHBIN7",441,0)
 ..S LRIEN="+"_QUIT_","_LRIDT_","_LRDFN_",",LRFILE=63.43
"RTN","LRHBIN7",442,0)
 ..S LRFDA(17,LRFILE,LRIEN,.01)=$G(LRRS1(LR1))
"RTN","LRHBIN7",443,0)
 ..D UPDATE^DIE("","LRFDA(17)","LRIENS","LRMSG")
"RTN","LRHBIN7",444,0)
 ; Virology report remark
"RTN","LRHBIN7",445,0)
 S LR1="" F  S LR1=$O(LRRS2(LR1)) Q:'LR1  D
"RTN","LRHBIN7",446,0)
 .S RSLT=$$GET1^DIQ(63.44,LR1_","_LRIDT_","_LRDFN_",",.01,"I")
"RTN","LRHBIN7",447,0)
 .I LRRS2(LR1)=$G(RSLT) Q
"RTN","LRHBIN7",448,0)
 .S LRFILE=63.44,LRIEN="+"_LR1_","_LRIDT_","_LRDFN_","
"RTN","LRHBIN7",449,0)
 .S LRFDA(18,LRFILE,LRIEN,.01)=$G(LRRS2(LR1))
"RTN","LRHBIN7",450,0)
 .D UPDATE^DIE("","LRFDA(18)","LRIEN","LRMSG")
"RTN","LRHBIN7",451,0)
 S LROK=1
"RTN","LRHBIN7",452,0)
 Q
"RTN","LRHBIN7",453,0)
 ;
"RTN","LRHBIN7",454,0)
MI23 ; GRAM STAIN LABELED -- 23
"RTN","LRHBIN7",455,0)
 N LRRS1,N1,N2,S1,X1
"RTN","LRHBIN7",456,0)
 S S1=0
"RTN","LRHBIN7",457,0)
 S X=HLARY("OBX",1),LRSTS=$P(X,D1,11),LRCMT=""
"RTN","LRHBIN7",458,0)
 S LRIEN=LRIDT_","_LRDFN_","
"RTN","LRHBIN7",459,0)
 S LRFILE=63.05
"RTN","LRHBIN7",460,0)
 S LRFDA(1,LRFILE,LRIEN,11)=$G(LRCDT)
"RTN","LRHBIN7",461,0)
 S LRFDA(1,LRFILE,LRIEN,11.5)=$G(LRSTS)
"RTN","LRHBIN7",462,0)
 S LRFDA(1,LRFILE,LRIEN,11.55)=$G(JVTECH)
"RTN","LRHBIN7",463,0)
 D UPDATE^DIE("","LRFDA(1)","LRIENS","LRMSG")
"RTN","LRHBIN7",464,0)
 K LRFDA,LRIENS,LRMSG,LRFILE
"RTN","LRHBIN7",465,0)
 S N1="" F  S N1=$O(HLOBX(N1)) Q:N1=""  D
"RTN","LRHBIN7",466,0)
 .S LR4=$P($P(HLOBX(N1),D1,4),D2,1)
"RTN","LRHBIN7",467,0)
 .S LRFILE=60,LRIEN=LR4_",",LR4=$$GET1^DIQ(LRFILE,LRIEN,.01,"I")
"RTN","LRHBIN7",468,0)
 .S N2="" F  S N2=$O(HLOBX(N1,N2)) Q:'N2  D
"RTN","LRHBIN7",469,0)
 ..S S1=S1+1,LRRS1(S1)=$P(HLOBX(N1,N2),D1,5)
"RTN","LRHBIN7",470,0)
 S X1="" F  S X1=$O(LRRS1(X1)) Q:X1=""  D
"RTN","LRHBIN7",471,0)
 .S RSLT=$$GET1^DIQ(63.29,X1_","_LRIDT_","_LRDFN_",",.01,"I")
"RTN","LRHBIN7",472,0)
 .I LRRS1(X1)=$G(RSLT) Q
"RTN","LRHBIN7",473,0)
 .S LRIEN="+"_X1_","_LRIDT_","_LRDFN_","
"RTN","LRHBIN7",474,0)
 .S LRFDA(2,63.29,LRIEN,.01)=$G(LRRS1(X1))
"RTN","LRHBIN7",475,0)
 .D UPDATE^DIE("","LRFDA(2)","LRIENS","LRMSG")
"RTN","LRHBIN7",476,0)
 S LROK=1
"RTN","LRHBIN7",477,0)
 Q
"RTN","LRHBIN7",478,0)
 ;
"RTN","LRHBIN7",479,0)
EXIT ;
"RTN","LRHBIN7",480,0)
 K ANT,DATA,D1,D2,DC3,DR,EXEC,FLAG,FLD,FLG,FNARY,FNGARY,FUNG,HLOBX,I,INCPARY,K,LIEN,LR4,LR6207
"RTN","LRHBIN7",481,0)
 K LRACFST,LRBG0,LNC,LNCARY,LRCCNT,LRCDT,LRCODE,LRI,LRIDT,LRMIDEF,LRMIOTH,LRDFN,LRMCMT,JVTECH
"RTN","LRHBIN7",482,0)
 K LRODT,LROK,LRORD,LRORG,LRPTP,LRPRV,LRVPRV,LRRDT,LRRS1,LRRS2,LRRS3,LRRS4,LRSAMELRSPT
"RTN","LRHBIN7",483,0)
 K LRSN,LRSITE,LRSS,LRSTS,LRUNDO,LRD,LRVAL,LRVPRN,MYCARY,MYC,MYCC,MYCO,MYCOARY,NUM
"RTN","LRHBIN7",484,0)
 K NUM1,ORDNM,PAARY,PARARY,PARY,PARA,PARAS,ORGARY,ORGN,ORGNARY,RSITE,RSLT,SITE,ST,STAGE
"RTN","LRHBIN7",485,0)
 K SUB,SUBSC,SUSCARY,TIM,VA,VAL,VIRARY,VIRUS,VARY,X,X1,X2,X3,X5,XN,Y
"RTN","LRHBIN7",486,0)
 Q
"RTN","LRHBIN7",487,0)
 ;
"RTN","LRHBR1")
0^9^B117641163
"RTN","LRHBR1",1,0)
LRHBR1 ;LEIDOS/TCK - REMOTE ORDERING - REMOTE LAB/RAD ORDERS BY LOCATION ; 5/20/16 7:35am
"RTN","LRHBR1",2,0)
 ;;1.0;REMOTE ORDERS;;OCT 1,2016;Build 19
"RTN","LRHBR1",3,0)
 ;
"RTN","LRHBR1",4,0)
 Q
"RTN","LRHBR1",5,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",6,0)
LAB ; Entry point for Remote Laboratory Orders by Location.
"RTN","LRHBR1",7,0)
 ;
"RTN","LRHBR1",8,0)
 S LRT=2
"RTN","LRHBR1",9,0)
 ;
"RTN","LRHBR1",10,0)
 D INIT,GDT:'LREND,LOC:'LREND,DETAIL:'LREND,GDV:'LREND,RUN:'LREND,STOP
"RTN","LRHBR1",11,0)
 ;
"RTN","LRHBR1",12,0)
 Q
"RTN","LRHBR1",13,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",14,0)
RAD ; Entry point for Remote Radiology Orders by Location.
"RTN","LRHBR1",15,0)
 ;
"RTN","LRHBR1",16,0)
 S LRT=1
"RTN","LRHBR1",17,0)
 ;
"RTN","LRHBR1",18,0)
 D INIT,GDT:'LREND,LOC:'LREND,DETAIL:'LREND,GDV:'LREND,RUN:'LREND,STOP
"RTN","LRHBR1",19,0)
 ;
"RTN","LRHBR1",20,0)
 Q
"RTN","LRHBR1",21,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",22,0)
TAT ; Entry point for Turnaround Time for Remote Lab Orders report.
"RTN","LRHBR1",23,0)
 ;
"RTN","LRHBR1",24,0)
 S LRT="2A"
"RTN","LRHBR1",25,0)
 ;
"RTN","LRHBR1",26,0)
 D INIT,GDT:'LREND,LOC:'LREND,DETAIL:'LREND,GDV:'LREND,RUN:'LREND,STOP
"RTN","LRHBR1",27,0)
 ;
"RTN","LRHBR1",28,0)
 Q
"RTN","LRHBR1",29,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",30,0)
INIT ; Initialize common variables.
"RTN","LRHBR1",31,0)
 ;
"RTN","LRHBR1",32,0)
 S U="^",B="|",S=";"
"RTN","LRHBR1",33,0)
 S LREND=0,LRSDT="TODAY",LREDT="T-7"
"RTN","LRHBR1",34,0)
 I LRT="2A" W !,"Turnaround Time for Remote Lab Orders" Q
"RTN","LRHBR1",35,0)
 W !,"REMOTE ORDERS - Remote ",$S(LRT=1:"Radiology",1:"Lab")
"RTN","LRHBR1",36,0)
 W " Orders by Location"
"RTN","LRHBR1",37,0)
 ;
"RTN","LRHBR1",38,0)
 Q
"RTN","LRHBR1",39,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",40,0)
RUN ; Run the report either queued or in person.
"RTN","LRHBR1",41,0)
 ;
"RTN","LRHBR1",42,0)
 K ^TMP("LR",$J),^TMP("LRX",$J),^TMP("TAT",$J)
"RTN","LRHBR1",43,0)
 S:$D(ZTQUEUED) ZTREQ="@" U IO
"RTN","LRHBR1",44,0)
 S (LRPAG,LREND)=0
"RTN","LRHBR1",45,0)
 D:'LREND START
"RTN","LRHBR1",46,0)
 D:$D(ZTQUEUED) STOP
"RTN","LRHBR1",47,0)
 ;
"RTN","LRHBR1",48,0)
 Q
"RTN","LRHBR1",49,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",50,0)
STOP ; End and cleanup.
"RTN","LRHBR1",51,0)
 ;
"RTN","LRHBR1",52,0)
 I ($E(IOST,1,2)="C-") D WAIT
"RTN","LRHBR1",53,0)
 I '$D(ZTQUEUED) D ^%ZISC
"RTN","LRHBR1",54,0)
 K ^TMP("LR",$J),^TMP("LRX",$J),^TMP("TAT",$J)
"RTN","LRHBR1",55,0)
 K %DT,B,DATA1,DD,DM,DSTR,DTOUT,DUOUT,DY,LRDET,LREDT,LREND,LRLOC
"RTN","LRHBR1",56,0)
 K LRPAG,LRSDT,LRT,OR,PLOC,POP,S,X,Y,ZTDESC,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE
"RTN","LRHBR1",57,0)
 ;
"RTN","LRHBR1",58,0)
 Q
"RTN","LRHBR1",59,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",60,0)
GDT ; Get dates (start and end).
"RTN","LRHBR1",61,0)
 ;
"RTN","LRHBR1",62,0)
 I LRSDT?1.7N S Y=LRSDT D DD^LRX S LRSDT=Y
"RTN","LRHBR1",63,0)
 I LREDT?1.7N S Y=LREDT D DD^LRX S LREDT=Y
"RTN","LRHBR1",64,0)
 S %DT("A")="Enter START date: ",%DT("B")=LRSDT,%DT="AET"
"RTN","LRHBR1",65,0)
 D ^%DT S LREND=Y<1 Q:LREND
"RTN","LRHBR1",66,0)
 S LRSDT=Y
"RTN","LRHBR1",67,0)
 S %DT("A")="Enter END date: ",%DT("B")=LREDT
"RTN","LRHBR1",68,0)
 D ^%DT S LREND=Y<1 Q:LREND
"RTN","LRHBR1",69,0)
 S LREDT=Y
"RTN","LRHBR1",70,0)
 S:LREDT>LRSDT X=LREDT,LREDT=LRSDT,LRSDT=X
"RTN","LRHBR1",71,0)
 ;
"RTN","LRHBR1",72,0)
 Q
"RTN","LRHBR1",73,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",74,0)
GDV ; Get output device.
"RTN","LRHBR1",75,0)
 ;
"RTN","LRHBR1",76,0)
 S %ZIS="Q" D ^%ZIS K %ZIS I POP S LREND=1 Q
"RTN","LRHBR1",77,0)
 I $D(IO("Q")) D
"RTN","LRHBR1",78,0)
 .K IO("Q")
"RTN","LRHBR1",79,0)
 .S LREND=1,ZTRTN="RUN^LRHBR1",ZTDESC="Lab Special Report"
"RTN","LRHBR1",80,0)
 .S ZTSAVE("LR*")=""
"RTN","LRHBR1",81,0)
 .D ^%ZTLOAD
"RTN","LRHBR1",82,0)
 ;
"RTN","LRHBR1",83,0)
 Q
"RTN","LRHBR1",84,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",85,0)
LOC ; Get the locations to run report for.  Default "ALL".
"RTN","LRHBR1",86,0)
 ;
"RTN","LRHBR1",87,0)
 N I,J,LOC
"RTN","LRHBR1",88,0)
 ;
"RTN","LRHBR1",89,0)
 I '$D(^DIC(4,"E")) D  Q
"RTN","LRHBR1",90,0)
 .S LRLOC=B_$$NAME^XUAF4($$KSP^XUPARAM("INST"))_B
"RTN","LRHBR1",91,0)
 .S LRLOC=B_^ZTMP("LRHBR1_LOCATION")_B   ;[temp until configuration complete then remove]
"RTN","LRHBR1",92,0)
 ;
"RTN","LRHBR1",93,0)
 K DIR
"RTN","LRHBR1",94,0)
 S DIR("B")="ALL",DIR("A")="Location",DIR(0)="S^1:ALL;",I=""
"RTN","LRHBR1",95,0)
 S LOC(1)="ALL",DIR("?")="Select Location"
"RTN","LRHBR1",96,0)
 ;
"RTN","LRHBR1",97,0)
 F J=2:1 S I=$O(^DIC(4,"E",I)) Q:I=""  D
"RTN","LRHBR1",98,0)
 .S LOC=$$GET1^DIQ(4,I,.01),LOC(J)=LOC
"RTN","LRHBR1",99,0)
 .S DIR(0)=DIR(0)_J_":"_$$GET1^DIQ(4,I,.01)_";",LOC(J)=LOC
"RTN","LRHBR1",100,0)
 ;
"RTN","LRHBR1",101,0)
 D ^DIR
"RTN","LRHBR1",102,0)
 S:($D(DUOUT))!($D(DTOUT)) LREND=1
"RTN","LRHBR1",103,0)
 I 'LREND D
"RTN","LRHBR1",104,0)
 .I LOC(Y)'="ALL" D  Q
"RTN","LRHBR1",105,0)
 ..S LRLOC=B_LOC(Y)_B
"RTN","LRHBR1",106,0)
 .S I="",LRLOC=B
"RTN","LRHBR1",107,0)
 .F  S I=$O(^DIC(4,"E",I)) Q:I=""  S LRLOC=LRLOC_$$GET1^DIQ(4,I,.01)_B
"RTN","LRHBR1",108,0)
 ;
"RTN","LRHBR1",109,0)
 Q
"RTN","LRHBR1",110,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",111,0)
DETAIL ; Include detail?  (1=yes, 0=no).  Default "NO".
"RTN","LRHBR1",112,0)
 ;
"RTN","LRHBR1",113,0)
 K DIR
"RTN","LRHBR1",114,0)
 S DIR("B")="NO",DIR("A")="Include a Detailed Report?",DIR(0)="S^1:NO;2:YES"
"RTN","LRHBR1",115,0)
 ;
"RTN","LRHBR1",116,0)
 D ^DIR
"RTN","LRHBR1",117,0)
 S:($D(DUOUT))!($D(DTOUT)) LREND=1 S:'LREND LRDET=Y-1 Q
"RTN","LRHBR1",118,0)
 ;
"RTN","LRHBR1",119,0)
 Q
"RTN","LRHBR1",120,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",121,0)
START ; Produce report looping through OR(100 data.
"RTN","LRHBR1",122,0)
 ;
"RTN","LRHBR1",123,0)
 ;   Input: LRSDT - Start date
"RTN","LRHBR1",124,0)
 ;          LREDT - End date
"RTN","LRHBR1",125,0)
 ;          LRLOC - Location(s) [|loc1|loc2|...]
"RTN","LRHBR1",126,0)
 ;          LRDET - Detail      [0=No, 1=Yes]
"RTN","LRHBR1",127,0)
 ;
"RTN","LRHBR1",128,0)
 ;  Output: Report.
"RTN","LRHBR1",129,0)
 ;
"RTN","LRHBR1",130,0)
 N ABREV,CDATE,COLDT,CPT,D0,DATA,IPROC,ITYPE,LOC,LRDT,LRDT1,ODATE,OR,OR1
"RTN","LRHBR1",131,0)
 N PNAME,PROV,RDATE,RPTDT,STATUS,TAT,TEST,TMP,TNAME
"RTN","LRHBR1",132,0)
 ;
"RTN","LRHBR1",133,0)
 S LRDT=(LREDT-1)+.999999,LRDT1=LRSDT+.999999
"RTN","LRHBR1",134,0)
 ;
"RTN","LRHBR1",135,0)
 F  S LRDT=$O(^OR(100,"AF",LRDT)) Q:LRDT=""!(LRDT>LRDT1)  D
"RTN","LRHBR1",136,0)
 .S OR="" F  S OR=$O(^OR(100,"AF",LRDT,OR)) Q:OR=""  D
"RTN","LRHBR1",137,0)
 ..I +$P($G(^OR(100,OR,0)),U,5)'=+LRT Q           ;not a lab/rad test
"RTN","LRHBR1",138,0)
 ..I '$D(^OR(100,OR,4.5)) Q
"RTN","LRHBR1",139,0)
 ..S OR1="" F  S OR1=$O(^OR(100,OR,4.5,OR1)) Q:OR1=""  D
"RTN","LRHBR1",140,0)
 ...S DATA=$G(^OR(100,OR,4.5,OR1,0))
"RTN","LRHBR1",141,0)
 ...I $P(DATA,U,4)'="Location" Q
"RTN","LRHBR1",142,0)
 ...S LOC=$G(^OR(100,OR,4.5,OR1,1)) Q:LOC=""
"RTN","LRHBR1",143,0)
 ...I LRLOC'[(B_LOC_B) Q
"RTN","LRHBR1",144,0)
 ...I $D(^TMP("LR",$J,LOC,OR)) Q
"RTN","LRHBR1",145,0)
 ...S TEST=$G(^OR(100,OR,4.5,1,1))                ;test
"RTN","LRHBR1",146,0)
 ...S ODATE=$$DATE($$FMTE^XLFDT(LRDT))            ;order date/time
"RTN","LRHBR1",147,0)
 ...S PROV=$$GET1^DIQ(100,OR,1)                   ;provider
"RTN","LRHBR1",148,0)
 ...S PNAME=$$GET1^DIQ(100,OR,.02)                ;patient name
"RTN","LRHBR1",149,0)
 ...S TNAME=$$GET1^DIQ(101.43,TEST,.01)           ;test/procedure name
"RTN","LRHBR1",150,0)
 ...S D0=+$$GET1^DIQ(101.43,TEST,2,"I")           ;D0 rad/nuc #71 file
"RTN","LRHBR1",151,0)
 ...S (ABREV,CPT,ITYPE,IPROC,TMP)=""
"RTN","LRHBR1",152,0)
 ...I D0]"" D
"RTN","LRHBR1",153,0)
 ....S CPT=$$GET1^DIQ(71,D0,9)                    ;CPT code
"RTN","LRHBR1",154,0)
 ....S ITYPE=$$GET1^DIQ(71,D0,12)                 ;Imaging type
"RTN","LRHBR1",155,0)
 ....I ITYPE]"" S TMP=$O(^RA(79.2,"B",ITYPE,""))
"RTN","LRHBR1",156,0)
 ....I TMP]"" S ABREV=$$GET1^DIQ(79.2,TMP,3)      ;Imaging type abbrev
"RTN","LRHBR1",157,0)
 ....S IPROC=$$GET1^DIQ(71,D0,.01)                ;Imaging procedure
"RTN","LRHBR1",158,0)
 ...S STATUS=$$GET1^DIQ(100,OR,5)                 ;status
"RTN","LRHBR1",159,0)
 ...I LRT="2A",$E(STATUS,1)'="C" Q                ;only complete for TAT
"RTN","LRHBR1",160,0)
 ...I STATUS="UNRELEASED" Q                       ;no unreleased
"RTN","LRHBR1",161,0)
 ...S CDATE=$P($$GET1^DIQ(100,OR,33),S,2,3)       ;collect date/time
"RTN","LRHBR1",162,0)
 ...S COLDT=CDATE
"RTN","LRHBR1",163,0)
 ...I CDATE]"",$P(CDATE,S)]"",$P(CDATE,S,2)]"" D
"RTN","LRHBR1",164,0)
 ....S CDATE=$P($G(^LRO(69,$P(CDATE,S),1,$P(CDATE,S,2),1)),U)
"RTN","LRHBR1",165,0)
 ....S COLDT=CDATE
"RTN","LRHBR1",166,0)
 ....S CDATE=$$DATE($$FMTE^XLFDT(CDATE))
"RTN","LRHBR1",167,0)
 ...S RPTDT=$$GET1^DIQ(100,OR,22,"I")             ;report date/time internal
"RTN","LRHBR1",168,0)
 ...I LRT="2A",COLDT="" Q                         ;tat must have collect
"RTN","LRHBR1",169,0)
 ...S TAT="" I LRT="2A" D                         ;turnaround time (minutes)
"RTN","LRHBR1",170,0)
 ....S TAT=$TR($J($$FMDIFF^XLFDT(RPTDT,COLDT,2)/60,50,0)," ","")
"RTN","LRHBR1",171,0)
 ...S RDATE=$$DATE($$GET1^DIQ(100,OR,22,"E"))     ;report date/time
"RTN","LRHBR1",172,0)
 ...I LRT="2A",RDATE="" Q                         ;must have rpt date for tat
"RTN","LRHBR1",173,0)
 ...I LRT=1 D
"RTN","LRHBR1",174,0)
 ....S TMP=ODATE_B_PROV_B_PNAME_B_CPT             ;rad order detail
"RTN","LRHBR1",175,0)
 ....S TMP=TMP_B_ITYPE_B_IPROC_B_$E(STATUS,1)
"RTN","LRHBR1",176,0)
 ...I +LRT=2 D
"RTN","LRHBR1",177,0)
 ....S TMP=ODATE_B_PROV_B_PNAME_B_TNAME           ;lab order detail
"RTN","LRHBR1",178,0)
 ....S TMP=TMP_B_$E(STATUS,1)_B_CDATE_B_RDATE
"RTN","LRHBR1",179,0)
 ....S TMP=TMP_B_TAT
"RTN","LRHBR1",180,0)
 ...I LRT=1,ITYPE]"",ABREV]"" D
"RTN","LRHBR1",181,0)
 ....S ^TMP("LRX",$J,ITYPE)=ABREV                 ;Image type abrev
"RTN","LRHBR1",182,0)
 ...S ^TMP("LR",$J)=$G(^TMP("LR",$J))+1           ;grand total
"RTN","LRHBR1",183,0)
 ...S ^TMP("LR",$J,LOC)=$G(^TMP("LR",$J,LOC))+1   ;location total
"RTN","LRHBR1",184,0)
 ...S ^TMP("LR",$J,LOC,OR)=TMP                    ;order detail
"RTN","LRHBR1",185,0)
 ...S ^TMP("TAT",$J,LOC)=$G(^TMP("TAT",$J,LOC))+TAT   ;tat location total
"RTN","LRHBR1",186,0)
 ...S ^TMP("TAT",$J)=$G(^TMP("TAT",$J))+TAT       ;tat grand total
"RTN","LRHBR1",187,0)
 ;
"RTN","LRHBR1",188,0)
 D HDR
"RTN","LRHBR1",189,0)
 I 'LRDET Q
"RTN","LRHBR1",190,0)
 ;
"RTN","LRHBR1",191,0)
 S (LOC,OR,PLOC)=""
"RTN","LRHBR1",192,0)
 F  S LOC=$O(^TMP("LR",$J,LOC)) Q:LOC=""  D  Q:LREND
"RTN","LRHBR1",193,0)
 .I LOC'=PLOC S PLOC=LOC D SHDR
"RTN","LRHBR1",194,0)
 .F  S OR=$O(^TMP("LR",$J,LOC,OR)) Q:OR=""  D  Q:LREND
"RTN","LRHBR1",195,0)
 ..S DATA=^TMP("LR",$J,LOC,OR)
"RTN","LRHBR1",196,0)
 ..I $Y+2>IOSL D WAIT Q:LREND  D:$E(IOST,1,2)'="C-" HDR D SHDR
"RTN","LRHBR1",197,0)
 ..I LRT=1 D
"RTN","LRHBR1",198,0)
 ...S TMP=$P(DATA,B,5)
"RTN","LRHBR1",199,0)
 ...I TMP]"",$G(^TMP("LRX",$J,TMP))]"" S TMP=^TMP("LRX",$J,TMP)
"RTN","LRHBR1",200,0)
 ...W !,$P($P(DATA,B),"@")
"RTN","LRHBR1",201,0)
 ...W ?10,$E($P(DATA,B,2),1,14),?26,$E($P(DATA,B,3),1,14)
"RTN","LRHBR1",202,0)
 ...W ?42,$E($P(DATA,B,4),1,14),?49,$E(TMP,1,11)
"RTN","LRHBR1",203,0)
 ...W ?55,$E($P(DATA,B,6),1,21),?77,$P(DATA,B,7)
"RTN","LRHBR1",204,0)
 ...W ! I $P(DATA,B)]"" W " @",$P($P(DATA,B),"@",2)
"RTN","LRHBR1",205,0)
 ...W ?10,$E($P(DATA,B,2),15,28),?26,$E($P(DATA,B,3),15,28)
"RTN","LRHBR1",206,0)
 ...W ?42,$E($P(DATA,B,4),15,28),?49,$E(TMP,12,22)
"RTN","LRHBR1",207,0)
 ...W ?55,$E($P(DATA,B,6),22,42)
"RTN","LRHBR1",208,0)
 ..I LRT=2 D
"RTN","LRHBR1",209,0)
 ...W !,$P($P(DATA,B),"@"),?10,$E($P(DATA,B,2),1,14)
"RTN","LRHBR1",210,0)
 ...W ?26,$E($P(DATA,B,3),1,14),?42,$E($P(DATA,B,4),1,14)
"RTN","LRHBR1",211,0)
 ...W ?58,$P(DATA,B,5),?62,$P($P(DATA,B,6),"@")
"RTN","LRHBR1",212,0)
 ...W ?72 I $P(DATA,B,5)'="D" W $P($P(DATA,B,7),"@")
"RTN","LRHBR1",213,0)
 ...W ! I $P(DATA,B)]"" W " @",$P($P(DATA,B),"@",2)
"RTN","LRHBR1",214,0)
 ...W ?10,$E($P(DATA,B,2),15,28),?26,$E($P(DATA,B,3),15,28)
"RTN","LRHBR1",215,0)
 ...W ?42,$E($P(DATA,B,4),15,28)
"RTN","LRHBR1",216,0)
 ...W ?62 I $P(DATA,B,6)]"" W " @",$P($P(DATA,B,6),"@",2)
"RTN","LRHBR1",217,0)
 ...W ?72 I $P(DATA,B,5)'="D",$P(DATA,B,7)]"" D
"RTN","LRHBR1",218,0)
 ....W " @",$P($P(DATA,B,7),"@",2)
"RTN","LRHBR1",219,0)
 ..I LRT="2A" D
"RTN","LRHBR1",220,0)
 ...W !,$P($P(DATA,B),"@"),?9,$E($P(DATA,B,2),1,14)
"RTN","LRHBR1",221,0)
 ...W ?24,$E($P(DATA,B,3),1,14),?39,$E($P(DATA,B,4),1,14)
"RTN","LRHBR1",222,0)
 ...W ?54,$P(DATA,B,5),?57,$P($P(DATA,B,6),"@")
"RTN","LRHBR1",223,0)
 ...W ?66 I $P(DATA,B,5)'="D" W $P($P(DATA,B,7),"@")
"RTN","LRHBR1",224,0)
 ...W ?75,$P(DATA,B,8)
"RTN","LRHBR1",225,0)
 ...W ! I $P(DATA,B)]"" W " @",$P($P(DATA,B),"@",2)
"RTN","LRHBR1",226,0)
 ...W ?9,$E($P(DATA,B,2),15,28),?24,$E($P(DATA,B,3),15,28)
"RTN","LRHBR1",227,0)
 ...W ?39,$E($P(DATA,B,4),15,28)
"RTN","LRHBR1",228,0)
 ...W ?57 I $P(DATA,B,6)]"" W " @",$P($P(DATA,B,6),"@",2)
"RTN","LRHBR1",229,0)
 ...W ?66 I $P(DATA,B,5)'="D",$P(DATA,B,7)]"" D
"RTN","LRHBR1",230,0)
 ....W " @",$P($P(DATA,B,7),"@",2)
"RTN","LRHBR1",231,0)
 ;
"RTN","LRHBR1",232,0)
 Q
"RTN","LRHBR1",233,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",234,0)
HDR ; Print header and totals by location.
"RTN","LRHBR1",235,0)
 ;
"RTN","LRHBR1",236,0)
 N L,TC,TM,TTC,TTM
"RTN","LRHBR1",237,0)
 ;
"RTN","LRHBR1",238,0)
 S LRPAG=LRPAG+1
"RTN","LRHBR1",239,0)
 ;
"RTN","LRHBR1",240,0)
 I LRT'="2A" D
"RTN","LRHBR1",241,0)
 .W ?$S(LRT=1:22,1:24),"Remote ",$S(LRT=1:"Radiology",1:"Lab")
"RTN","LRHBR1",242,0)
 .W " Orders by Location"
"RTN","LRHBR1",243,0)
 I LRT="2A" W ?21,"Turnaround Time for Remote Lab Orders"
"RTN","LRHBR1",244,0)
 W ?73,"Page ",LRPAG
"RTN","LRHBR1",245,0)
 W !?23,"From ",$$FMTE^XLFDT(LREDT)," to ",$$FMTE^XLFDT(LRSDT)
"RTN","LRHBR1",246,0)
 W !?22,"Date Printed: ",$$FMTE^XLFDT($$NOW^XLFDT),!
"RTN","LRHBR1",247,0)
 ;
"RTN","LRHBR1",248,0)
 I LRT="2A" D  Q
"RTN","LRHBR1",249,0)
 .W !?5,"Location",?25,"# of Tests",?40,"Total Time",?60,"Average Time"
"RTN","LRHBR1",250,0)
 .W !?5,$TR($J("",68)," ","-")
"RTN","LRHBR1",251,0)
 .S L="",(TTC,TTM)=0
"RTN","LRHBR1",252,0)
 .F  S L=$O(^TMP("LR",$J,L)) Q:L=""  D  Q:LREND
"RTN","LRHBR1",253,0)
 ..S TC=^TMP("LR",$J,L),TM=^TMP("TAT",$J,L)
"RTN","LRHBR1",254,0)
 ..S TTC=TTC+TC,TTM=TTM+TM
"RTN","LRHBR1",255,0)
 ..W !?5,$J(L,15),$TR($J(TC,10)," ","."),?40,TM,?60,$J(TM/TC,10,2)
"RTN","LRHBR1",256,0)
 .W !?5,$TR($J("",68)," ","-")
"RTN","LRHBR1",257,0)
 .W !?5,$J("Totals",15),$TR($J(TTC,10)," ","."),?40,TTM,?60
"RTN","LRHBR1",258,0)
 .W $S(TTC=0:0,1:$J(TTM/TTC,10,2)),!
"RTN","LRHBR1",259,0)
 ;
"RTN","LRHBR1",260,0)
 S L=""
"RTN","LRHBR1",261,0)
 F  S L=$O(^TMP("LR",$J,L)) Q:L=""  D  Q:LREND
"RTN","LRHBR1",262,0)
 .W !?5,$J(L,15),$TR($J(^TMP("LR",$J,L),10)," ",".")
"RTN","LRHBR1",263,0)
 W !?5,$TR($J("",26)," ","-")
"RTN","LRHBR1",264,0)
 W !?5,$J("Total",15),$TR($J(+$G(^TMP("LR",$J)),10)," ","."),!
"RTN","LRHBR1",265,0)
 ;
"RTN","LRHBR1",266,0)
 Q
"RTN","LRHBR1",267,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",268,0)
SHDR ; Print sub header.
"RTN","LRHBR1",269,0)
 ;
"RTN","LRHBR1",270,0)
 I $Y+6>IOSL D WAIT Q:LREND  D:$E(IOST,1,2)'="C-" HDR W !
"RTN","LRHBR1",271,0)
 ;
"RTN","LRHBR1",272,0)
 W !!,"==> Performing Location: ",LOC,!
"RTN","LRHBR1",273,0)
 I LRT=1 D                                       ;rad sub header
"RTN","LRHBR1",274,0)
 .W !,"Order",?10,"Provider",?26,"Patient"
"RTN","LRHBR1",275,0)
 .W ?42,"CPT",?49,"Type",?55,"Image Procedure",?77,"St"
"RTN","LRHBR1",276,0)
 .W !,$TR($J("",8)," ","-"),?10,$TR($J("",14)," ","-")
"RTN","LRHBR1",277,0)
 .W ?26,$TR($J("",14)," ","-"),?42,$TR($J("",5)," ","-")
"RTN","LRHBR1",278,0)
 .W ?49,$TR($J("",4)," ","-"),?55,$TR($J("",20)," ","-")
"RTN","LRHBR1",279,0)
 .W ?77,$TR($J("",3)," ","-")
"RTN","LRHBR1",280,0)
 ;
"RTN","LRHBR1",281,0)
 I LRT=2 D                                       ;lab sub header
"RTN","LRHBR1",282,0)
 .W !,"Order",?10,"Provider",?26,"Patient",?42
"RTN","LRHBR1",283,0)
 .W "Test",?58,"St",?62,"Collect",?72,"Report"
"RTN","LRHBR1",284,0)
 .W !,$TR($J("",8)," ","-"),?10,$TR($J("",14)," ","-")
"RTN","LRHBR1",285,0)
 .W ?26,$TR($J("",14)," ","-"),?42,$TR($J("",14)," ","-")
"RTN","LRHBR1",286,0)
 .W ?58,$TR($J("",3)," ","-"),?62,$TR($J("",8)," ","-")
"RTN","LRHBR1",287,0)
 .W ?72,$TR($J("",8)," ","-")
"RTN","LRHBR1",288,0)
 ;
"RTN","LRHBR1",289,0)
 I LRT="2A" D                                       ;lab sub header
"RTN","LRHBR1",290,0)
 .W !,"Order",?9,"Provider",?24,"Patient",?39
"RTN","LRHBR1",291,0)
 .W "Test",?54,"St",?57,"Collect",?66,"Report",?75,"TAT"
"RTN","LRHBR1",292,0)
 .W !,$TR($J("",8)," ","-"),?9,$TR($J("",14)," ","-")
"RTN","LRHBR1",293,0)
 .W ?24,$TR($J("",14)," ","-"),?39,$TR($J("",14)," ","-")
"RTN","LRHBR1",294,0)
 .W ?54,$TR($J("",3)," ","-"),?57,$TR($J("",8)," ","-")
"RTN","LRHBR1",295,0)
 .W ?66,$TR($J("",8)," ","-"),?75,$TR($J("",5)," ","-")
"RTN","LRHBR1",296,0)
 ;
"RTN","LRHBR1",297,0)
 Q
"RTN","LRHBR1",298,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",299,0)
DATE(DATE) ; Convert mmm dd, yyyy@hh:mm to mm/dd/yyyy@hh:mm
"RTN","LRHBR1",300,0)
 ;
"RTN","LRHBR1",301,0)
 N DD,DM,DSTR,DY,LOWER,TM,UPPER
"RTN","LRHBR1",302,0)
 ;
"RTN","LRHBR1",303,0)
 I $G(DATE)="" Q ""
"RTN","LRHBR1",304,0)
 ;
"RTN","LRHBR1",305,0)
 S LOWER="abcdefghijklmnopqrstuvwxyz"
"RTN","LRHBR1",306,0)
 S UPPER="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
"RTN","LRHBR1",307,0)
 S DSTR("JAN")="01",DSTR("FEB")="02",DSTR("MAR")="03",DSTR("APR")="04"
"RTN","LRHBR1",308,0)
 S DSTR("MAY")="05",DSTR("JUN")="06",DSTR("JUL")="07",DSTR("AUG")="08"
"RTN","LRHBR1",309,0)
 S DSTR("SEP")="09",DSTR("OCT")=10,DSTR("NOV")=11,DSTR("DEC")=12
"RTN","LRHBR1",310,0)
 ;
"RTN","LRHBR1",311,0)
 S DM=$TR($P(DATE," "),LOWER,UPPER),DD=$P($P(DATE," ",2),",")
"RTN","LRHBR1",312,0)
 S DY=$E($P($P(DATE," ",3),"@"),3,4),TM=$P($P(DATE,"@",2),":",1,2)
"RTN","LRHBR1",313,0)
 ;
"RTN","LRHBR1",314,0)
 Q DSTR(DM)_"/"_DD_"/"_DY_"@"_TM
"RTN","LRHBR1",315,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR1",316,0)
WAIT ; Pause for page breaks.
"RTN","LRHBR1",317,0)
 ;
"RTN","LRHBR1",318,0)
 K DIR
"RTN","LRHBR1",319,0)
 S DIR(0)="E"
"RTN","LRHBR1",320,0)
 D ^DIR
"RTN","LRHBR1",321,0)
 S:($D(DUOUT))!($D(DTOUT)) LREND=1
"RTN","LRHBR1",322,0)
 S $Y=1
"RTN","LRHBR1",323,0)
 ;
"RTN","LRHBR1",324,0)
 Q
"RTN","LRHBR2")
0^11^B169207416
"RTN","LRHBR2",1,0)
LRHBR2 ;LEIDOS/TCK - REMOTE ORDERING - REMOTE LAB/RAD ORDERS BY TEST/IMAGE ; 8/30/16 3:06pm
"RTN","LRHBR2",2,0)
 ;;1.0;REMOTE ORDERS;;OCT 1,2016;Build 19
"RTN","LRHBR2",3,0)
 ;
"RTN","LRHBR2",4,0)
 Q
"RTN","LRHBR2",5,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",6,0)
LAB ; Entry point for Remote Laboratory Orders by Test Name.
"RTN","LRHBR2",7,0)
 ;
"RTN","LRHBR2",8,0)
 S LRT=2,XREF="AF"
"RTN","LRHBR2",9,0)
 ;
"RTN","LRHBR2",10,0)
 D INIT,GDT:'LREND,TEST:'LREND,LOC:'LREND,DETAIL:'LREND
"RTN","LRHBR2",11,0)
 D GDV:'LREND,RUN:'LREND,STOP
"RTN","LRHBR2",12,0)
 ;
"RTN","LRHBR2",13,0)
 Q
"RTN","LRHBR2",14,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",15,0)
RAD ; Entry point for Remote Radiology Orders by Image Type.
"RTN","LRHBR2",16,0)
 ;
"RTN","LRHBR2",17,0)
 S LRT=1,XREF="AF"
"RTN","LRHBR2",18,0)
 ;
"RTN","LRHBR2",19,0)
 D INIT,GDT:'LREND,IMAGE:'LREND,LOC:'LREND,DETAIL:'LREND
"RTN","LRHBR2",20,0)
 D GDV:'LREND,RUN:'LREND,STOP
"RTN","LRHBR2",21,0)
 ;
"RTN","LRHBR2",22,0)
 Q
"RTN","LRHBR2",23,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",24,0)
RADC ; Entry point for Remote Radiology Orders by CPT Code.
"RTN","LRHBR2",25,0)
 ;
"RTN","LRHBR2",26,0)
 S LRT="1A",XREF="AF"
"RTN","LRHBR2",27,0)
 ;
"RTN","LRHBR2",28,0)
 D INIT,GDT:'LREND,CPT:'LREND,LOC:'LREND,DETAIL:'LREND
"RTN","LRHBR2",29,0)
 D GDV:'LREND,RUN:'LREND,STOP
"RTN","LRHBR2",30,0)
 ;
"RTN","LRHBR2",31,0)
 Q
"RTN","LRHBR2",32,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",33,0)
RADCR ; Entry point for Remote Radiology Orders by CPT Code and RVU.
"RTN","LRHBR2",34,0)
 ;
"RTN","LRHBR2",35,0)
 S LRT="1B",XREF="AF",LRTEST="*"
"RTN","LRHBR2",36,0)
 ;
"RTN","LRHBR2",37,0)
 D INIT,GDT:'LREND,LOC:'LREND,DETAIL:'LREND,GDV:'LREND,RUN:'LREND,STOP
"RTN","LRHBR2",38,0)
 ;
"RTN","LRHBR2",39,0)
 Q
"RTN","LRHBR2",40,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",41,0)
INIT ; Initialize common variables.
"RTN","LRHBR2",42,0)
 ;
"RTN","LRHBR2",43,0)
 S U="^",B="|",S=";"
"RTN","LRHBR2",44,0)
 S LREND=0,LRSDT="TODAY",LREDT="T-7"
"RTN","LRHBR2",45,0)
 W !,"REMOTE ORDERS - Remote ",$S(LRT=1:"Radiology",1:"Lab")
"RTN","LRHBR2",46,0)
 W " Orders by "_$S(LRT=2:"Test Name",LRT=1:"Imaging Type",1:"CPT Code")
"RTN","LRHBR2",47,0)
 I LRT="1B" W " and wRVU"
"RTN","LRHBR2",48,0)
 ;
"RTN","LRHBR2",49,0)
 Q
"RTN","LRHBR2",50,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",51,0)
RUN ; Run the report either queued or in person.
"RTN","LRHBR2",52,0)
 ;
"RTN","LRHBR2",53,0)
 K ^TMP("LR",$J)
"RTN","LRHBR2",54,0)
 S:$D(ZTQUEUED) ZTREQ="@" U IO
"RTN","LRHBR2",55,0)
 S (LRPAG,LREND)=0
"RTN","LRHBR2",56,0)
 D:'LREND START
"RTN","LRHBR2",57,0)
 D:$D(ZTQUEUED) STOP
"RTN","LRHBR2",58,0)
 ;
"RTN","LRHBR2",59,0)
 Q
"RTN","LRHBR2",60,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",61,0)
STOP ; End and cleanup.
"RTN","LRHBR2",62,0)
 ;
"RTN","LRHBR2",63,0)
 I ($E(IOST,1,2)="C-") D WAIT
"RTN","LRHBR2",64,0)
 I '$D(ZTQUEUED) D ^%ZISC
"RTN","LRHBR2",65,0)
 K ^TMP("LR",$J),^TMP("LRTEST",$J),^TMP("LRX",$J),^TMP("LRCPT",$J)
"RTN","LRHBR2",66,0)
 K %DT,B,DATA1,DD,DM,DSTR,DTOUT,DUOUT,DY
"RTN","LRHBR2",67,0)
 K LRDET,LREDT,LREND,LRLOC,LRPAG,LRSDT,LRTEST
"RTN","LRHBR2",68,0)
 K OR,PLOC,POP,S,X,XREF,Y,ZTDESC,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE
"RTN","LRHBR2",69,0)
 ;
"RTN","LRHBR2",70,0)
 Q
"RTN","LRHBR2",71,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",72,0)
GDT ; Get dates (start and end).
"RTN","LRHBR2",73,0)
 ;
"RTN","LRHBR2",74,0)
 I LRSDT?1.7N S Y=LRSDT D DD^LRX S LRSDT=Y
"RTN","LRHBR2",75,0)
 I LREDT?1.7N S Y=LREDT D DD^LRX S LREDT=Y
"RTN","LRHBR2",76,0)
 S %DT("A")="Enter START date: ",%DT("B")=LRSDT,%DT="AET"
"RTN","LRHBR2",77,0)
 D ^%DT S LREND=Y<1 Q:LREND
"RTN","LRHBR2",78,0)
 S LRSDT=Y
"RTN","LRHBR2",79,0)
 S %DT("A")="Enter END date: ",%DT("B")=LREDT
"RTN","LRHBR2",80,0)
 D ^%DT S LREND=Y<1 Q:LREND
"RTN","LRHBR2",81,0)
 S LREDT=Y
"RTN","LRHBR2",82,0)
 S:LREDT>LRSDT X=LREDT,LREDT=LRSDT,LRSDT=X
"RTN","LRHBR2",83,0)
 ;
"RTN","LRHBR2",84,0)
 Q
"RTN","LRHBR2",85,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",86,0)
GDV ; Get output device.
"RTN","LRHBR2",87,0)
 ;
"RTN","LRHBR2",88,0)
 S %ZIS="Q" D ^%ZIS K %ZIS I POP S LREND=1 Q
"RTN","LRHBR2",89,0)
 I $D(IO("Q")) D
"RTN","LRHBR2",90,0)
 .K IO("Q")
"RTN","LRHBR2",91,0)
 .S LREND=1,ZTRTN="RUN^LRHBR2",ZTDESC="Lab Special Report"
"RTN","LRHBR2",92,0)
 .S ZTSAVE("LR*")=""
"RTN","LRHBR2",93,0)
 .D ^%ZTLOAD
"RTN","LRHBR2",94,0)
 ;
"RTN","LRHBR2",95,0)
 Q
"RTN","LRHBR2",96,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",97,0)
LOC ; Get the locations to run report for.  Default "ALL".
"RTN","LRHBR2",98,0)
 ;
"RTN","LRHBR2",99,0)
 N I,J,LOC
"RTN","LRHBR2",100,0)
 ;
"RTN","LRHBR2",101,0)
 I '$D(^DIC(4,"E")) D  Q
"RTN","LRHBR2",102,0)
 .S LRLOC=B_$$NAME^XUAF4($$KSP^XUPARAM("INST"))_B
"RTN","LRHBR2",103,0)
 .S LRLOC=B_^ZTMP("LRHBR1_LOCATION")_B   ;[temp until configuration complete then remove]
"RTN","LRHBR2",104,0)
 ;
"RTN","LRHBR2",105,0)
 K DIR
"RTN","LRHBR2",106,0)
 S DIR("B")="ALL",DIR("A")="Location",DIR(0)="S^1:ALL;",I=""
"RTN","LRHBR2",107,0)
 S LOC(1)="ALL",DIR("?")="Select Location"
"RTN","LRHBR2",108,0)
 ;
"RTN","LRHBR2",109,0)
 F J=2:1 S I=$O(^DIC(4,"E",I)) Q:I=""  D
"RTN","LRHBR2",110,0)
 .S LOC=$$GET1^DIQ(4,I,.01),LOC(J)=LOC
"RTN","LRHBR2",111,0)
 .S DIR(0)=DIR(0)_J_":"_$$GET1^DIQ(4,I,.01)_";",LOC(J)=LOC
"RTN","LRHBR2",112,0)
 ;
"RTN","LRHBR2",113,0)
 D ^DIR
"RTN","LRHBR2",114,0)
 S:($D(DUOUT))!($D(DTOUT)) LREND=1
"RTN","LRHBR2",115,0)
 I 'LREND D
"RTN","LRHBR2",116,0)
 .I LOC(Y)'="ALL" D  Q
"RTN","LRHBR2",117,0)
 ..S LRLOC=B_LOC(Y)_B
"RTN","LRHBR2",118,0)
 .S I="",LRLOC=B
"RTN","LRHBR2",119,0)
 .F  S I=$O(^DIC(4,"E",I)) Q:I=""  S LRLOC=LRLOC_$$GET1^DIQ(4,I,.01)_B
"RTN","LRHBR2",120,0)
 ;
"RTN","LRHBR2",121,0)
 Q
"RTN","LRHBR2",122,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",123,0)
TEST ; Prompt for lab test(s) to be included (<Return> for all).
"RTN","LRHBR2",124,0)
 ;
"RTN","LRHBR2",125,0)
 N STOP
"RTN","LRHBR2",126,0)
 ;
"RTN","LRHBR2",127,0)
 K DIC,^TMP("LRTEST",$J)
"RTN","LRHBR2",128,0)
 W !!,"Press <Enter> at LABORATORY TEST NAME Prompt to select All Tests",!
"RTN","LRHBR2",129,0)
 S DIC="^LAB(60,",DIC(0)="AEMOQ",STOP=0
"RTN","LRHBR2",130,0)
 S DIC("S")="I $P(^(0),U,4)[""CH"",""BO""[$P(^(0),U,3)"
"RTN","LRHBR2",131,0)
 ;
"RTN","LRHBR2",132,0)
 F  D  Q:STOP!(LREND)
"RTN","LRHBR2",133,0)
 .D ^DIC
"RTN","LRHBR2",134,0)
 .I X["^" S LREND=1 Q
"RTN","LRHBR2",135,0)
 .I Y>0 S ^TMP("LRTEST",$J,$P(Y,U,2))=""
"RTN","LRHBR2",136,0)
 .I Y<0 S STOP=1 Q
"RTN","LRHBR2",137,0)
 ;
"RTN","LRHBR2",138,0)
 I '$D(^TMP("LRTEST",$J)) S LRTEST="*" W "ALL Tests Selected"
"RTN","LRHBR2",139,0)
 E  S LRTEST=""
"RTN","LRHBR2",140,0)
 ;
"RTN","LRHBR2",141,0)
 Q
"RTN","LRHBR2",142,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",143,0)
IMAGE ; Prompt for rad image type(s) to be included (<Return> for all).
"RTN","LRHBR2",144,0)
 ;
"RTN","LRHBR2",145,0)
 N STOP
"RTN","LRHBR2",146,0)
 ;
"RTN","LRHBR2",147,0)
 K DIC,^TMP("LRTEST",$J)
"RTN","LRHBR2",148,0)
 W !!,"Press <Enter> at IMAGE TYPE Prompt to select All Tests",!
"RTN","LRHBR2",149,0)
 S DIC="^RA(79.2,",DIC(0)="AEMOQ",STOP=0,DIC("A")="IMAGE TYPE: "
"RTN","LRHBR2",150,0)
 ;
"RTN","LRHBR2",151,0)
 F  D  Q:STOP!(LREND)
"RTN","LRHBR2",152,0)
 .D ^DIC
"RTN","LRHBR2",153,0)
 .I X["^" S LREND=1 Q
"RTN","LRHBR2",154,0)
 .I Y>0 S ^TMP("LRTEST",$J,$P(Y,U,2))=""
"RTN","LRHBR2",155,0)
 .I Y<0 S STOP=1 Q
"RTN","LRHBR2",156,0)
 ;
"RTN","LRHBR2",157,0)
 I '$D(^TMP("LRTEST",$J)) S LRTEST="*" W "ALL Image Types Selected"
"RTN","LRHBR2",158,0)
 E  S LRTEST=""
"RTN","LRHBR2",159,0)
 ;
"RTN","LRHBR2",160,0)
 Q
"RTN","LRHBR2",161,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",162,0)
CPT ; Prompt for CPT Code(s) to be included (<Return> for all).
"RTN","LRHBR2",163,0)
 ;
"RTN","LRHBR2",164,0)
 N STOP
"RTN","LRHBR2",165,0)
 ;
"RTN","LRHBR2",166,0)
 K DIC,^TMP("LRCPT",$J)
"RTN","LRHBR2",167,0)
 W !!,"Press <Enter> at CPT CODE Prompt to select All Tests",!
"RTN","LRHBR2",168,0)
 S DIC="^ICPT(",DIC(0)="AEMOQ",STOP=0,DIC("A")="CPT CODE: "
"RTN","LRHBR2",169,0)
 ;
"RTN","LRHBR2",170,0)
 F  D  Q:STOP!(LREND)
"RTN","LRHBR2",171,0)
 .D ^DIC
"RTN","LRHBR2",172,0)
 .I X["^" S LREND=1 Q
"RTN","LRHBR2",173,0)
 .I Y>0 S ^TMP("LRCPT",$J,$P(Y,U,2))=""
"RTN","LRHBR2",174,0)
 .I Y<0 S STOP=1 Q
"RTN","LRHBR2",175,0)
 ;
"RTN","LRHBR2",176,0)
 I '$D(^TMP("LRCPT",$J)) S LRTEST="*" W "ALL CPT Codes Selected"
"RTN","LRHBR2",177,0)
 E  S LRTEST=""
"RTN","LRHBR2",178,0)
 ;
"RTN","LRHBR2",179,0)
 Q
"RTN","LRHBR2",180,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",181,0)
DETAIL ; Include detail?  (1=yes, 0=no).  Default "NO".
"RTN","LRHBR2",182,0)
 ;
"RTN","LRHBR2",183,0)
 K DIR
"RTN","LRHBR2",184,0)
 S DIR("B")="NO",DIR("A")="Include a Detailed Report?",DIR(0)="S^1:NO;2:YES"
"RTN","LRHBR2",185,0)
 ;
"RTN","LRHBR2",186,0)
 D ^DIR
"RTN","LRHBR2",187,0)
 S:($D(DUOUT))!($D(DTOUT)) LREND=1 S:'LREND LRDET=Y-1 Q
"RTN","LRHBR2",188,0)
 ;
"RTN","LRHBR2",189,0)
 Q
"RTN","LRHBR2",190,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",191,0)
START ; Produce report looping through OR(100 data.
"RTN","LRHBR2",192,0)
 ;
"RTN","LRHBR2",193,0)
 ;   Input: LRSDT - Start date
"RTN","LRHBR2",194,0)
 ;          LREDT - End date
"RTN","LRHBR2",195,0)
 ;          LRLOC - Location(s) [|loc1|loc2|...]
"RTN","LRHBR2",196,0)
 ;          LRDET - Detail      [0=No, 1=Yes]
"RTN","LRHBR2",197,0)
 ;
"RTN","LRHBR2",198,0)
 ;  Output: Report.
"RTN","LRHBR2",199,0)
 ;
"RTN","LRHBR2",200,0)
 N ABREV,CDATE,CPT,D0,DATA,IPROC,ITYPE,LOC,LRDT,LRDT1,ODATE,OR,OR1
"RTN","LRHBR2",201,0)
 N PNAME,PROV,RDATE,STATUS,TEST,TMP,TNAME
"RTN","LRHBR2",202,0)
 ;
"RTN","LRHBR2",203,0)
 S LRDT=(LREDT-1)+.999999,LRDT1=LRSDT+.999999
"RTN","LRHBR2",204,0)
 ;
"RTN","LRHBR2",205,0)
 F  S LRDT=$O(^OR(100,XREF,LRDT)) Q:LRDT=""!(LRDT>LRDT1)  D
"RTN","LRHBR2",206,0)
 .S OR="" F  S OR=$O(^OR(100,XREF,LRDT,OR)) Q:OR=""  D
"RTN","LRHBR2",207,0)
 ..I +$P($G(^OR(100,OR,0)),U,5)'=+LRT Q           ;not a lab/rad test
"RTN","LRHBR2",208,0)
 ..I '$D(^OR(100,OR,4.5)) Q
"RTN","LRHBR2",209,0)
 ..S OR1="" F  S OR1=$O(^OR(100,OR,4.5,OR1)) Q:OR1=""  D
"RTN","LRHBR2",210,0)
 ...S DATA=$G(^OR(100,OR,4.5,OR1,0))
"RTN","LRHBR2",211,0)
 ...I $P(DATA,U,4)'="Location" Q
"RTN","LRHBR2",212,0)
 ...S LOC=$G(^OR(100,OR,4.5,OR1,1)) Q:LOC=""
"RTN","LRHBR2",213,0)
 ...I LRLOC'[(B_LOC_B) Q
"RTN","LRHBR2",214,0)
 ...I $D(^TMP("LR",$J,LOC,OR)) Q
"RTN","LRHBR2",215,0)
 ...S TEST=$G(^OR(100,OR,4.5,1,1))                ;test
"RTN","LRHBR2",216,0)
 ...S ODATE=$$DATE($$FMTE^XLFDT(LRDT))            ;order date/time
"RTN","LRHBR2",217,0)
 ...S PROV=$$GET1^DIQ(100,OR,1)                   ;provider
"RTN","LRHBR2",218,0)
 ...S PNAME=$$GET1^DIQ(100,OR,.02)                ;patient name
"RTN","LRHBR2",219,0)
 ...S TNAME=$$GET1^DIQ(101.43,TEST,.01)           ;test/procedure name
"RTN","LRHBR2",220,0)
 ...S D0=+$$GET1^DIQ(101.43,TEST,2,"I")           ;D0 rad/nuc #71 file
"RTN","LRHBR2",221,0)
 ...S (ABREV,CPT,ITYPE,IPROC,TMP)=""
"RTN","LRHBR2",222,0)
 ...I D0]"" D
"RTN","LRHBR2",223,0)
 ....S CPT=$$GET1^DIQ(71,D0,9)                    ;CPT code
"RTN","LRHBR2",224,0)
 ....S ITYPE=$$GET1^DIQ(71,D0,12)                 ;Imaging type
"RTN","LRHBR2",225,0)
 ....I ITYPE]"" S TMP=$O(^RA(79.2,"B",ITYPE,""))
"RTN","LRHBR2",226,0)
 ....I TMP]"" S ABREV=$$GET1^DIQ(79.2,TMP,3)      ;Imaging type abbrev
"RTN","LRHBR2",227,0)
 ....S IPROC=$$GET1^DIQ(71,D0,.01)                ;Imaging procedure
"RTN","LRHBR2",228,0)
 ...S STATUS=$$GET1^DIQ(100,OR,5)                 ;status
"RTN","LRHBR2",229,0)
 ...I STATUS="UNRELEASED" Q                       ;no unreleased
"RTN","LRHBR2",230,0)
 ...S CDATE=$P($$GET1^DIQ(100,OR,33),S,2,3)       ;collect date/time
"RTN","LRHBR2",231,0)
 ...I CDATE]"",$P(CDATE,S)]"",$P(CDATE,S,2)]"" D
"RTN","LRHBR2",232,0)
 ....S CDATE=$P($G(^LRO(69,$P(CDATE,S),1,$P(CDATE,S,2),1)),U)
"RTN","LRHBR2",233,0)
 ....S CDATE=$$DATE($$FMTE^XLFDT(CDATE))
"RTN","LRHBR2",234,0)
 ...S RDATE=$$DATE($$GET1^DIQ(100,OR,22,"E"))     ;report date/time
"RTN","LRHBR2",235,0)
 ...I LRT="1B",RDATE="" Q                         ;CPT wRVU only reported
"RTN","LRHBR2",236,0)
 ...I LRT="1B",$E(STATUS,1)="D" Q                 ;         and no deleted
"RTN","LRHBR2",237,0)
 ...I +LRT=1 D
"RTN","LRHBR2",238,0)
 ....S TMP=$S(LRT="1B":RDATE,1:ODATE)_B_PROV      ;rad order detail
"RTN","LRHBR2",239,0)
 ....S TMP=TMP_B_PNAME_B_CPT_B_ITYPE
"RTN","LRHBR2",240,0)
 ....S TMP=TMP_B_IPROC_B_$E(STATUS,1)
"RTN","LRHBR2",241,0)
 ....S TNAME=ITYPE
"RTN","LRHBR2",242,0)
 ...I LRT=2 D
"RTN","LRHBR2",243,0)
 ....S TMP=ODATE_B_PROV_B_PNAME_B_TNAME           ;lab report detail
"RTN","LRHBR2",244,0)
 ....S TMP=TMP_B_$E(STATUS,1)_B_CDATE_B_RDATE
"RTN","LRHBR2",245,0)
 ...I LRT'="1A",LRT'="1B",TNAME]"",$D(^TMP("LRTEST",$J,TNAME))!(LRTEST="*") D
"RTN","LRHBR2",246,0)
 ....S ^TMP("LRTEST",$J)=$I(^TMP("LRTEST",$J))              ;total
"RTN","LRHBR2",247,0)
 ....S ^TMP("LRTEST",$J,TNAME)=$I(^TMP("LRTEST",$J,TNAME))  ;total by test
"RTN","LRHBR2",248,0)
 ...I +LRT=1,TNAME]"",ABREV]"" D
"RTN","LRHBR2",249,0)
 ....S ^TMP("LRX",$J,TNAME)=ABREV                           ;Image type abrev
"RTN","LRHBR2",250,0)
 ...I LRT'="1A",LRT'="1B",TNAME]"",'$D(^TMP("LRTEST",$J,TNAME)),LRTEST'="*" Q   ;test not selected
"RTN","LRHBR2",251,0)
 ...I (LRT="1A"!(LRT="1B")),IPROC]"" S:CPT="" CPT="NONE" D
"RTN","LRHBR2",252,0)
 ....I LRTEST'="*",'$D(^TMP("LRCPT",$J,CPT)) Q
"RTN","LRHBR2",253,0)
 ....S ^TMP("LRTEST",$J)=$I(^TMP("LRTEST",$J))                      ;Total
"RTN","LRHBR2",254,0)
 ....S ^TMP("LRTEST",$J,CPT,IPROC)=$I(^TMP("LRTEST",$J,CPT,IPROC))  ;total by CPT
"RTN","LRHBR2",255,0)
 ...I LRT="1A",LRTEST'="*",CPT]"",'$D(^TMP("LRCPT",$J,CPT)) Q       ;not a CPT to total
"RTN","LRHBR2",256,0)
 ...I LRT="1A",CPT="",LRTEST'="*" Q
"RTN","LRHBR2",257,0)
 ...S ^TMP("LR",$J)=$G(^TMP("LR",$J))+1                     ;grand total
"RTN","LRHBR2",258,0)
 ...S ^TMP("LR",$J,LOC)=$G(^TMP("LR",$J,LOC))+1             ;location total
"RTN","LRHBR2",259,0)
 ...S ^TMP("LR",$J,LOC,OR)=TMP                              ;order detail
"RTN","LRHBR2",260,0)
 ;
"RTN","LRHBR2",261,0)
 I '$D(^TMP("LR",$J)) D  Q                                  ;nothing matching criteria
"RTN","LRHBR2",262,0)
 .W !!,"No data found matching prescribed criteria.",!
"RTN","LRHBR2",263,0)
 D HDR
"RTN","LRHBR2",264,0)
 I 'LRDET Q
"RTN","LRHBR2",265,0)
 ;
"RTN","LRHBR2",266,0)
 S (LOC,OR,PLOC)=""
"RTN","LRHBR2",267,0)
 F  S LOC=$O(^TMP("LR",$J,LOC)) Q:LOC=""  D  Q:LREND
"RTN","LRHBR2",268,0)
 .I LOC'=PLOC S PLOC=LOC D SHDR
"RTN","LRHBR2",269,0)
 .F  S OR=$O(^TMP("LR",$J,LOC,OR)) Q:OR=""  D  Q:LREND
"RTN","LRHBR2",270,0)
 ..S DATA=^TMP("LR",$J,LOC,OR)
"RTN","LRHBR2",271,0)
 ..I DATA="" Q
"RTN","LRHBR2",272,0)
 ..I $Y+2>IOSL D WAIT Q:LREND  D:$E(IOST,1,2)'="C-" HDR D SHDR
"RTN","LRHBR2",273,0)
 ..I +LRT=1 D
"RTN","LRHBR2",274,0)
 ...S TMP=$P(DATA,B,5)
"RTN","LRHBR2",275,0)
 ...I TMP]"",$G(^TMP("LRX",$J,TMP))]"" S TMP=^TMP("LRX",$J,TMP)
"RTN","LRHBR2",276,0)
 ...W !,$P($P(DATA,B),"@")
"RTN","LRHBR2",277,0)
 ...W ?10,$E($P(DATA,B,2),1,14),?26,$E($P(DATA,B,3),1,14)
"RTN","LRHBR2",278,0)
 ...W ?42,$E($P(DATA,B,4),1,14),?49,$E(TMP,1,11)
"RTN","LRHBR2",279,0)
 ...W ?55,$E($P(DATA,B,6),1,21),?77,$P(DATA,B,7)
"RTN","LRHBR2",280,0)
 ...W ! I $P(DATA,B)]"" W " @",$P($P(DATA,B),"@",2)
"RTN","LRHBR2",281,0)
 ...W ?10,$E($P(DATA,B,2),15,28),?26,$E($P(DATA,B,3),15,28)
"RTN","LRHBR2",282,0)
 ...W ?42,$E($P(DATA,B,4),15,28),?49,$E(TMP,12,22)
"RTN","LRHBR2",283,0)
 ...W ?55,$E($P(DATA,B,6),22,42)
"RTN","LRHBR2",284,0)
 ..I LRT=2 D
"RTN","LRHBR2",285,0)
 ...W !,$P($P(DATA,B),"@"),?10,$E($P(DATA,B,2),1,14)
"RTN","LRHBR2",286,0)
 ...W ?26,$E($P(DATA,B,3),1,14),?42,$E($P(DATA,B,4),1,14)
"RTN","LRHBR2",287,0)
 ...W ?58,$P(DATA,B,5),?62,$P($P(DATA,B,6),"@")
"RTN","LRHBR2",288,0)
 ...W ?72 I $P(DATA,B,5)'="D" W $P($P(DATA,B,7),"@")
"RTN","LRHBR2",289,0)
 ...W ! I $P(DATA,B)]"" W " @",$P($P(DATA,B),"@",2)
"RTN","LRHBR2",290,0)
 ...W ?10,$E($P(DATA,B,2),15,28),?26,$E($P(DATA,B,3),15,28)
"RTN","LRHBR2",291,0)
 ...W ?42,$E($P(DATA,B,4),15,28)
"RTN","LRHBR2",292,0)
 ...W ?62 I $P(DATA,B,6)]"" W " @",$P($P(DATA,B,6),"@",2)
"RTN","LRHBR2",293,0)
 ...W ?72 I $P(DATA,B,5)'="D",$P(DATA,B,7)]"" D
"RTN","LRHBR2",294,0)
 ....W " @",$P($P(DATA,B,7),"@",2)
"RTN","LRHBR2",295,0)
 ;
"RTN","LRHBR2",296,0)
 Q
"RTN","LRHBR2",297,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",298,0)
HDR ; Print header and totals by location.
"RTN","LRHBR2",299,0)
 ;
"RTN","LRHBR2",300,0)
 N EXAM,GTWRVU,L,NAME,TEXAM,TWRVU,WRVU
"RTN","LRHBR2",301,0)
 ;
"RTN","LRHBR2",302,0)
 S LRPAG=LRPAG+1
"RTN","LRHBR2",303,0)
 ;
"RTN","LRHBR2",304,0)
 W ?$S(LRT=2:24,LRT=1:20,LRT="1B":18,1:22),"Remote "
"RTN","LRHBR2",305,0)
 W $S(LRT=2:"Lab",1:"Radiology")," Orders by "
"RTN","LRHBR2",306,0)
 W $S(LRT=2:"Test Name",LRT=1:"Imaging Type",1:"CPT Code")
"RTN","LRHBR2",307,0)
 I LRT="1B" W " and wRVU"
"RTN","LRHBR2",308,0)
 W ?73,"Page ",LRPAG
"RTN","LRHBR2",309,0)
 W !?23,"From ",$$FMTE^XLFDT(LREDT)," to ",$$FMTE^XLFDT(LRSDT)
"RTN","LRHBR2",310,0)
 W !?22,"Date Printed: ",$$FMTE^XLFDT($$NOW^XLFDT),!
"RTN","LRHBR2",311,0)
 ;
"RTN","LRHBR2",312,0)
 I LRT="1A" D  Q
"RTN","LRHBR2",313,0)
 .W !?5,"CPT",?12,"Procedure",?50,"Total"
"RTN","LRHBR2",314,0)
 .W !?5,$TR($J("",65)," ","-")
"RTN","LRHBR2",315,0)
 .S (L,NAME)=""
"RTN","LRHBR2",316,0)
 .F  S L=$O(^TMP("LRTEST",$J,L)) Q:L=""  D  Q:LREND
"RTN","LRHBR2",317,0)
 ..F  S NAME=$O(^TMP("LRTEST",$J,L,NAME)) Q:NAME=""  D  Q:LREND
"RTN","LRHBR2",318,0)
 ...W !?5,L,?12,$E(NAME,1,37),?50,^TMP("LRTEST",$J,L,NAME)
"RTN","LRHBR2",319,0)
 .W !?5,$TR($J("",50)," ","-")
"RTN","LRHBR2",320,0)
 .W !?5,$J("Total",38),$TR($J(^TMP("LRTEST",$J),10)," ","."),!
"RTN","LRHBR2",321,0)
 ;
"RTN","LRHBR2",322,0)
 I LRT="1B" D  Q
"RTN","LRHBR2",323,0)
 .S (WRVU,TWRVU,GTWRVU,EXAM,GTEXAM)=0
"RTN","LRHBR2",324,0)
 .W !?58,"Total",?70,"Total"
"RTN","LRHBR2",325,0)
 .W !?5,"CPT",?12,"Procedure",?50,"wRVU",?58,"Exams",?70,"wRVU"
"RTN","LRHBR2",326,0)
 .W !?5,$TR($J("",70)," ","-")
"RTN","LRHBR2",327,0)
 .S (L,NAME)=""
"RTN","LRHBR2",328,0)
 .F  S L=$O(^TMP("LRTEST",$J,L)) Q:L=""  D  Q:LREND
"RTN","LRHBR2",329,0)
 ..F  S NAME=$O(^TMP("LRTEST",$J,L,NAME)) Q:NAME=""  D  Q:LREND
"RTN","LRHBR2",330,0)
 ...S WRVU=+$$RVU^FBRVU(L),EXAM=^TMP("LRTEST",$J,L,NAME)
"RTN","LRHBR2",331,0)
 ...S TWRVU=WRVU*EXAM,GTWRVU=GTWRVU+TWRVU,GTEXAM=GTEXAM+EXAM
"RTN","LRHBR2",332,0)
 ...W !?5,L,?12,$E(NAME,1,37),?50,WRVU,?58,EXAM,?70,TWRVU
"RTN","LRHBR2",333,0)
 .W !?5,$TR($J("",70)," ","-")
"RTN","LRHBR2",334,0)
 .W !?5,$J("Totals",40),?58,GTEXAM,?70,GTWRVU,!
"RTN","LRHBR2",335,0)
 ;
"RTN","LRHBR2",336,0)
 S L=""
"RTN","LRHBR2",337,0)
 F  S L=$O(^TMP("LRTEST",$J,L)) Q:L=""  D  Q:LREND
"RTN","LRHBR2",338,0)
 .I $G(^TMP("LRX",$J,L))]"" S NAME=^TMP("LRX",$J,L)
"RTN","LRHBR2",339,0)
 .E  S NAME=L
"RTN","LRHBR2",340,0)
 .W !?5,$J(NAME,$S(+LRT=1:15,1:35))
"RTN","LRHBR2",341,0)
 .W $TR($J(^TMP("LRTEST",$J,L),10)," ",".")
"RTN","LRHBR2",342,0)
 W !?5,$TR($J("",$S(+LRT=1:26,1:46))," ","-")
"RTN","LRHBR2",343,0)
 W !?5,$J("Total",$S(+LRT=1:15,1:35))
"RTN","LRHBR2",344,0)
 W $TR($J(+$G(^TMP("LRTEST",$J)),10)," ","."),!
"RTN","LRHBR2",345,0)
 ;
"RTN","LRHBR2",346,0)
 Q
"RTN","LRHBR2",347,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",348,0)
SHDR ; Print sub header.
"RTN","LRHBR2",349,0)
 ;
"RTN","LRHBR2",350,0)
 I $Y+6>IOSL D WAIT Q:LREND  D:$E(IOST,1,2)'="C-" HDR W !
"RTN","LRHBR2",351,0)
 ;
"RTN","LRHBR2",352,0)
 W !!,"==> Performing Location: ",LOC,!
"RTN","LRHBR2",353,0)
 I +LRT=1 D                                       ;rad sub header
"RTN","LRHBR2",354,0)
 .W !,$S(LRT="1B":"Report",1:"Order")
"RTN","LRHBR2",355,0)
 .W ?10,"Provider",?26,"Patient",?42,"CPT",?49,"Type"
"RTN","LRHBR2",356,0)
 .W ?55,"Image Procedure",?77,"St"
"RTN","LRHBR2",357,0)
 .W !,$TR($J("",8)," ","-"),?10,$TR($J("",14)," ","-")
"RTN","LRHBR2",358,0)
 .W ?26,$TR($J("",14)," ","-"),?42,$TR($J("",5)," ","-")
"RTN","LRHBR2",359,0)
 .W ?49,$TR($J("",4)," ","-"),?55,$TR($J("",20)," ","-")
"RTN","LRHBR2",360,0)
 .W ?77,$TR($J("",3)," ","-")
"RTN","LRHBR2",361,0)
 ;
"RTN","LRHBR2",362,0)
 I LRT=2 D                                       ;lab sub header
"RTN","LRHBR2",363,0)
 .W !,"Order",?10,"Provider",?26,"Patient",?42
"RTN","LRHBR2",364,0)
 .W "Test",?58,"St",?62,"Collect",?72,"Report"
"RTN","LRHBR2",365,0)
 .W !,$TR($J("",8)," ","-"),?10,$TR($J("",14)," ","-")
"RTN","LRHBR2",366,0)
 .W ?26,$TR($J("",14)," ","-"),?42,$TR($J("",14)," ","-")
"RTN","LRHBR2",367,0)
 .W ?58,$TR($J("",3)," ","-"),?62,$TR($J("",8)," ","-")
"RTN","LRHBR2",368,0)
 .W ?72,$TR($J("",8)," ","-")
"RTN","LRHBR2",369,0)
 ;
"RTN","LRHBR2",370,0)
 Q
"RTN","LRHBR2",371,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",372,0)
DATE(DATE) ; Convert mmm dd, yyyy@hh:mm to mm/dd/yyyy@hh:mm
"RTN","LRHBR2",373,0)
 ;
"RTN","LRHBR2",374,0)
 N DD,DM,DSTR,DY,LOWER,TM,UPPER
"RTN","LRHBR2",375,0)
 ;
"RTN","LRHBR2",376,0)
 I $G(DATE)="" Q ""
"RTN","LRHBR2",377,0)
 ;
"RTN","LRHBR2",378,0)
 S LOWER="abcdefghijklmnopqrstuvwxyz"
"RTN","LRHBR2",379,0)
 S UPPER="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
"RTN","LRHBR2",380,0)
 S DSTR("JAN")="01",DSTR("FEB")="02",DSTR("MAR")="03",DSTR("APR")="04"
"RTN","LRHBR2",381,0)
 S DSTR("MAY")="05",DSTR("JUN")="06",DSTR("JUL")="07",DSTR("AUG")="08"
"RTN","LRHBR2",382,0)
 S DSTR("SEP")="09",DSTR("OCT")=10,DSTR("NOV")=11,DSTR("DEC")=12
"RTN","LRHBR2",383,0)
 ;
"RTN","LRHBR2",384,0)
 S DM=$TR($P(DATE," "),LOWER,UPPER),DD=$P($P(DATE," ",2),",")
"RTN","LRHBR2",385,0)
 S DY=$E($P($P(DATE," ",3),"@"),3,4),TM=$P($P(DATE,"@",2),":",1,2)
"RTN","LRHBR2",386,0)
 ;
"RTN","LRHBR2",387,0)
 Q DSTR(DM)_"/"_DD_"/"_DY_"@"_TM
"RTN","LRHBR2",388,0)
 ;---------------------------------------------------------------------
"RTN","LRHBR2",389,0)
WAIT ; Pause for page breaks.
"RTN","LRHBR2",390,0)
 ;
"RTN","LRHBR2",391,0)
 K DIR
"RTN","LRHBR2",392,0)
 S DIR(0)="E"
"RTN","LRHBR2",393,0)
 D ^DIR
"RTN","LRHBR2",394,0)
 S:($D(DUOUT))!($D(DTOUT)) LREND=1
"RTN","LRHBR2",395,0)
 S $Y=1
"RTN","LRHBR2",396,0)
 ;
"RTN","LRHBR2",397,0)
 Q
"RTN","RAHBIN")
0^10^B14288552
"RTN","RAHBIN",1,0)
RAHBIN ;LEIDOS/TCK- Remote ordering - Radiology ; 8/30/16 12:04pm
"RTN","RAHBIN",2,0)
 ;;1.0;Radiology Orders Portability;;April 1, 2016;Build 19
"RTN","RAHBIN",3,0)
 ; Reference to ^DIC(4 supported by IA #10090
"RTN","RAHBIN",4,0)
 ; Reference to DC^ORWDXA supported by IA #5595
"RTN","RAHBIN",5,0)
 ; Reference to SEND^ORWDX supported by IA #5596
"RTN","RAHBIN",6,0)
 ;
"RTN","RAHBIN",7,0)
 ; Updated: 20100908
"RTN","RAHBIN",8,0)
 ; updated 20101124 rhl DBGOUT
"RTN","RAHBIN",9,0)
 ; updated 20110509 dje: IA comments, code cleanup.  Note:  the IA references may be unnecessary, since the relevant code is commented out.
"RTN","RAHBIN",10,0)
 ;
"RTN","RAHBIN",11,0)
 ; gsn - Start using RD1 type delimiters instead of D1 types as these
"RTN","RAHBIN",12,0)
 ;       variables are used by fileman calls
"RTN","RAHBIN",13,0)
 ; 4076 - PACS define REQLOC from OBR13
"RTN","RAHBIN",14,0)
 ;
"RTN","RAHBIN",15,0)
EN ;
"RTN","RAHBIN",16,0)
 ; Note: HL7 delimitors D1-D5 are defined in JVOR
"RTN","RAHBIN",17,0)
 ;
"RTN","RAHBIN",18,0)
 S ^TMP("HLMT")=HLMTIEN
"RTN","RAHBIN",19,0)
 ;
"RTN","RAHBIN",20,0)
 K ^TMP("RMTE"),REC,HLARY
"RTN","RAHBIN",21,0)
 N I,D1,D2,D3,D4,D5,TYPE
"RTN","RAHBIN",22,0)
 S (D1,D2,D3,D4,D5,TYPE)="",C=0  ;Initialize variables
"RTN","RAHBIN",23,0)
 I $G(HLMTIEN)'>0 S LROROUT(1)="0^No Results Array Received" Q
"RTN","RAHBIN",24,0)
 S HLMA="",HLMA=$O(^HLMA("B",HLMTIEN,HLMA))
"RTN","RAHBIN",25,0)
 Q:$G(HLMA)'>0
"RTN","RAHBIN",26,0)
 Q:'$D(^HLMA(HLMA,0))
"RTN","RAHBIN",27,0)
 Q:'$D(^HLMA(HLMA,"MSH"))
"RTN","RAHBIN",28,0)
 S LOC=+$P(^HLMA(HLMA,"MSH",1,0),"|",4)
"RTN","RAHBIN",29,0)
 M ^TMP("RMTE",1)=^HLMA(HLMA,"MSH",1,0)
"RTN","RAHBIN",30,0)
 S DONE=0
"RTN","RAHBIN",31,0)
 S I=0 F  S I=$O(^HL(772,HLMTIEN,"IN",I)) Q:I=""  D
"RTN","RAHBIN",32,0)
 .Q:I=""
"RTN","RAHBIN",33,0)
 .S C=$G(I)+1
"RTN","RAHBIN",34,0)
 .S SB=$P(^HL(772,HLMTIEN,"IN",I,0),"|")
"RTN","RAHBIN",35,0)
 .I 'DONE,SB=""!(SB'?.A),$P(^TMP("RMTE",I),"|")="OBR" D  Q
"RTN","RAHBIN",36,0)
 ..S ^TMP("RMTE",C-1)=^TMP("RMTE",C-1)_^HL(772,HLMTIEN,"IN",I,0),DONE=1
"RTN","RAHBIN",37,0)
 .S ^TMP("RMTE",C)=^HL(772,HLMTIEN,"IN",I,0)
"RTN","RAHBIN",38,0)
 K RAMSG M RAMSG=^TMP("RMTE")
"RTN","RAHBIN",39,0)
 K ^TMP("RMTE")	 
"RTN","RAHBIN",40,0)
 S RD1="|",RD2="^",RD3="\"
"RTN","RAHBIN",41,0)
 K RAOROUT
"RTN","RAHBIN",42,0)
 N XC
"RTN","RAHBIN",43,0)
 N ORIEN,WPRT,WPACH
"RTN","RAHBIN",44,0)
 N LROK S LROK=1
"RTN","RAHBIN",45,0)
 N IMGLOC,PROC,REQPRV,PRISTF,EXMDT,RPTSTA,RPTDT,TRNSCP,VRFDT
"RTN","RAHBIN",46,0)
 N RADTE,IMGTYP,HOSDIV,CASE,EXSTAT,EXCAT,WARD,SERVC,RAOIEN,REQPRV,RPTEN
"RTN","RAHBIN",47,0)
 N BED,REQLOC,CRDMTH,PRIRES,PRIDGC,RPTIEN,SECRES,SECSTF,SECDGC
"RTN","RAHBIN",48,0)
 N LCASE,DFN,RPTENTDT,VRFDT,VRFPHY,ESCD,SVCBY,ITRLOC,LOGDT,ACTION,WPIT,WPRT,REQSTA,LSTACT,RAOSTADT,RAONWSTA
"RTN","RAHBIN",49,0)
 ;
"RTN","RAHBIN",50,0)
 N RACNT S RACNT=1
"RTN","RAHBIN",51,0)
 Q:'$D(RAMSG)
"RTN","RAHBIN",52,0)
 D PARSE
"RTN","RAHBIN",53,0)
 Q:'$D(HLARY)
"RTN","RAHBIN",54,0)
 ;
"RTN","RAHBIN",55,0)
 I ORC1="DC" D EN^LRHBIN G ENQ ; CPRS discontinue
"RTN","RAHBIN",56,0)
 ;I ORC1="CA" D HLD^RAHBIN1 G ENQ ; Hold order
"RTN","RAHBIN",57,0)
 I ORC1="CA" D EN^LRHBIN G ENQ ; Cancel exam and case
"RTN","RAHBIN",58,0)
 I ORC1="NW",ORC5="IP" D REG^RAHBIN1 G ENQ
"RTN","RAHBIN",59,0)
 I ORC1="SC",ORC5="IP" D  G ENQ
"RTN","RAHBIN",60,0)
 .I OBR25="X" D HLD^RAHBIN1 ;Cancel Arrival
"RTN","RAHBIN",61,0)
 .I OBR25="I" D REG^RAHBIN1 ;Rad Arrival
"RTN","RAHBIN",62,0)
 I ORC1="RE" D  G ENQ ;  results
"RTN","RAHBIN",63,0)
 .I OBR25'["F" Q
"RTN","RAHBIN",64,0)
 .D RSLT^RAHBIN1 G ENQ
"RTN","RAHBIN",65,0)
 I ORC1="XO" D MOD^RAHBIN1 G ENQ  ;set to EXAMINED status
"RTN","RAHBIN",66,0)
 ;
"RTN","RAHBIN",67,0)
 ;bsl;non-translated vista codes instead of CHCS codes
"RTN","RAHBIN",68,0)
 ;I ORC1="NW" Q D REG^JVHLRAD G ENQ  ; registration
"RTN","RAHBIN",69,0)
 ;
"RTN","RAHBIN",70,0)
 S RAOROUT(1)="-1^UNKNOWN RAD MESSAGE TYPE RECEIVED="_ORC1
"RTN","RAHBIN",71,0)
ENQ ;
"RTN","RAHBIN",72,0)
 I '$D(RAOROUT(1)) S RAOROUT(1)="-1^NO RETURN MESSAGE"
"RTN","RAHBIN",73,0)
 S RAOROUT(1)=RAOROUT(1)_$C(13)
"RTN","RAHBIN",74,0)
 K MSHSEG,ORC,ORCSEG,ORDSEG,ORWREC,PID
"RTN","RAHBIN",75,0)
 Q
"RTN","RAHBIN",76,0)
 ;
"RTN","RAHBIN",77,0)
TEST(LROROUT,HLMTIEN) ;
"RTN","RAHBIN",78,0)
 D EN
"RTN","RAHBIN",79,0)
 Q
"RTN","RAHBIN",80,0)
 ;
"RTN","RAHBIN",81,0)
CHKORID(ID) ;
"RTN","RAHBIN",82,0)
 Q
"RTN","RAHBIN",83,0)
 ;
"RTN","RAHBIN",84,0)
PARSE ;
"RTN","RAHBIN",85,0)
 K PIDSEG
"RTN","RAHBIN",86,0)
 N ZCNT,FLG,XT,XC,X
"RTN","RAHBIN",87,0)
 S PIDSEG="",ORCSEG=""
"RTN","RAHBIN",88,0)
 ;
"RTN","RAHBIN",89,0)
 S ZCNT="",FLG=0,U="^"
"RTN","RAHBIN",90,0)
 F  S ZCNT=$O(RAMSG(ZCNT)) Q:ZCNT=""  D  Q:FLG=2
"RTN","RAHBIN",91,0)
 . S XT=$P(RAMSG(ZCNT),RD1,1) Q:XT=""
"RTN","RAHBIN",92,0)
 . S XC=$G(HLARY(XT))+1,HLARY(XT)=XC
"RTN","RAHBIN",93,0)
 . S HLARY(XT,XC)=$P(RAMSG(ZCNT),RD1,2,999)
"RTN","RAHBIN",94,0)
 ;   set some basic variables:
"RTN","RAHBIN",95,0)
 S X=HLARY("MSH",1),X=$P(X,RD1,8),XMT=$P(X,RD1,1),XME=$P(X,RD1,2)
"RTN","RAHBIN",96,0)
 S MSHSEG=HLARY("MSH",1),PIDSEG=$G(HLARY("PID",1)),ORCSEG=$G(HLARY("ORC",1))
"RTN","RAHBIN",97,0)
 S ORC1=$P($G(HLARY("ORC",1)),RD1,1),ORC5=$P($G(HLARY("ORC",1)),RD1,5)
"RTN","RAHBIN",98,0)
 S REQLOC=+$P($G(HLARY("ORC",1)),RD1,13)         ;4076 init Reqloc
"RTN","RAHBIN",99,0)
 S OBR25=$P($G(HLARY("OBR",1)),RD1,25)
"RTN","RAHBIN",100,0)
 S ORIEN=$P($G(HLARY("OBR",1)),RD1,2)
"RTN","RAHBIN",101,0)
 I $G(HLARY("ORC"))'>0 S ORC1="RE"
"RTN","RAHBIN",102,0)
 Q
"RTN","RAHBIN",103,0)
 ;
"RTN","RAHBIN",104,0)
DBG ;
"RTN","RAHBIN",105,0)
 K DBKIND,DBCNT
"RTN","RAHBIN",106,0)
 D INT^JVHLDBG("JVRA",.DBKIND,.DBCNT)
"RTN","RAHBIN",107,0)
 I DBKIND["I" D JVIN^JVHLDBG("JVRA",DBCNT,.RAMSG)
"RTN","RAHBIN",108,0)
 Q
"RTN","RAHBIN",109,0)
DBGOUT ;
"RTN","RAHBIN",110,0)
 I $D(RAOROUT),$G(DBCNT) D JVOUT^JVHLDBG("JVRA",DBCNT,.RAOROUT)
"RTN","RAHBIN",111,0)
 Q
"RTN","RAHBIN",112,0)
 ;
"RTN","RAHBIN2")
0^12^B97217147
"RTN","RAHBIN2",1,0)
RAHBIN2 ;LEIDOS/TCK- REMOTE ORDERING - Radiology - PARSER ; 8/30/16 12:15pm
"RTN","RAHBIN2",2,0)
 ;;1.0;Radiology Orders Portability;** GSN TEST VERSION ***;April 1, 2016;Build 19
"RTN","RAHBIN2",3,0)
 ; Reference to NOW^%DTC supported by IA #10000
"RTN","RAHBIN2",4,0)
 ; Reference to ^OR(100 supported by IA #5196
"RTN","RAHBIN2",5,0)
 ; Reference to ^RAMIS(71 supported by IA #5607
"RTN","RAHBIN2",6,0)
 ; Reference to ^RADPT( supported by IA #5602
"RTN","RAHBIN2",7,0)
 ; Reference to ^RAO(75.1 supported by IA #5604
"RTN","RAHBIN2",8,0)
 ; Reference to ^DPT( supported by IA #10035
"RTN","RAHBIN2",9,0)
 ; Reference to ^VA(200 supported by IA #10060
"RTN","RAHBIN2",10,0)
 ; Reference to ^RA(79.1 supported by IA #5610
"RTN","RAHBIN2",11,0)
 ; Reference to CN^RAREG1 supported by IA #5479
"RTN","RAHBIN2",12,0)
 ; Reference to HL7TFM^XLFDT supported by IA #10103
"RTN","RAHBIN2",13,0)
 ; Reference to ^RA(72 supported by IA #5606
"RTN","RAHBIN2",14,0)
 ;
"RTN","RAHBIN2",15,0)
 ; updated 20100908
"RTN","RAHBIN2",16,0)
 ; updated 20110509 dje: document IAs, code cleanup
"RTN","RAHBIN2",17,0)
 ;
"RTN","RAHBIN2",18,0)
 ; gsn  - convert to RD1 type delimiters.
"RTN","RAHBIN2",19,0)
 ; 4839 - add Impression txt for filing seperately from report txt
"RTN","RAHBIN2",20,0)
 ;        also had to rework amendment text logic here and in rtn
"RTN","RAHBIN2",21,0)
 ;        RAHBIN2.
"RTN","RAHBIN2",22,0)
 ; 5265 - Add the "AE xref after we get case number so other processes
"RTN","RAHBIN2",23,0)
 ;        also calling CN^RARE1, will see the case number is in use.
"RTN","RAHBIN2",24,0)
 ;
"RTN","RAHBIN2",25,0)
 Q
"RTN","RAHBIN2",26,0)
 ;
"RTN","RAHBIN2",27,0)
EN ;
"RTN","RAHBIN2",28,0)
 N X,OBXCNT,RCNT,STOP
"RTN","RAHBIN2",29,0)
 K PRGFLG S PRGFLG=""
"RTN","RAHBIN2",30,0)
 ;
"RTN","RAHBIN2",31,0)
 ;   process HL7 segments:
"RTN","RAHBIN2",32,0)
PID ;
"RTN","RAHBIN2",33,0)
 K DFN
"RTN","RAHBIN2",34,0)
 S DFN=""
"RTN","RAHBIN2",35,0)
 S X=HLARY("PID",1),DFN=$P(X,RD1,2)
"RTN","RAHBIN2",36,0)
 I DFN["-" S DFN=+$P(DFN,"-",2)
"RTN","RAHBIN2",37,0)
 ;I $G(NAME)'="" S DFN="",DFN=$O(^DPT("B",NAME,DFN))
"RTN","RAHBIN2",38,0)
 S SEX=$$GET1^DIQ(2,DFN,.02,"I")
"RTN","RAHBIN2",39,0)
 ;
"RTN","RAHBIN2",40,0)
PV1 ;
"RTN","RAHBIN2",41,0)
 S X=$G(HLARY("PV1",1)) D  ; rhl 20100927
"RTN","RAHBIN2",42,0)
 . S X="NO"
"RTN","RAHBIN2",43,0)
 . S PRGFLG=$P(X,RD1,15),PRGFLG=$E(PRGFLG,1),PRGFLG=$TR(PRGFLG,"YNU","ynu")
"RTN","RAHBIN2",44,0)
 . I PRGFLG'="y",PRGFLG'="n",PRGFLG'="u" S PRGFLG=""
"RTN","RAHBIN2",45,0)
 ;
"RTN","RAHBIN2",46,0)
ORC ;
"RTN","RAHBIN2",47,0)
 I $D(HLARY("ORC")) D
"RTN","RAHBIN2",48,0)
 .S X=HLARY("ORC",1),EXMDT=$P(X,RD1,9)
"RTN","RAHBIN2",49,0)
 .S:'EXMDT EXMDT=$P(X,"^",14) I 'EXMDT D NOW^%DTC S EXMDT=%
"RTN","RAHBIN2",50,0)
 .S EXMDT=$$HLD(EXMDT),REQDT=EXMDT
"RTN","RAHBIN2",51,0)
 .S EXMSTA=$P($P(X,"|",17),"^")
"RTN","RAHBIN2",52,0)
 .S CATEG=$P($P(X,"|",17),"^",2)
"RTN","RAHBIN2",53,0)
 .S WARD=$P($P(X,"|",17),"^",3)
"RTN","RAHBIN2",54,0)
 .S SERVICE=$P($P(X,"|",17),"^",4)
"RTN","RAHBIN2",55,0)
 .S OR=$P(X,2),ST=$$GET1^DIQ(100,OR,5,"I")
"RTN","RAHBIN2",56,0)
 .I ST=5 S RAONWSTA=6
"RTN","RAHBIN2",57,0)
 .I ST=6 S RAONWSTA=2
"RTN","RAHBIN2",58,0)
 .S USER=$P(X,"|",10),USER=$P(USER,"^",2,3),USER=$TR(USER,"^",",")
"RTN","RAHBIN2",59,0)
 .S RADARRY("USER")=$G(USER)
"RTN","RAHBIN2",60,0)
OBR ;
"RTN","RAHBIN2",61,0)
 K ORIEN,IMGLOC,PRISTF,PROC,REQPRV,RPTSTA,RPTDT,TRNSCP,VRFDT,ITRLOC,VRFPHY
"RTN","RAHBIN2",62,0)
 ;K RADARRY("RPTSTA")
"RTN","RAHBIN2",63,0)
 S ORIEN="",IMGLOC="",ITRLOC="",VRFPHYN=""
"RTN","RAHBIN2",64,0)
 N %
"RTN","RAHBIN2",65,0)
 S X=HLARY("OBR",1),IMGLOC=+$P($P(X,RD1,21),"`",2),PROC=+$P($P(X,RD1,4),"^",4),REQPRV=$P(X,RD1,16),PRISTF=0,VRFPHY=$P(X,RD1,32)
"RTN","RAHBIN2",66,0)
 S PRVNM=$P(REQPRV,"^",2,3) I PRVNM["^" S PRVNM=$TR(PRVNM,"^",",")
"RTN","RAHBIN2",67,0)
 I PRVNM'="",$D(^VA(200,"B",PRVNM)) D
"RTN","RAHBIN2",68,0)
 .S REQPRV="",REQPRV=$O(^VA(200,"B",PRVNM,REQPRV))
"RTN","RAHBIN2",69,0)
 I PRVNM=""!('$D(^VA(200,"B",PRVNM))) D PROXY(.REQPRV,.PRVNM)
"RTN","RAHBIN2",70,0)
 I VRFPHY="" S VRFPHY=0
"RTN","RAHBIN2",71,0)
 D PROXY(.VRFPHY,.VRFPHYN)
"RTN","RAHBIN2",72,0)
 S USER=$P(X,"|",35),USER=$P(USER,"^",2,3),USER=$TR(USER,"^",",")
"RTN","RAHBIN2",73,0)
 S ITRLOC=+$P($P(X,RD1,21),"`",2)
"RTN","RAHBIN2",74,0)
 I $G(EXMDT)'>0 D
"RTN","RAHBIN2",75,0)
 .S EXMDT=$P(X,RD1,7)
"RTN","RAHBIN2",76,0)
 .S:'EXMDT EXMDT=$P(X,"^",14)
"RTN","RAHBIN2",77,0)
 .I 'EXMDT D NOW^%DTC S EXMDT=%
"RTN","RAHBIN2",78,0)
 .S EXMDT=$$HLD(EXMDT),REQDT=EXMDT
"RTN","RAHBIN2",79,0)
 S RPTSTA=$P(X,RD1,25),RPTDT=$$HLD($P(X,RD1,22)),TRNSCP=+$P(X,RD1,35)
"RTN","RAHBIN2",80,0)
 S VRFDT=$P(X,RD1,22),VRFDT=$$HLD($P(X,RD1,22)),ORIEN=+$P(X,RD1,2)
"RTN","RAHBIN2",81,0)
 I RPTSTA="F" S RPTSTA="V"  ;BSL;Fix to allow results viewing
"RTN","RAHBIN2",82,0)
 S RADARRY("RPTSTA")=RPTSTA
"RTN","RAHBIN2",83,0)
 S RADARRY("USER")=$G(USER)
"RTN","RAHBIN2",84,0)
 ;
"RTN","RAHBIN2",85,0)
 I $G(NWSTATUS)'="",$G(PROC) S EXSTAT=$$GETSTA(PROC,NWSTATUS) ; rhl 20100929
"RTN","RAHBIN2",86,0)
 S RADARRY("EXSTAT")=$G(EXSTAT)
"RTN","RAHBIN2",87,0)
 ;
"RTN","RAHBIN2",88,0)
OBX ; 
"RTN","RAHBIN2",89,0)
 N HCNT,ICNT,RCNT,IMPBEG,RAAM,AMENDED,DELIM,RATMP,SKIP,TXT
"RTN","RAHBIN2",90,0)
 S (IMPBEG,RAAM)=0
"RTN","RAHBIN2",91,0)
 ;
"RTN","RAHBIN2",92,0)
 ;4839:
"RTN","RAHBIN2",93,0)
 S (RCNT,HCNT,ICNT)=1 ;init these counters when first OBX happens
"RTN","RAHBIN2",94,0)
 ;
"RTN","RAHBIN2",95,0)
 ;Loop thru HLARY and convert Report nodes, which qaulify, to
"RTN","RAHBIN2",96,0)
 ;Impression nodes.
"RTN","RAHBIN2",97,0)
 ;
"RTN","RAHBIN2",98,0)
 F OBXCNT=0:0 S OBXCNT=$O(HLARY("OBX",OBXCNT)) Q:'OBXCNT  D
"RTN","RAHBIN2",99,0)
 . S X=HLARY("OBX",OBXCNT)
"RTN","RAHBIN2",100,0)
 . Q:($P(X,RD1,3)'["REPORT")&($P(X,RD1,3)'["RESCODE")
"RTN","RAHBIN2",101,0)
 . ;check for beginning of IMP txt
"RTN","RAHBIN2",102,0)
 . S:$$UP^XLFSTR($P(X,RD1,5))["IMPRESSION:" IMPBEG=1
"RTN","RAHBIN2",103,0)
 . I $P(X,RD1,3)["RESCODE" S IMPBEG=0   ;reset impbeg at Rescode line
"RTN","RAHBIN2",104,0)
 . I IMPBEG D
"RTN","RAHBIN2",105,0)
 .. S $P(X,RD1,3)="I\IMPRESSION\L",HLARY("OBX",OBXCNT)=X
"RTN","RAHBIN2",106,0)
 ;
"RTN","RAHBIN2",107,0)
 ;Now loop thru HLARY & determine type of text and call correct tag
"RTN","RAHBIN2",108,0)
 ;
"RTN","RAHBIN2",109,0)
 K OCXCNT,PRIDGC
"RTN","RAHBIN2",110,0)
 S (PRIDGC,PRIFLG)=0
"RTN","RAHBIN2",111,0)
 F OBXCNT=0:0 S OBXCNT=$O(HLARY("OBX",OBXCNT)) Q:'OBXCNT  D
"RTN","RAHBIN2",112,0)
 . S X=HLARY("OBX",OBXCNT)
"RTN","RAHBIN2",113,0)
 . I $P(X,RD1,3)["TECH" S RADARRY("TECH")=$P(X,RD1,5) Q
"RTN","RAHBIN2",114,0)
 . I $P(X,RD1,3)["MODIFIERS" D OBXMOD Q
"RTN","RAHBIN2",115,0)
 . I $P(X,RD1,3)["DIAGNOSTIC" D OBXDGN Q
"RTN","RAHBIN2",116,0)
 . I $P(X,RD1,3)["REPORT" D OBXRPT Q
"RTN","RAHBIN2",117,0)
 . I $P(X,RD1,3)["HISTORY" D OBXHST Q
"RTN","RAHBIN2",118,0)
 . I $P(X,RD1,3)["IMPRESSION" D OBXIMP Q
"RTN","RAHBIN2",119,0)
 ;
"RTN","RAHBIN2",120,0)
 ;4839:
"RTN","RAHBIN2",121,0)
 ;determine the last update sent (RAAM) just sent via DOD HL7 msg
"RTN","RAHBIN2",122,0)
 ;as DOD sends ALL text, the orig text + all amendments to date.
"RTN","RAHBIN2",123,0)
 ;  RAAM=1 is an orig final report, 2 or more are amendments
"RTN","RAHBIN2",124,0)
 ;
"RTN","RAHBIN2",125,0)
 I $D(WPRT) S RATMP=$O(WPRT(999),-1) S:RATMP>RAAM RAAM=RATMP
"RTN","RAHBIN2",126,0)
 I $D(WPIT) S RATMP=$O(WPIT(999),-1) S:RATMP>RAAM RAAM=RATMP
"RTN","RAHBIN2",127,0)
 I $D(WPACH) S RATMP=$O(WPACH(999),-1) S:RATMP>RAAM RAAM=RATMP
"RTN","RAHBIN2",128,0)
 ;
"RTN","RAHBIN2",129,0)
 ;now init report & imp text arrays only if they had amended text
"RTN","RAHBIN2",130,0)
 ;that was just sent, else kill that specific array to stop its update
"RTN","RAHBIN2",131,0)
 I $D(WPRT(RAAM)) M TMP=WPRT(RAAM) K WPRT M WPRT=TMP K TMP
"RTN","RAHBIN2",132,0)
 E  K WPRT
"RTN","RAHBIN2",133,0)
 I $D(WPIT(RAAM)) M TMP=WPIT(RAAM) K WPIT M WPIT=TMP K TMP
"RTN","RAHBIN2",134,0)
 E  K WPIT
"RTN","RAHBIN2",135,0)
 I $D(WPACH(RAAM)) M TMP=WPACH(RAAM) K WPACH M WPACH=TMP K TMP
"RTN","RAHBIN2",136,0)
 E  K WPACH
"RTN","RAHBIN2",137,0)
 Q
"RTN","RAHBIN2",138,0)
 ;====================================================================
"RTN","RAHBIN2",139,0)
 ;
"RTN","RAHBIN2",140,0)
PROXY(VAL,VAL1) ;
"RTN","RAHBIN2",141,0)
 S VAL1="PROXY,PROVIDER"
"RTN","RAHBIN2",142,0)
 I $D(^VA(200,"B",VAL1)) S VAL="",VAL=$O(^VA(200,"B",VAL1,VAL))
"RTN","RAHBIN2",143,0)
 I '$D(^VA(200,"B",VAL1)) S VAL=0
"RTN","RAHBIN2",144,0)
 Q
"RTN","RAHBIN2",145,0)
 ;
"RTN","RAHBIN2",146,0)
OBXMOD ; PROCEDURE MODIFIERS
"RTN","RAHBIN2",147,0)
 B
"RTN","RAHBIN2",148,0)
 S CNT=1
"RTN","RAHBIN2",149,0)
 I $D(PMOD) S CNT=999,CNT=$O(PMOD(CNT),-1),CNT=CNT+1
"RTN","RAHBIN2",150,0)
 S PMOD(CNT)=$P(X,RD1,5)
"RTN","RAHBIN2",151,0)
 S RAAM=$G(RAAM)+1
"RTN","RAHBIN2",152,0)
 S (RCNT,HCNT,ICNT)=1
"RTN","RAHBIN2",153,0)
 Q
"RTN","RAHBIN2",154,0)
 ;
"RTN","RAHBIN2",155,0)
OBXDGN ; DIAGNOSIC CODE always Precedes the Report text. also contains diagnosis
"RTN","RAHBIN2",156,0)
 ;
"RTN","RAHBIN2",157,0)
 S AMENDED=$S($P(X,RD1,11)="C":1,1:0)
"RTN","RAHBIN2",158,0)
 I PRIFLG D
"RTN","RAHBIN2",159,0)
 .I $D(SECDGC) S CNT=99,CNT=$O(SECDGC(CNT),-1),CNT=CNT+1,SECDGC(CNT)=+$P(X,RD1,5)
"RTN","RAHBIN2",160,0)
 .I '$D(SECDGC) S CNT=1,SECDGC(CNT)=+$P(X,RD1,5)
"RTN","RAHBIN2",161,0)
 I 'PRIFLG S PRIDGC=+$P(X,RD1,5),PRIFLG=1
"RTN","RAHBIN2",162,0)
 ;increment Amendments,1 = ORIG, 2 - n = Amendments
"RTN","RAHBIN2",163,0)
 S RAAM=RAAM+1
"RTN","RAHBIN2",164,0)
 ;re-init when RESCODE happens, covers each OBX result so orig result
"RTN","RAHBIN2",165,0)
 ;and multiple amendment results kept separate.
"RTN","RAHBIN2",166,0)
 S (RCNT,HCNT,ICNT)=1
"RTN","RAHBIN2",167,0)
 Q
"RTN","RAHBIN2",168,0)
 ;
"RTN","RAHBIN2",169,0)
OBXRPT ; report text
"RTN","RAHBIN2",170,0)
 I $P(X,RD1,3)'["REPORT" Q
"RTN","RAHBIN2",171,0)
 I '$D(WPRT) S RAAM=1
"RTN","RAHBIN2",172,0)
 I $D(WPRT) S RAAM=99999,RAAM=$O(WPRT(RAAM),-1)
"RTN","RAHBIN2",173,0)
 ;I $G(VRFPHY)="" S VRFPHY=REQPRV
"RTN","RAHBIN2",174,0)
 S WPRT(RAAM,"WP",RCNT)=$P(X,RD1,5)
"RTN","RAHBIN2",175,0)
 S RCNT=RCNT+1 
"RTN","RAHBIN2",176,0)
 Q
"RTN","RAHBIN2",177,0)
 ;
"RTN","RAHBIN2",178,0)
OBXIMP ; impression text
"RTN","RAHBIN2",179,0)
 I $P(X,RD1,3)'["IMPRESSION" Q
"RTN","RAHBIN2",180,0)
 S TXT=$P(X,RD1,5)
"RTN","RAHBIN2",181,0)
 S SKIP=0
"RTN","RAHBIN2",182,0)
 I ICNT=1 D
"RTN","RAHBIN2",183,0)
 . S DELIM=$S(TXT["IMPRESSION:":"IMPRESSION:",TXT["Impression:":"Impression:",1:"")
"RTN","RAHBIN2",184,0)
 . I DELIM]"" S TXT=$P(TXT,DELIM,2) I $E(TXT,1)=" " S TXT=$E(TXT,2,999)
"RTN","RAHBIN2",185,0)
 . S:TXT="" SKIP=1    ;skip hdr only line
"RTN","RAHBIN2",186,0)
 Q:SKIP
"RTN","RAHBIN2",187,0)
 I '$D(WPIT) S RAAM=1
"RTN","RAHBIN2",188,0)
 I $D(WPIT) S RAAM=99999,RAAM=$O(WPIT(RAAM),-1)
"RTN","RAHBIN2",189,0)
 S WPIT(RAAM,"WP",ICNT)=TXT
"RTN","RAHBIN2",190,0)
 S ICNT=ICNT+1
"RTN","RAHBIN2",191,0)
 Q 
"RTN","RAHBIN2",192,0)
 ;
"RTN","RAHBIN2",193,0)
OBXHST ; additional clinical history text
"RTN","RAHBIN2",194,0)
 I $P(X,RD1,3)'["HISTORY" Q
"RTN","RAHBIN2",195,0)
 I '$D(WPACH) S RAAM=1
"RTN","RAHBIN2",196,0)
 I $D(WPACH) S RAAM=99999,RAAM=$O(WPACH(RAAM),-1)
"RTN","RAHBIN2",197,0)
 S WPACH(RAAM,"WP",HCNT)=$P(X,RD1,5)
"RTN","RAHBIN2",198,0)
 S HCNT=HCNT+1
"RTN","RAHBIN2",199,0)
 Q
"RTN","RAHBIN2",200,0)
 ;
"RTN","RAHBIN2",201,0)
 ;=======================================================
"RTN","RAHBIN2",202,0)
VARS ; check variables for HL7 -- generate varibles
"RTN","RAHBIN2",203,0)
 N X13
"RTN","RAHBIN2",204,0)
 K IMGTYP,RADFN,RAOIEN
"RTN","RAHBIN2",205,0)
 S IMGTYP=""
"RTN","RAHBIN2",206,0)
 ;S RAOIEN=+$G(^OR(100,ORIEN,4)) ; pointer to RAO(75.1 
"RTN","RAHBIN2",207,0)
 ;BL;IA compliance change
"RTN","RAHBIN2",208,0)
 S RAOIEN=$$GET1^DIQ(100,ORIEN,33,"I")
"RTN","RAHBIN2",209,0)
 I $G(RAOIEN)'>0 S LROK=0,RAOROUT(1)="-1^NO RADIOLOGY ORDER NUMBER FOUND",MSG="ERR^NO RADIOLOGY ORDER NUMBER FOUND" D ERR Q
"RTN","RAHBIN2",210,0)
 S IMGTYP=$P($G(^RAMIS(71,PROC,0)),"^",12)
"RTN","RAHBIN2",211,0)
 ;BL;IA compliance change
"RTN","RAHBIN2",212,0)
 S RADFN=DFN
"RTN","RAHBIN2",213,0)
 I '$G(RADTE) S RADTE=$P(^RADPT(DFN,"DT",RADTI,0),"^")
"RTN","RAHBIN2",214,0)
 I '$G(CASE) D SCASE
"RTN","RAHBIN2",215,0)
 I '$G(LCASE) S LCASE=$E(RADTE,4,5)_$E(RADTE,6,7)_$E(RADTE,2,3)_"-"_CASE
"RTN","RAHBIN2",216,0)
 ;  check pregnancy flag precedence: Y>U>N>"" ; rhl 20100927
"RTN","RAHBIN2",217,0)
 ;BL;IA compliance change
"RTN","RAHBIN2",218,0)
 I SEX="F" D
"RTN","RAHBIN2",219,0)
 .S X13=$$GET1^DIQ(75.1,RAOIEN,13,"I")
"RTN","RAHBIN2",220,0)
 .I PRGFLG="",X13="" S PRGFLG="u"
"RTN","RAHBIN2",221,0)
 .I PRGFLG="",X13'="" S PRGFLG=X13
"RTN","RAHBIN2",222,0)
 ;
"RTN","RAHBIN2",223,0)
 Q
"RTN","RAHBIN2",224,0)
 ;=========================================================
"RTN","RAHBIN2",225,0)
CHK1 ; check for result variables
"RTN","RAHBIN2",226,0)
 ; check patient DFN & SSN
"RTN","RAHBIN2",227,0)
 ; verify providers
"RTN","RAHBIN2",228,0)
 ; check providers: REQPRV, PRISTF, TRNSCP
"RTN","RAHBIN2",229,0)
 K I,LROK,MSG,TCNT,CHKLOC,CHKPROC,CHKPRIDGC
"RTN","RAHBIN2",230,0)
 S CHKLOC="",CHKPROC="",CHKPRIDGC=""
"RTN","RAHBIN2",231,0)
 S TCNT=RACNT
"RTN","RAHBIN2",232,0)
 S I="",LROK=1,MSG=""
"RTN","RAHBIN2",233,0)
 I $G(PRISTF)="" S PRISTF=0
"RTN","RAHBIN2",234,0)
 F I="REQPRV","TRNSCP","IMGLOC" S:@I=0 @I=""
"RTN","RAHBIN2",235,0)
 F I="DFN","PROC","REQPRV","REQDT","PRISTF","EXMDT","RPTSTA","RPTDT","VRFDT","PRIDGC" D  ;
"RTN","RAHBIN2",236,0)
 . Q:@I'=""
"RTN","RAHBIN2",237,0)
 . S RACNT=RACNT+1
"RTN","RAHBIN2",238,0)
 . S RAOROUT(RACNT)="ERR^REQUIRED FIELD NOT DEFINED "_I
"RTN","RAHBIN2",239,0)
 . S LROK=0
"RTN","RAHBIN2",240,0)
 Q:'LROK
"RTN","RAHBIN2",241,0)
 S RACNT=1
"RTN","RAHBIN2",242,0)
 ;
"RTN","RAHBIN2",243,0)
 I $G(IMGLOC)="" S MSG="ERR^NO IMAGE LOCATION SPECIFIED " D ERR Q
"RTN","RAHBIN2",244,0)
 I $$GET1^DIQ(2,DFN_",",.01,"I")="" S MSG="ERR^DFN "_DFN_" NOT IN PATIENT FILE " D ERR Q
"RTN","RAHBIN2",245,0)
 ;Use fileman calls to check for global references (removing $D)
"RTN","RAHBIN2",246,0)
 S CHKLOC=$$GET1^DIQ(79.1,IMGLOC,.01,"I")
"RTN","RAHBIN2",247,0)
 S CHKPROC=$$GET1^DIQ(71,PROC,.01,"I")
"RTN","RAHBIN2",248,0)
 S CHKPRIDGC=$$GET1^DIQ(78.3,PRIDGC,.01,"I")
"RTN","RAHBIN2",249,0)
 I '$D(CHKLOC) S MSG="ERR^IMAGE LOCATION "_IMGLOC_" NOT IN IMG LOCATION FILE " D ERR Q
"RTN","RAHBIN2",250,0)
 I '$D(CHKPROC) S MSG="ERR^PROCEDURE "_PROC_" NOT IN RAD PROC FILE " D ERR Q
"RTN","RAHBIN2",251,0)
 ;I $$GET1^DIQ(200,REQPRV_",",.01,"I")="" S MSG="ERR^REQUESTING PROVIDER "_REQPRV_" NOT IN NEW PERSON FILE " D ERR Q
"RTN","RAHBIN2",252,0)
 ;I $$GET1^DIQ(200,PRISTF_",",.01,"I")="" S MSG="ERR^REQUESTING PROVIDER "_REQPRV_" NOT IN NEW PERSON FILE " D ERR Q
"RTN","RAHBIN2",253,0)
 ;I '$D(CHKPRIDGC) S MSG="ERR^PRIMARY DIAGNOSIS "_PRIDGC_" NOT IN RAD DIAGNOSIS FILE " D ERR Q
"RTN","RAHBIN2",254,0)
 S RACNT=TCNT
"RTN","RAHBIN2",255,0)
 ;
"RTN","RAHBIN2",256,0)
 Q
"RTN","RAHBIN2",257,0)
 ;
"RTN","RAHBIN2",258,0)
CHK2 ; check for registration variables
"RTN","RAHBIN2",259,0)
 ; check patient DFN & SSN
"RTN","RAHBIN2",260,0)
 ; verify providers
"RTN","RAHBIN2",261,0)
 ; check providers: REQPRV
"RTN","RAHBIN2",262,0)
 K CHKLOC,CHKPROC
"RTN","RAHBIN2",263,0)
 S CHKLOC="",CHKPROC=""
"RTN","RAHBIN2",264,0)
 S I="",LROK=1
"RTN","RAHBIN2",265,0)
 I $G(REQDT)>0 S EXMDT=REQDT
"RTN","RAHBIN2",266,0)
 I $G(PRISTF)="" S PRISTF=0
"RTN","RAHBIN2",267,0)
 F I="REQPRV","TRNSCP","IMGLOC" S:@I=0 @I=""
"RTN","RAHBIN2",268,0)
 F I="DFN","PROC","REQPRV","REQDT","EXMDT" D  ;
"RTN","RAHBIN2",269,0)
 . Q:@I'=""
"RTN","RAHBIN2",270,0)
 . S RACNT=RACNT+1,RAOROUT(RACNT)="ERR^REQUIRED FIELD NOT DEFINED "_I,LROK=0
"RTN","RAHBIN2",271,0)
 Q:'LROK
"RTN","RAHBIN2",272,0)
 ;
"RTN","RAHBIN2",273,0)
 I $$GET1^DIQ(2,DFN_",",.01,"I")="" S MSG="ERR^DFN "_DFN_" NOT IN PATIENT FILE " D ERR Q
"RTN","RAHBIN2",274,0)
 S CHKLOC=$$GET1^DIQ(79.1,IMGLOC,.01,"I")
"RTN","RAHBIN2",275,0)
 S CHKPROC=$$GET1^DIQ(71,PROC,.01,"I")
"RTN","RAHBIN2",276,0)
 I $G(IMGLOC),'$D(CHKLOC) S MSG="ERR^IMAGE LOCATION "_IMGLOC_" NOT IN IMG LOCATION FILE " D ERR Q
"RTN","RAHBIN2",277,0)
 I '$D(CHKPROC) S MSG="ERR^PROCEDURE "_PROC_" NOT IN RAD PROC FILE " D ERR Q
"RTN","RAHBIN2",278,0)
 I $$GET1^DIQ(200,REQPRV_",",.01,"I")="" S MSG="ERR^REQUESTING PROVIDER "_REQPRV_" NOT IN NEW PERSON FILE " D ERR Q
"RTN","RAHBIN2",279,0)
 ;
"RTN","RAHBIN2",280,0)
 Q
"RTN","RAHBIN2",281,0)
 ;
"RTN","RAHBIN2",282,0)
SRADTI ; get RADTE & RADTI
"RTN","RAHBIN2",283,0)
 ; input EXAMDT, Exam Date/Time in HL7 format
"RTN","RAHBIN2",284,0)
 K RADTE,RADTI
"RTN","RAHBIN2",285,0)
 S RADTE=EXMDT
"RTN","RAHBIN2",286,0)
 ; RADTI is 9's complement of FM Internal D/T and used as 3rd subscript in 70.02, 70.03, etc.
"RTN","RAHBIN2",287,0)
 S RADTI=9999999.9999-RADTE ; ^RADPT(RADFN,"DT",RADTI, . . .
"RTN","RAHBIN2",288,0)
 ;BL;Adding code to ensure only 1 test per RADTI;JIRA 1822
"RTN","RAHBIN2",289,0)
 ;check for existing RADTI
"RTN","RAHBIN2",290,0)
CKRADTI ;begin loop for RADTI check (need a new RADTI)
"RTN","RAHBIN2",291,0)
 K CHKRADTI
"RTN","RAHBIN2",292,0)
 S CHKRADTI=$$GET1^DIQ(70.02,RADTI_","_DFN,.01,"I")
"RTN","RAHBIN2",293,0)
 I CHKRADTI'="" D INCTI
"RTN","RAHBIN2",294,0)
 Q
"RTN","RAHBIN2",295,0)
INCTI ;RADTI exists increment X2 
"RTN","RAHBIN2",296,0)
 S RADTE=$$FMADD^XLFDT(RADTE,,,+1)
"RTN","RAHBIN2",297,0)
 S RADTI=9999999.9999-RADTE
"RTN","RAHBIN2",298,0)
 D CKRADTI
"RTN","RAHBIN2",299,0)
 Q
"RTN","RAHBIN2",300,0)
SCASE ; get case#
"RTN","RAHBIN2",301,0)
 ; RADTE & RADTI must be defined.
"RTN","RAHBIN2",302,0)
 N RATYPE,RASET,RAX
"RTN","RAHBIN2",303,0)
 S RATYPE=1,RASET=0
"RTN","RAHBIN2",304,0)
 K CASE,LCASE
"RTN","RAHBIN2",305,0)
 S CASE="",LCASE=""
"RTN","RAHBIN2",306,0)
 D CN^RAREG1 ; create Case#  ;  need agreement
"RTN","RAHBIN2",307,0)
 ;5265 - build temp Case# xref that the API, CN^RAREG1, uses to get
"RTN","RAHBIN2",308,0)
 ;       the next available Case number. Both ORP & Legacy use this.
"RTN","RAHBIN2",309,0)
 ;       Further down in our process, RAHBIN2, files are stored, which
"RTN","RAHBIN2",310,0)
 ;       includes creating the real AE xref.  Then kill temp xref.
"RTN","RAHBIN2",311,0)
 S ^RADPT("AE",X,$J)=""       ;temp xref  5265
"RTN","RAHBIN2",312,0)
 S CASE=X
"RTN","RAHBIN2",313,0)
 ;
"RTN","RAHBIN2",314,0)
 S LCASE=$E(RADTE,4,5)_$E(RADTE,6,7)_$E(RADTE,2,3)_"-"_CASE
"RTN","RAHBIN2",315,0)
 I $D(^RADPT("ADC",LCASE)) S LROK=0,RAOROUT(1)="-1^CASE NUMBER ALREADY IN USE"
"RTN","RAHBIN2",316,0)
 Q
"RTN","RAHBIN2",317,0)
HLD(XD) ; convert HL7 date to FM date
"RTN","RAHBIN2",318,0)
 Q:$G(XD)="" ""
"RTN","RAHBIN2",319,0)
 Q $$HL7TFM^XLFDT(XD)
"RTN","RAHBIN2",320,0)
 ;
"RTN","RAHBIN2",321,0)
ERR ;
"RTN","RAHBIN2",322,0)
 S RACNT=RACNT+1,RAOROUT(RACNT)="ERR^"_MSG,LROK=0
"RTN","RAHBIN2",323,0)
 Q
"RTN","RAHBIN2",324,0)
GETSTA(PROC,STATUS) ; get status (EXSTAT) for RADPT ; rhl 20100929 - new subrtn
"RTN","RAHBIN2",325,0)
 N IMGTYP,XIEN,X7,XSTAT
"RTN","RAHBIN2",326,0)
 S EXMSTA=""
"RTN","RAHBIN2",327,0)
 ;BL;IA compliance change
"RTN","RAHBIN2",328,0)
 S IMGTYP=$$GET1^DIQ(71,PROC,12,"I") I IMGTYP="" Q ""
"RTN","RAHBIN2",329,0)
 ;
"RTN","RAHBIN2",330,0)
 S XSTAT=""
"RTN","RAHBIN2",331,0)
 F  S XSTAT=$O(^RA(72,"B",XSTAT)) Q:XSTAT=""  D  Q:EXMSTA
"RTN","RAHBIN2",332,0)
 . Q:XSTAT'[STATUS
"RTN","RAHBIN2",333,0)
 . S XIEN=0 FOR  S XIEN=$O(^RA(72,"B",STATUS,XIEN)) Q:'XIEN  D  Q:EXMSTA
"RTN","RAHBIN2",334,0)
 . . ;BL;IA compliance change
"RTN","RAHBIN2",335,0)
 . . S X7=$$GET1^DIQ(72,XIEN,7,"I")
"RTN","RAHBIN2",336,0)
 . . I X7=IMGTYP S EXMSTA=XIEN
"RTN","RAHBIN2",337,0)
 ;
"RTN","RAHBIN2",338,0)
 Q EXMSTA
"RTN","RAHBIN2",339,0)
 ;
"RTN","RAHBIN2",340,0)
ENDQ ;
"RTN","RAHBIN2",341,0)
 K NWSTATUS,EXSTAT,HLARY,WPACH,WPRT,WRPT
"RTN","RAHBIN2",342,0)
 Q
"RTN","RAHBIN3")
0^13^B207308557
"RTN","RAHBIN3",1,0)
RAHBIN3 ;LEIDOS/TCK- Remote Ordering - Radiology - Filer ; 9/5/16 1:06pm
"RTN","RAHBIN3",2,0)
 ;;1.0;Radiology Orders Portability;;March 1, 2016;Build 19
"RTN","RAHBIN3",3,0)
 ; Reference to ^RADPT( supported by IA #5602
"RTN","RAHBIN3",4,0)
 ; Reference to NOW^%DTC supported by IA #10000
"RTN","RAHBIN3",5,0)
 ; Reference to ^RAO(75.1 supported by IA #5604
"RTN","RAHBIN3",6,0)
 ; Reference to ^OR(100 supported by IA #5196
"RTN","RAHBIN3",7,0)
 ; Reference to GETDLG^ORCD supported by IA #5493
"RTN","RAHBIN3",8,0)
 ; Reference to ^RARPT(74 supported by IA #5605
"RTN","RAHBIN3",9,0)
 ; Reference to NOW^XLFDT supported by IA #10103
"RTN","RAHBIN3",10,0)
 ; Reference to X7005^RADD3 supported by IA #5661
"RTN","RAHBIN3",11,0)
 ; Reference to FIELD^DID supported by IA #2052
"RTN","RAHBIN3",12,0)
 ;
"RTN","RAHBIN3",13,0)
 ; updated:  20100908
"RTN","RAHBIN3",14,0)
 ; 4839 - changed Amended Impression & Report text label hdrs.
"RTN","RAHBIN3",15,0)
 ;        added 3 subhdr lines. File into subfile 74.06 old
"RTN","RAHBIN3",16,0)
 ;        text data to trigger the AMENDED report headings.
"RTN","RAHBIN3",17,0)
 ; 4833 - Encrypted Esig now saved, defined as Verifing Doctor.
"RTN","RAHBIN3",18,0)
 ; 4076 - init Principal Clinic from Requesting Loc
"RTN","RAHBIN3",19,0)
 ; 5329 - Send Abnormal diag Provider Alert, if needed
"RTN","RAHBIN3",20,0)
 Q
"RTN","RAHBIN3",21,0)
 ;
"RTN","RAHBIN3",22,0)
 ; NOTES:
"RTN","RAHBIN3",23,0)
 ; RADTE = Examination date/time in FM format truncated to maximum of 4 decimal places.
"RTN","RAHBIN3",24,0)
 ; RADTI = 9'S complement of RADTE (9999999.9999-RADTE) used as subscript in ^RADPT( to force chronological order.
"RTN","RAHBIN3",25,0)
 ; CASE = case# a 'Unique' number given to an exam when it is registered (generated by CN^RAREG1) ; AKA short case#
"RTN","RAHBIN3",26,0)
 ; LCASE = long case# ; LCASE=$E(RADTE,4,5)_$E(RADTE,6,7)_$E(RADTE,2,3)_"-"_CASE
"RTN","RAHBIN3",27,0)
 ;
"RTN","RAHBIN3",28,0)
 ;      3 files are affected by Radiology Registration and Resulting:
"RTN","RAHBIN3",29,0)
 ; ^RADPT(     #70    -- RAD/NUC MED PATIENT FILE
"RTN","RAHBIN3",30,0)
 ; ^RARPT(     #74    -- RAD/NUC MED REPORTS FILE
"RTN","RAHBIN3",31,0)
 ; ^RAO(75.1   #75.1  -- RAD/NUC MED ORDERS FILE
"RTN","RAHBIN3",32,0)
 ;
"RTN","RAHBIN3",33,0)
 ;====================================================================
"RTN","RAHBIN3",34,0)
EN ;
"RTN","RAHBIN3",35,0)
 ;
"RTN","RAHBIN3",36,0)
 ;
"RTN","RAHBIN3",37,0)
 Q
"RTN","RAHBIN3",38,0)
PAT(RADARRY) ; create patient entry in RADPT
"RTN","RAHBIN3",39,0)
 K DR,DA,DIE,LROK,DLAYGO
"RTN","RAHBIN3",40,0)
 I $G(RADFN)'>0,$G(DFN)>0 S RADFN=DFN
"RTN","RAHBIN3",41,0)
 S LROK=1
"RTN","RAHBIN3",42,0)
 Q:$D(^RADPT(RADFN))
"RTN","RAHBIN3",43,0)
 N X,Y,DINUM,DIC,DLAYGO
"RTN","RAHBIN3",44,0)
 ;
"RTN","RAHBIN3",45,0)
 S LROK=1
"RTN","RAHBIN3",46,0)
 S X=RADFN,DINUM=RADFN,DIC(0)="L",DIC="^RADPT(",DLAYGO=2
"RTN","RAHBIN3",47,0)
 K RADFN
"RTN","RAHBIN3",48,0)
 S RADFN=X
"RTN","RAHBIN3",49,0)
 D FILE^DICN
"RTN","RAHBIN3",50,0)
 I RADFN'=+Y S LROK=0,RAOROUT(1)="-1^COULD NOT CREATE RECORD IN RADPT" Q
"RTN","RAHBIN3",51,0)
 ;
"RTN","RAHBIN3",52,0)
 S DR=".06////"_DUZ
"RTN","RAHBIN3",53,0)
 S DA=RADFN,DIE=70 K Y D ^DIE
"RTN","RAHBIN3",54,0)
 ;
"RTN","RAHBIN3",55,0)
 Q
"RTN","RAHBIN3",56,0)
 ;========================================================== 
"RTN","RAHBIN3",57,0)
REG(RADARRY) ; register exam in RADPT (#70)  & RAO(75.1  (#75.1)
"RTN","RAHBIN3",58,0)
 ; Input:
"RTN","RAHBIN3",59,0)
 ;
"RTN","RAHBIN3",60,0)
 N RADFDA,RAIEN,ERRMSG,NOW,REQSTA,RAONWSTA,%,DT1
"RTN","RAHBIN3",61,0)
 D NOW^%DTC S NOW=%
"RTN","RAHBIN3",62,0)
 S RADARRY("REQSTA")=6,RADARRY("RAONWSTA")="6"
"RTN","RAHBIN3",63,0)
 ;
"RTN","RAHBIN3",64,0)
 ;    file #70.02:    Registered Exams
"RTN","RAHBIN3",65,0)
 S DT1=RADTI
"RTN","RAHBIN3",66,0)
 K DFN
"RTN","RAHBIN3",67,0)
 S DFN=RADFN
"RTN","RAHBIN3",68,0)
 S RAIEN(1)=DT1
"RTN","RAHBIN3",69,0)
 S RADFDA(70.02,"+1,"_RADFN_",",.01)=RADTE      ; exam date/time
"RTN","RAHBIN3",70,0)
 S RADFDA(70.02,"+1,"_RADFN_",",2)=RADARRY("IMGTYP")   ; type of image=>79.2
"RTN","RAHBIN3",71,0)
 S RADFDA(70.02,"+1,"_RADFN_",",3)=RADARRY("HOSDIV")   ; hospital division=>79
"RTN","RAHBIN3",72,0)
 S RADFDA(70.02,"+1,"_RADFN_",",4)=RADARRY("IMGLOC")   ; imaging location=>79.1
"RTN","RAHBIN3",73,0)
 ;
"RTN","RAHBIN3",74,0)
 D UPDATE^DIE("S","RADFDA","RAIEN","ERRMSG")
"RTN","RAHBIN3",75,0)
 I $G(DIERR) D ERR
"RTN","RAHBIN3",76,0)
 ;    file #70.03:    Examinations
"RTN","RAHBIN3",77,0)
 K RADFDA,ERRMSG
"RTN","RAHBIN3",78,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",.01)=RADARRY("CASE")   ; case#
"RTN","RAHBIN3",79,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",2)=RADARRY("PROC")     ; procedure=>71
"RTN","RAHBIN3",80,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",3)=RADARRY("EXSTAT")   ; exam status=>72
"RTN","RAHBIN3",81,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",4)=RADARRY("EXCAT")    ; category of exam:codes
"RTN","RAHBIN3",82,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",6)=RADARRY("WARD")     ; ward=>42
"RTN","RAHBIN3",83,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",7)=RADARRY("SERVC")    ; service=>49
"RTN","RAHBIN3",84,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",8)=RADARRY("REQLOC")  ;4076 dupe in Reqloc ptr=>44
"RTN","RAHBIN3",85,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",11)=RADARRY("RAOIEN")  ; imaging order=>75.1
"RTN","RAHBIN3",86,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",14)=RADARRY("REQPRV")  ; requesting provider=>200
"RTN","RAHBIN3",87,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",19)=RADARRY("BED")     ; bedsection=>42.4
"RTN","RAHBIN3",88,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",21)=RADARRY("REQDT")   ; request date
"RTN","RAHBIN3",89,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",22)=RADARRY("REQLOC")  ; request location=>44
"RTN","RAHBIN3",90,0)
 S RADFDA(70.03,"+2,"_RADTI_","_RADFN_",",26)=RADARRY("CRDMTH")  ; credit method: codes
"RTN","RAHBIN3",91,0)
 ;
"RTN","RAHBIN3",92,0)
 D UPDATE^DIE("S","RADFDA","","ERRMSG")
"RTN","RAHBIN3",93,0)
 I $G(DIERR) D ERR
"RTN","RAHBIN3",94,0)
 ;
"RTN","RAHBIN3",95,0)
 ;   get DA2
"RTN","RAHBIN3",96,0)
 N RAOIEN S RAOIEN=RADARRY("RAOIEN") ; 20110329
"RTN","RAHBIN3",97,0)
 N DA2,FOUND S FOUND=0 ; 20110329
"RTN","RAHBIN3",98,0)
 S DA2=0,DA2=$O(^RADPT(RADFN,"DT",RADTI,"P",DA2)) Q:FOUND  ; 20110329
"RTN","RAHBIN3",99,0)
 Q:'DA2
"RTN","RAHBIN3",100,0)
 I $P(^RADPT(RADFN,"DT",RADTI,"P",DA2,0),"^",11)=RAOIEN S FOUND=1 ; 20110329
"RTN","RAHBIN3",101,0)
 I 'FOUND S DA2=0 ; 20110329
"RTN","RAHBIN3",102,0)
 ;
"RTN","RAHBIN3",103,0)
 ;Need to update 70.05 exam status change history
"RTN","RAHBIN3",104,0)
 I $G(DA2) D  ; 20110329
"RTN","RAHBIN3",105,0)
 . K RADFDA,ERRMSG
"RTN","RAHBIN3",106,0)
 . ;D A7007^RADD3(RADFN,RADTI,DA2,RADARRY("DUZ"),$G(RADARRY("TECH")))
"RTN","RAHBIN3",107,0)
 . S RADFDA(70.07,"+1,"_DA2_","_RADTI_","_RADFN_",",.01)=$$NOW^XLFDT
"RTN","RAHBIN3",108,0)
 . S RADFDA(70.07,"+1,"_DA2_","_RADTI_","_RADFN_",",2)="E"
"RTN","RAHBIN3",109,0)
 . S RADFDA(70.07,"+1,"_DA2_","_RADTI_","_RADFN_",",3)=$G(RADARRY("DUZ"))
"RTN","RAHBIN3",110,0)
 . S RADFDA(70.07,"+1,"_DA2_","_RADTI_","_RADFN_",",4)=$G(RADARRY("TECH"))
"RTN","RAHBIN3",111,0)
 . D UPDATE^DIE("S","RADFDA","","ERRMSG") K RADFDA,ERRMSG
"RTN","RAHBIN3",112,0)
 . S EXSTAT=RADARRY("EXSTAT")
"RTN","RAHBIN3",113,0)
 . D X7005^RADD3(RADFN,RADTI,DA2,1,"",EXSTAT,RADARRY("DUZ"))
"RTN","RAHBIN3",114,0)
 . ;S RAIENS="+1,"_DA2_","_RADTI_","_RADFN_","
"RTN","RAHBIN3",115,0)
 . ;S RADFDA(70.05,RAIENS,.01)=$$MIDNGHT^RAUTL5($$NOW^XLFDT()) ; 20110329
"RTN","RAHBIN3",116,0)
 . ;D UPDATE^DIE(,"RADFDA","RAIENS","ERRMSG")
"RTN","RAHBIN3",117,0)
 . ;S RAIENS="+1,"_DA2_","_RADTI_","_RADFN_","
"RTN","RAHBIN3",118,0)
 . ;S RADFDA(70.05,RAIENS,2)=EXSTAT ; 20110329
"RTN","RAHBIN3",119,0)
 . ;S RADFDA(70.05,RAIENS,3)=RADARRY("DUZ") ; 20110329
"RTN","RAHBIN3",120,0)
 . ;D UPDATE^DIE(,"RADFDA","RAIENS","ERRMSG") K RADFDA,ERRMSG
"RTN","RAHBIN3",121,0)
 . ;D UPDATE^DIE("S","RADFDA","","ERRMSG") K RADFDA,ERRMSG
"RTN","RAHBIN3",122,0)
 . I $D(PMOD) D FLEMOD(.PMOD)
"RTN","RAHBIN3",123,0)
 . I $G(DIERR) D ERR
"RTN","RAHBIN3",124,0)
 ;    log activity in RAO(75.1
"RTN","RAHBIN3",125,0)
 K RADFDA,ERRMSG
"RTN","RAHBIN3",126,0)
 S RADFDA(75.1,RAOIEN_",",5)=RADARRY("REQSTA")      ; request status:codes
"RTN","RAHBIN3",127,0)
 I SEX="F" S RADFDA(75.1,RAOIEN_",",13)=RADARRY("PRGFLG")     ; preg flag ; rhl 20100927
"RTN","RAHBIN3",128,0)
 S RADFDA(75.1,RAOIEN_",",18)=RADARRY("NOW")     ; last activity d/t
"RTN","RAHBIN3",129,0)
 S RADFDA(75.12,"+1,"_RAOIEN_",",.01)=RADARRY("NOW")   ; status change d/t
"RTN","RAHBIN3",130,0)
 S RADFDA(75.12,"+1,"_RAOIEN_",",2)=RADARRY("RAONWSTA")    ; new status:codes
"RTN","RAHBIN3",131,0)
 ;S RADFDA(75.12,"+1,"_RAOIEN_",",3)=RADARRY("VRFPHY")  ; computer user=>200
"RTN","RAHBIN3",132,0)
 ;
"RTN","RAHBIN3",133,0)
 D UPDATE^DIE("S","RADFDA","","ERRMSG")
"RTN","RAHBIN3",134,0)
 I $G(DIERR) D ERR
"RTN","RAHBIN3",135,0)
 ;
"RTN","RAHBIN3",136,0)
 ;Pregnancy update in 100 file 4.5 node (Dialogue)
"RTN","RAHBIN3",137,0)
 ;convert from lower case to upper case
"RTN","RAHBIN3",138,0)
 ;First check to see if Rad status is set in OR(100 file
"RTN","RAHBIN3",139,0)
 K PRGSEQ,PRGDONE,LSTSEQ,PRGSEQ,LSTSEQ,PRGTEXT1,PRGTEXT2,PRGTEXT
"RTN","RAHBIN3",140,0)
 S PRGSEQ=5,PRGDONE=0  ;Never going to have less than a 6 for pregnancy sequence
"RTN","RAHBIN3",141,0)
 S ORIEN=$G(RADARRY("ORIEN"))
"RTN","RAHBIN3",142,0)
 I $G(SEX)="F" D
"RTN","RAHBIN3",143,0)
 . F  S PRGSEQ=$O(^OR(100,ORIEN,4.5,PRGSEQ)) Q:PRGSEQ'=+PRGSEQ  D
"RTN","RAHBIN3",144,0)
 . . I ^OR(100,ORIEN,4.5,PRGSEQ,0)["PREGNANT" S PRGDONE=1
"RTN","RAHBIN3",145,0)
 . . S LSTSEQ=PRGSEQ
"RTN","RAHBIN3",146,0)
 . I PRGDONE=0 D
"RTN","RAHBIN3",147,0)
 . . N ORDIALOG
"RTN","RAHBIN3",148,0)
 . . K PRGFLG
"RTN","RAHBIN3",149,0)
 . . S PRGFLG=RADARRY("PRGFLG")
"RTN","RAHBIN3",150,0)
 . . S PRGFLG=$TR(PRGFLG,"nyu","NYU")
"RTN","RAHBIN3",151,0)
 . . D GETDLG^ORCD(1)
"RTN","RAHBIN3",152,0)
 . . S PRGTEXT1=$P(ORDIALOG("B","PREGNANT"),"^",2)
"RTN","RAHBIN3",153,0)
 . . S PRGTEXT2=$P(ORDIALOG(PRGTEXT1),"^")
"RTN","RAHBIN3",154,0)
 . . K ORDIALOG
"RTN","RAHBIN3",155,0)
 . . N RAIEN,RADFDA,RADFILE
"RTN","RAHBIN3",156,0)
 . . S RADFILE=100.045,RAIEN=ORIEN_","
"RTN","RAHBIN3",157,0)
 . . S RADFDA(1,RADFILE,"+1,"_RAIEN,.01)=PRGTEXT2
"RTN","RAHBIN3",158,0)
 . . S RADFDA(1,RADFILE,"+1,"_RAIEN,.02)=PRGTEXT1
"RTN","RAHBIN3",159,0)
 . . S RADFDA(1,RADFILE,"+1,"_RAIEN,.03)="1"
"RTN","RAHBIN3",160,0)
 . . S RADFDA(1,RADFILE,"+1,"_RAIEN,.04)="PREGNANT"
"RTN","RAHBIN3",161,0)
 . . S RADFDA(1,RADFILE,"+1,"_RAIEN,1)=PRGFLG
"RTN","RAHBIN3",162,0)
 . . D UPDATE^DIE("S","RADFDA(1)","","ERRMSG") K RADFDA,RADFILE,RAIEN
"RTN","RAHBIN3",163,0)
 ;
"RTN","RAHBIN3",164,0)
REGQ ; 
"RTN","RAHBIN3",165,0)
 Q
"RTN","RAHBIN3",166,0)
 ;==========================================================
"RTN","RAHBIN3",167,0)
 ;
"RTN","RAHBIN3",168,0)
FLEMOD(PMOD) ;
"RTN","RAHBIN3",169,0)
 Q:'$D(PMOD)
"RTN","RAHBIN3",170,0)
 S IDX="" F  S IDX=$O(PMOD(IDX)) Q:IDX=""  D
"RTN","RAHBIN3",171,0)
 .Q:$G(PMOD(IDX))=""
"RTN","RAHBIN3",172,0)
 .S MOD=PMOD(IDX) K PMOD(IDX)
"RTN","RAHBIN3",173,0)
 .;Q:$D(^RADPT(RADFN,"DT",RADTI,"P",1,"M","B",MOD))
"RTN","RAHBIN3",174,0)
 .S RADARRY("PROCMOD")=MOD
"RTN","RAHBIN3",175,0)
 .S RADFDA(70.1,"+1,"_DA2_","_RADTI_","_RADFN_",",.01)=RADARRY("PROCMOD")
"RTN","RAHBIN3",176,0)
 .D UPDATE^DIE("S","RADFDA","","ERRMSG")
"RTN","RAHBIN3",177,0)
 .S ORIEN=$G(RADARRY("ORIEN"))
"RTN","RAHBIN3",178,0)
 .Q:$$CHKMOD(ORIEN,MOD)
"RTN","RAHBIN3",179,0)
 .N ORDIALOG
"RTN","RAHBIN3",180,0)
 .K PROCMOD
"RTN","RAHBIN3",181,0)
 .S PROCMOD=RADARRY("PROCMOD")
"RTN","RAHBIN3",182,0)
 .D GETDLG^ORCD(1)
"RTN","RAHBIN3",183,0)
 .S PROCMOD1=$P(ORDIALOG("B","PROCEDURE MODIFIER"),"^",2)
"RTN","RAHBIN3",184,0)
 .S PROCMOD2=$P(ORDIALOG(PROCMOD1),"^")
"RTN","RAHBIN3",185,0)
 .S I=$O(^OR(100,ORIEN,4.5,"ID","MODIFIER",999),-1)
"RTN","RAHBIN3",186,0)
 .S I=$G(I)+1
"RTN","RAHBIN3",187,0)
 .K ORDIALOG
"RTN","RAHBIN3",188,0)
 .N RAIEN,RADFDA,RADFILE
"RTN","RAHBIN3",189,0)
 .S RADFILE=100.045,RAIEN=ORIEN_","
"RTN","RAHBIN3",190,0)
 .S RADFDA(1,RADFILE,"+1,"_RAIEN,.01)=PROCMOD2
"RTN","RAHBIN3",191,0)
 .S RADFDA(1,RADFILE,"+1,"_RAIEN,.02)=PROCMOD1
"RTN","RAHBIN3",192,0)
 .S RADFDA(1,RADFILE,"+1,"_RAIEN,.03)=$G(I)
"RTN","RAHBIN3",193,0)
 .S RADFDA(1,RADFILE,"+1,"_RAIEN,.04)="MODIFIER"
"RTN","RAHBIN3",194,0)
 .S RADFDA(1,RADFILE,"+1,"_RAIEN,1)=RADARRY("PROCMOD")
"RTN","RAHBIN3",195,0)
 .D UPDATE^DIE("S","RADFDA(1)","","ERRMSG") K RADFDA,RADFILE,RAIEN
"RTN","RAHBIN3",196,0)
 Q
"RTN","RAHBIN3",197,0)
 ;
"RTN","RAHBIN3",198,0)
CHKMOD(ORIEN,MOD) ;
"RTN","RAHBIN3",199,0)
 N N
"RTN","RAHBIN3",200,0)
 S FOUND=0,N=""
"RTN","RAHBIN3",201,0)
 Q:'$D(^OR(100,ORIEN,4.5,"ID","MODIFIER"))
"RTN","RAHBIN3",202,0)
 F  S N=$O(^OR(100,ORIEN,4.5,"ID","MODIFIER",N)) Q:N=""  D  Q:FOUND
"RTN","RAHBIN3",203,0)
 .Q:$P(^OR(100,ORIEN,4.5,N,0),"^",4)'["MOD"
"RTN","RAHBIN3",204,0)
 .Q:'$D(^OR(100,ORIEN,4.5,N,1))
"RTN","RAHBIN3",205,0)
 .I MOD=^OR(100,ORIEN,4.5,N,1) S FOUND=1
"RTN","RAHBIN3",206,0)
 Q FOUND
"RTN","RAHBIN3",207,0)
 ;
"RTN","RAHBIN3",208,0)
RPT(RADARRY) ; file results in RADPT (#70), RARPT (#74)
"RTN","RAHBIN3",209,0)
 ; Input: CASE, RAOIEN, ORIEN
"RTN","RAHBIN3",210,0)
 N RADTI,DA2,NOW,ACTION,ERROR
"RTN","RAHBIN3",211,0)
 D NOW^%DTC S NOW=%
"RTN","RAHBIN3",212,0)
 S RADARRY("RPTSTA")="V",ERROR=0
"RTN","RAHBIN3",213,0)
 ; Input:
"RTN","RAHBIN3",214,0)
 ;
"RTN","RAHBIN3",215,0)
 ;
"RTN","RAHBIN3",216,0)
 ;bsl; add code for amending results
"RTN","RAHBIN3",217,0)
 ;Must check to see if results have already been filed
"RTN","RAHBIN3",218,0)
 K AMEND,EXRSLT
"RTN","RAHBIN3",219,0)
 D GETDPT I 'LROK S RAOROUT(1)="-1^COULD NOT FIND RECORD TO POST RESULTS" Q
"RTN","RAHBIN3",220,0)
 S EXRSLT=^RADPT(RADFN,"DT",RADTI,"P",DA2,0)
"RTN","RAHBIN3",221,0)
 S RPTIEN=+$P(EXRSLT,"^",17)     ;convert to number
"RTN","RAHBIN3",222,0)
 ;
"RTN","RAHBIN3",223,0)
 ;* Report amendment process, Do IF ien non 0 and then quit filer *
"RTN","RAHBIN3",224,0)
RPTIEN ;
"RTN","RAHBIN3",225,0)
 I RPTIEN D  Q
"RTN","RAHBIN3",226,0)
 . N II
"RTN","RAHBIN3",227,0)
 . D RPTERR    ;4839-save prev text fields first/Error Reports subfile
"RTN","RAHBIN3",228,0)
 . ;
"RTN","RAHBIN3",229,0)
 . ;4839:
"RTN","RAHBIN3",230,0)
 . ;save incoming text fields to RARPT file #74
"RTN","RAHBIN3",231,0)
 . ;        Impression amended text
"RTN","RAHBIN3",232,0)
 . I $D(WPIT("WP")) D
"RTN","RAHBIN3",233,0)
 . . S AMEND("WP",1)=""
"RTN","RAHBIN3",234,0)
 . . S AMEND("WP",2)="***Addendum Below***"
"RTN","RAHBIN3",235,0)
 . . ;insert blank if needed
"RTN","RAHBIN3",236,0)
 . . S II=$O(WPIT("WP",0))
"RTN","RAHBIN3",237,0)
 . . S:$G(WPIT("WP",II))]"" AMEND("WP",3)=""
"RTN","RAHBIN3",238,0)
 . . D WP^DIE(74,RPTIEN_",",300,"A","AMEND(""WP"")","ERRMSG")
"RTN","RAHBIN3",239,0)
 . . D WP^DIE(74,RPTIEN_",",300,"A","WPIT(""WP"")","ERRMSG")
"RTN","RAHBIN3",240,0)
 . . K AMEND("WP")
"RTN","RAHBIN3",241,0)
 . ;        Report amended text
"RTN","RAHBIN3",242,0)
 . I $D(WPRT("WP")) D
"RTN","RAHBIN3",243,0)
 . . S AMEND("WP",1)=""
"RTN","RAHBIN3",244,0)
 . . S AMEND("WP",2)="***Addendum Below***"
"RTN","RAHBIN3",245,0)
 . . ;insert blank if needed
"RTN","RAHBIN3",246,0)
 . . S II=$O(WPRT("WP",0))
"RTN","RAHBIN3",247,0)
 . . S:$G(WPRT("WP",II))]"" AMEND("WP",3)=""
"RTN","RAHBIN3",248,0)
 . . D WP^DIE(74,RPTIEN_",",200,"A","AMEND(""WP"")","ERRMSG")
"RTN","RAHBIN3",249,0)
 . . D WP^DIE(74,RPTIEN_",",200,"A","WPRT(""WP"")","ERRMSG")
"RTN","RAHBIN3",250,0)
 . ;update Report DT & Verify DT & xref to show the amended DOD report
"RTN","RAHBIN3",251,0)
 . ;time - 4839
"RTN","RAHBIN3",252,0)
 . N OLDVTIM,VNOW
"RTN","RAHBIN3",253,0)
 . S OLDVTIM=$P(^RARPT(RPTIEN,0),U,7),OLDVTIM=9999999.9999-OLDVTIM
"RTN","RAHBIN3",254,0)
 . K ^RARPT("AA",OLDVTIM,RPTIEN)
"RTN","RAHBIN3",255,0)
 . S VNOW=$E($$NOW^XLFDT,1,12)
"RTN","RAHBIN3",256,0)
 . S $P(^RARPT(RPTIEN,0),U,7)=VNOW
"RTN","RAHBIN3",257,0)
 . S $P(^RARPT(RPTIEN,0),U,8)=VNOW
"RTN","RAHBIN3",258,0)
 . S ^RARPT("AA",9999999.9999-VNOW,RPTIEN)=""
"RTN","RAHBIN3",259,0)
 . D END
"RTN","RAHBIN3",260,0)
 ;* End of Report amendment process *
"RTN","RAHBIN3",261,0)
 ;
"RTN","RAHBIN3",262,0)
 ;** Filing of original reports below **
"RTN","RAHBIN3",263,0)
 ;  file RARPT #74
"RTN","RAHBIN3",264,0)
 K RPTIEN,DIE,DA,DR
"RTN","RAHBIN3",265,0)
 N X,DIC,DLAYGO
"RTN","RAHBIN3",266,0)
 S X=LCASE,DIC(0)="L",DIC="^RARPT(",DLAYGO=2
"RTN","RAHBIN3",267,0)
 D FILE^DICN S RPTIEN=+Y ; create new report record file# 74
"RTN","RAHBIN3",268,0)
 S RADARRY("RPTIEN")=RPTIEN
"RTN","RAHBIN3",269,0)
 ;
"RTN","RAHBIN3",270,0)
 K RADFDA,ERRMSG,LCASE
"RTN","RAHBIN3",271,0)
 S RADFDA(74,RPTIEN_",",2)=RADARRY("DFN")      ; patient=>2
"RTN","RAHBIN3",272,0)
 S RADFDA(74,RPTIEN_",",3)=RADARRY("EXMDT")    ; exam dt
"RTN","RAHBIN3",273,0)
 S RADFDA(74,RPTIEN_",",4)=RADARRY("CASE")     ; case#
"RTN","RAHBIN3",274,0)
 S RADFDA(74,RPTIEN_",",5)=RADARRY("RPTSTA")   ; report status:codes
"RTN","RAHBIN3",275,0)
 S RADFDA(74,RPTIEN_",",6)=RADARRY("RPTENTDT") ; date report entered
"RTN","RAHBIN3",276,0)
 S RADFDA(74,RPTIEN_",",7)=RADARRY("VRFDT")    ; verified date
"RTN","RAHBIN3",277,0)
 S RADFDA(74,RPTIEN_",",8)=RADARRY("RPTDT")    ; reported date
"RTN","RAHBIN3",278,0)
 ;S RADFDA(74,RPTIEN_",",9)=RADARRY("VRFPHY")   ; verifying physician=>200
"RTN","RAHBIN3",279,0)
 ;4833 dot structure
"RTN","RAHBIN3",280,0)
 ;D:RADARRY("VRFPHY")   ;encrpyt esig from RARPT ien, doc duz, doc name
"RTN","RAHBIN3",281,0)
 . ;S X2=RPTIEN,X1=RADARRY("VRFPHY"),X=$P($$ESBLOCK^XUSESIG1(X1),U,1)
"RTN","RAHBIN3",282,0)
 . ;D EN^XUSHSHP S RADARRY("ESCD")=X
"RTN","RAHBIN3",283,0)
 S RADFDA(74,RPTIEN_",",10)=RADARRY("ESCD")    ; electronic signature code
"RTN","RAHBIN3",284,0)
 S RADFDA(74,RPTIEN_",",11)=RADARRY("TRNSCP")  ; transcriptionist=>200
"RTN","RAHBIN3",285,0)
 S RADFDA(74,RPTIEN_",",17)=RADARRY("SCVBY")   ; status changed to verified by=>200
"RTN","RAHBIN3",286,0)
 S RADFDA(74,RPTIEN_",",86)=RADARRY("ITRLOC")  ; interpreting imaging location=>79.1
"RTN","RAHBIN3",287,0)
 ;
"RTN","RAHBIN3",288,0)
 K FLAGS
"RTN","RAHBIN3",289,0)
 S FLAGS=""
"RTN","RAHBIN3",290,0)
 D FILE^DIE(FLAGS,"RADFDA","ERRMSG")
"RTN","RAHBIN3",291,0)
 I $G(DIERR) D ERR
"RTN","RAHBIN3",292,0)
 ;
"RTN","RAHBIN3",293,0)
 K RADFDA,ERRMSG
"RTN","RAHBIN3",294,0)
 S RADFDA(74.01,"+1,"_RPTIEN_",",.01)=RADARRY("NOW") ; log date
"RTN","RAHBIN3",295,0)
 S RADFDA(74.01,"+1,"_RPTIEN_",",2)=RADARRY("ACTION")    ; type of action
"RTN","RAHBIN3",296,0)
 S RADFDA(74.01,"+1,"_RPTIEN_",",3)=RADARRY("DUZ")       ; computer user
"RTN","RAHBIN3",297,0)
 D UPDATE^DIE("S","RADFDA","","ERRMSG")
"RTN","RAHBIN3",298,0)
 I $G(DIERR) D ERR
"RTN","RAHBIN3",299,0)
 ;     file word processing data
"RTN","RAHBIN3",300,0)
 I $D(WPACH("WP")) D WP^DIE(74,RPTIEN_",",400,"","WPACH(""WP"")","ERRMSG")  ; additional clinical history
"RTN","RAHBIN3",301,0)
 I $D(WPIT("WP")) D WP^DIE(74,RPTIEN_",",300,"","WPIT(""WP"")","ERRMSG")     ; impression text
"RTN","RAHBIN3",302,0)
 I $D(WPRT("WP")) D WP^DIE(74,RPTIEN_",",200,"","WPRT(""WP"")","ERRMSG")     ; report text
"RTN","RAHBIN3",303,0)
 ;
"RTN","RAHBIN3",304,0)
 ;  file results into RADPT( exminations
"RTN","RAHBIN3",305,0)
 ;    file #70.03:
"RTN","RAHBIN3",306,0)
 K RADFDA,ERRMSG,PROC
"RTN","RAHBIN3",307,0)
 S FLAGS=""
"RTN","RAHBIN3",308,0)
 ;BSL;Set exam status to complete
"RTN","RAHBIN3",309,0)
 S RADARRY("EXSTAT")=$$GETSTA^RAHBIN2(RADARRY("PROC"),"COMPLETE")
"RTN","RAHBIN3",310,0)
 ;
"RTN","RAHBIN3",311,0)
 ;S RADFDA(70.03,DA2_","_RADTI_","_RADFN_",",12)=PRIRES   ; primary interpreting resident=>200
"RTN","RAHBIN3",312,0)
 S RADFDA(70.03,DA2_","_RADTI_","_RADFN_",",13)=RADARRY("PRIDGC")   ; primary diagnosis code=>74
"RTN","RAHBIN3",313,0)
 S RADFDA(70.03,DA2_","_RADTI_","_RADFN_",",15)=RADARRY("PRISTF")   ; primary interpreting staff=>200
"RTN","RAHBIN3",314,0)
 S RADFDA(70.03,DA2_","_RADTI_","_RADFN_",",17)=RADARRY("RPTIEN")   ; report text=>74
"RTN","RAHBIN3",315,0)
 S RADFDA(70.03,DA2_","_RADTI_","_RADFN_",",3)=RADARRY("EXSTAT")  ;EXAM STATUS
"RTN","RAHBIN3",316,0)
 S FLAGS=""
"RTN","RAHBIN3",317,0)
 D FILE^DIE(FLAGS,"RADFDA","ERRMSG")
"RTN","RAHBIN3",318,0)
 I $G(DIERR) D ERR
"RTN","RAHBIN3",319,0)
 D X7005^RADD3(RADFN,RADTI,DA2,"","",RADARRY("EXSTAT"),$G(RADARRY("DUZ")))
"RTN","RAHBIN3",320,0)
 D A7007^RADD3(RADFN,RADTI,DA2,RADARRY("DUZ"),$G(RADARRY("TECH")))
"RTN","RAHBIN3",321,0)
 ;Update 100 File
"RTN","RAHBIN3",322,0)
 ;BL;Modified to update status regardless of errors, response to JIRA 2048
"RTN","RAHBIN3",323,0)
 ;I 'ERROR,$D(ORIEN) D removing dot structure to ensure code gets called jira 2048
"RTN","RAHBIN3",324,0)
 ;file new proc mods if found
"RTN","RAHBIN3",325,0)
 ;BL;IA compliance change
"RTN","RAHBIN3",326,0)
 S ORIEN=RADARRY("ORIEN")
"RTN","RAHBIN3",327,0)
 N NOW
"RTN","RAHBIN3",328,0)
 S NOW=$$NOW^XLFDT,FLAGS=""
"RTN","RAHBIN3",329,0)
 S RADFDA(100,ORIEN_",",22)=NOW
"RTN","RAHBIN3",330,0)
 S RADFDA(100,ORIEN_",",5)=2
"RTN","RAHBIN3",331,0)
 D FILE^DIE(FLAGS,"RADFDA","ERRMSG")
"RTN","RAHBIN3",332,0)
 ;add remote user's name to the 8 node of file 100
"RTN","RAHBIN3",333,0)
 I $D(^OR(100,ORIEN,8,1,.1)) D
"RTN","RAHBIN3",334,0)
 .S CNT=$P(^OR(100,ORIEN,8,1,.1,0),"^",3)
"RTN","RAHBIN3",335,0)
 .S CNT=CNT+1,$P(^OR(100,ORIEN,8,1,.1,0),"^",2,3)=CNT
"RTN","RAHBIN3",336,0)
 .S ^OR(100,ORIEN,8,1,.1,CNT,0)="Verified By: "_RADARRY("USER")
"RTN","RAHBIN3",337,0)
 I $G(DIERR) D ERR
"RTN","RAHBIN3",338,0)
 ;UPDATE 75.1 with new status
"RTN","RAHBIN3",339,0)
 S RADFDA(75.1,RAOIEN_",",5)=RADARRY("EXSTAT")
"RTN","RAHBIN3",340,0)
 S RADFDA(75.1,RAOIEN_",",18)=RADARRY("NOW")
"RTN","RAHBIN3",341,0)
 S RADFDA(75.12,"+1,"_RAOIEN_",",.01)=RADARRY("NOW")
"RTN","RAHBIN3",342,0)
 S RADFDA(75.12,"+1,"_RAOIEN_",",2)=RADARRY("EXSTAT")
"RTN","RAHBIN3",343,0)
 S RADFDA(75.12,"+1,"_RAOIEN_",",3)=RADARRY("REQPRV")
"RTN","RAHBIN3",344,0)
 D UPDATE^DIE("S","RADFDA","","ERRMSG")
"RTN","RAHBIN3",345,0)
 ;
"RTN","RAHBIN3",346,0)
 ;BL;UPDATE IMAGING LOCATION WHEN RESULTS COME IN; ISSUE 1937
"RTN","RAHBIN3",347,0)
 S RADFDA(70.02,"+1,"_RADFN_",",4)=RADARRY("IMGLOC")   ; imaging location=>79.1
"RTN","RAHBIN3",348,0)
 S FLAGS=""
"RTN","RAHBIN3",349,0)
 D FILE^DIE(FLAGS,"RADFDA","ERRMSG")
"RTN","RAHBIN3",350,0)
 I $G(DIERR) D ERR
"RTN","RAHBIN3",351,0)
 ;
"RTN","RAHBIN3",352,0)
END ;Check if Abnormal Alert needed then, finish cleanup    ;5329
"RTN","RAHBIN3",353,0)
 ;
"RTN","RAHBIN3",354,0)
 ;setup variables for Abnormal alert testing & conditional call, ;5329
"RTN","RAHBIN3",355,0)
 N RAAB,RACNI,RAEXAM0,RARPT
"RTN","RAHBIN3",356,0)
 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P","B",RADARRY("CASE"),0))
"RTN","RAHBIN3",357,0)
 S RAEXAM0=$S($D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)):^(0),1:0)
"RTN","RAHBIN3",358,0)
 S RARPT=RPTIEN    ;Glb Var needed by OE3, file 74 ien
"RTN","RAHBIN3",359,0)
 I $G(RADARRY("PRIDGC"))>0 D
"RTN","RAHBIN3",360,0)
 .S RAAB=$S($P(^RA(78.3,+RADARRY("PRIDGC"),0),U,4)="y":1,1:0)
"RTN","RAHBIN3",361,0)
 I $G(RAAB)>0 D OE3^RAUTL00(RADFN,RADTI,RACNI,RAEXAM0)
"RTN","RAHBIN3",362,0)
 ;
"RTN","RAHBIN3",363,0)
 ;cleanup
"RTN","RAHBIN3",364,0)
 K RIEN,WPACH,WPIT,WPRT,XMSG,RAOIEN,RADTE,RADFDA,RACNT,PMOD,SECDGC,PRIDGC
"RTN","RAHBIN3",365,0)
 ;
"RTN","RAHBIN3",366,0)
RPTQ ;
"RTN","RAHBIN3",367,0)
 Q
"RTN","RAHBIN3",368,0)
 ;
"RTN","RAHBIN3",369,0)
GETDPT ; get RADTI  and DA2 for a Case# & orien
"RTN","RAHBIN3",370,0)
 N STOP
"RTN","RAHBIN3",371,0)
 S RADTI=0,DA2="",STOP=0,LROK=0
"RTN","RAHBIN3",372,0)
 F  S RADTI=$O(^RADPT(RADFN,"DT",RADTI)) Q:'RADTI  D  Q:STOP
"RTN","RAHBIN3",373,0)
 . S DA2=0,DA2=$O(^RADPT(RADFN,"DT",RADTI,"P",DA2))
"RTN","RAHBIN3",374,0)
 . I RADARRY("CASE")=+^RADPT(RADFN,"DT",RADTI,"P",DA2,0),$P(^RADPT(RADFN,"DT",RADTI,"P",DA2,0),"^",11)=RAOIEN S STOP=1,LROK=1
"RTN","RAHBIN3",375,0)
 ; sub-sub files
"RTN","RAHBIN3",376,0)
 ;F I=1:1 Q:'$D(SECRES(I))  D  ; secondary interpreting resident=>200
"RTN","RAHBIN3",377,0)
 ;. K RADFDA,ERRMSG
"RTN","RAHBIN3",378,0)
 ;F I=1:1 Q:'$D(SECSTF(I))  D  ; secondary interpreting staff=>200
"RTN","RAHBIN3",379,0)
 ;. K RADFDA,ERRMSG
"RTN","RAHBIN3",380,0)
 ;. S RADFDA(70.11,"+1,"_DA2_","_RADTI_","_RADFN_",",.01)=SECSTF(I)
"RTN","RAHBIN3",381,0)
 ;. D UPDATE^DIE("S","RADFDA","","ERRMSG")
"RTN","RAHBIN3",382,0)
 Q:'$D(SECDGC)
"RTN","RAHBIN3",383,0)
 F I=1:1 Q:'$D(SECDGC(I))  D  ; secondary diagnosis code=>78.3
"RTN","RAHBIN3",384,0)
 .K RADFDA,ERRMSG
"RTN","RAHBIN3",385,0)
 .S RADFDA(70.14,"+1,"_DA2_","_RADTI_","_RADFN_",",.01)=SECDGC(I)
"RTN","RAHBIN3",386,0)
 .D UPDATE^DIE("S","RADFDA","","ERRMSG")
"RTN","RAHBIN3",387,0)
 Q
"RTN","RAHBIN3",388,0)
 ;
"RTN","RAHBIN3",389,0)
ERR ; return errors from filer
"RTN","RAHBIN3",390,0)
 S ERROR=1
"RTN","RAHBIN3",391,0)
 ;I $G(DEBUG) D DGERR^JVDG2("JVDGF",DBCNT,.XMSG,"F") ; debug log
"RTN","RAHBIN3",392,0)
 N XO,XF,XL S XO="" F  S XO=$O(ERRMSG("DIERR",XO)) Q:'XO  D
"RTN","RAHBIN3",393,0)
 . S XF=$G(ERRMSG("DIERR",XO,"PARAM","FIELD")),XL=$G(ERRMSG("DIERR",XO,"PARAM","FILE")) Q:((XF="")!(XL=""))
"RTN","RAHBIN3",394,0)
 . S XF=$$DDLBL(XL,XF)
"RTN","RAHBIN3",395,0)
 . S RACNT=RACNT+1,RAOROUT(RACNT)=XF_": "_$G(XMSG("DIERR",XO,"TEXT",1))
"RTN","RAHBIN3",396,0)
 ;
"RTN","RAHBIN3",397,0)
 K DIERR,ERRMSG
"RTN","RAHBIN3",398,0)
 Q
"RTN","RAHBIN3",399,0)
 ;
"RTN","RAHBIN3",400,0)
DDLBL(FILE,FLD) ; return field name. (This entry point copied from JVDG, since we're in a separate package.)
"RTN","RAHBIN3",401,0)
 ; Input:
"RTN","RAHBIN3",402,0)
 ;    FILE=file#
"RTN","RAHBIN3",403,0)
 ;    FLD=Field number
"RTN","RAHBIN3",404,0)
 ;  Returns
"RTN","RAHBIN3",405,0)
 ;    field's Label
"RTN","RAHBIN3",406,0)
 I $G(FILE)=""!($G(FLD)="") Q ""
"RTN","RAHBIN3",407,0)
 N FDA
"RTN","RAHBIN3",408,0)
 D FIELD^DID(FILE,FLD,"","LABEL","FDA","")
"RTN","RAHBIN3",409,0)
 Q $G(FDA("LABEL"))
"RTN","RAHBIN3",410,0)
 ;
"RTN","RAHBIN3",411,0)
RPTERR ;Saves previous text fields to subfile #74.06 to trigger the Amended 
"RTN","RAHBIN3",412,0)
 ;report headings.  4839.
"RTN","RAHBIN3",413,0)
 ;
"RTN","RAHBIN3",414,0)
 N QQ,CH,RT,IT,ECNT
"RTN","RAHBIN3",415,0)
 M CH=^RARPT(RPTIEN,"H") K CH(0)
"RTN","RAHBIN3",416,0)
 M RT=^RARPT(RPTIEN,"R") K RT(0)
"RTN","RAHBIN3",417,0)
 M IT=^RARPT(RPTIEN,"I") K IT(0)
"RTN","RAHBIN3",418,0)
 ;build Tmp report with old values for #74.06
"RTN","RAHBIN3",419,0)
 S ECNT=1
"RTN","RAHBIN3",420,0)
 S ^TMP($J,"RA AUTOE",ECNT)="** DOD incoming Radiology Results event **"
"RTN","RAHBIN3",421,0)
 S ECNT=ECNT+1,^TMP($J,"RA AUTOE",ECNT)=""
"RTN","RAHBIN3",422,0)
 I $D(CH) D
"RTN","RAHBIN3",423,0)
 . S ECNT=ECNT+1,^TMP($J,"RA AUTOE",ECNT)="  Additional Clinical History:"
"RTN","RAHBIN3",424,0)
 . F QQ=0:0 S QQ=$O(CH(QQ)) Q:'QQ  D
"RTN","RAHBIN3",425,0)
 . . S ECNT=ECNT+1,^TMP($J,"RA AUTOE",ECNT)=CH(QQ,0)
"RTN","RAHBIN3",426,0)
 I $D(RT) D
"RTN","RAHBIN3",427,0)
 . S ECNT=ECNT+1,^TMP($J,"RA AUTOE",ECNT)="  Report:"
"RTN","RAHBIN3",428,0)
 . F QQ=0:0 S QQ=$O(RT(QQ)) Q:'QQ  D
"RTN","RAHBIN3",429,0)
 . . S ECNT=ECNT+1,^TMP($J,"RA AUTOE",ECNT)=RT(QQ,0)
"RTN","RAHBIN3",430,0)
 I $D(IT) D
"RTN","RAHBIN3",431,0)
 . S ECNT=ECNT+1,^TMP($J,"RA AUTOE",ECNT)="  Impression:"
"RTN","RAHBIN3",432,0)
 . F QQ=0:0 S QQ=$O(IT(QQ)) Q:'QQ  D
"RTN","RAHBIN3",433,0)
 . . S ECNT=ECNT+1,^TMP($J,"RA AUTOE",ECNT)=IT(QQ,0)
"RTN","RAHBIN3",434,0)
 D EN1^RARTE3(RPTIEN)    ;call to legacy to file ERR nodes in TMP
"RTN","RAHBIN3",435,0)
 Q
"RTN","RAHBIN3",436,0)
 ;
"VER")
8.0^22.0
**END**
**END**
