KIDS Distribution saved on Sep 06, 2016@10:45:52
SPOKE BUILD
**KIDS**:ZZTEST 2.0^

**INSTALL NAME**
ZZTEST 2.0
"BLD",8909,0)
ZZTEST 2.0^ZZTEST^0^3160906^n
"BLD",8909,4,0)
^9.64PA^^0
"BLD",8909,6.3)
2
"BLD",8909,"KRN",0)
^9.67PA^779.2^20
"BLD",8909,"KRN",.4,0)
.4
"BLD",8909,"KRN",.4,"NM",0)
^9.68A^^0
"BLD",8909,"KRN",.401,0)
.401
"BLD",8909,"KRN",.401,"NM",0)
^9.68A^^0
"BLD",8909,"KRN",.402,0)
.402
"BLD",8909,"KRN",.402,"NM",0)
^9.68A^^0
"BLD",8909,"KRN",.403,0)
.403
"BLD",8909,"KRN",.5,0)
.5
"BLD",8909,"KRN",.84,0)
.84
"BLD",8909,"KRN",3.6,0)
3.6
"BLD",8909,"KRN",3.8,0)
3.8
"BLD",8909,"KRN",9.2,0)
9.2
"BLD",8909,"KRN",9.8,0)
9.8
"BLD",8909,"KRN",9.8,"NM",0)
^9.68A^6^6
"BLD",8909,"KRN",9.8,"NM",1,0)
LRHBR1^^0^B117641163
"BLD",8909,"KRN",9.8,"NM",2,0)
LRHBR2^^0^B169207416
"BLD",8909,"KRN",9.8,"NM",3,0)
LRRMTIN^^0^B22418784
"BLD",8909,"KRN",9.8,"NM",4,0)
LRRMTIN1^^0^B159894830
"BLD",8909,"KRN",9.8,"NM",5,0)
LRRMTOUT^^0^B23245720
"BLD",8909,"KRN",9.8,"NM",6,0)
RARMTOUT^^0^B68106880
"BLD",8909,"KRN",9.8,"NM","B","LRHBR1",1)

"BLD",8909,"KRN",9.8,"NM","B","LRHBR2",2)

"BLD",8909,"KRN",9.8,"NM","B","LRRMTIN",3)

"BLD",8909,"KRN",9.8,"NM","B","LRRMTIN1",4)

"BLD",8909,"KRN",9.8,"NM","B","LRRMTOUT",5)

"BLD",8909,"KRN",9.8,"NM","B","RARMTOUT",6)

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

"BLD",8909,"KRN",101,"NM","B","LA7V 500 ORM-O01 SUBS",2)

"BLD",8909,"KRN",101,"NM","B","LA7V REMOTE ORM-O01 EVENT",3)

"BLD",8909,"KRN",101,"NM","B","LA7V REMOTE ORM-O01 SUBS",18)

"BLD",8909,"KRN",101,"NM","B","LR EVSEND CPRS",4)

"BLD",8909,"KRN",101,"NM","B","LR EVSEND REMTE",5)

"BLD",8909,"KRN",101,"NM","B","RA 500 ORM-O01 EVENT",6)

"BLD",8909,"KRN",101,"NM","B","RA 500 ORM-O01 SUBS",7)

"BLD",8909,"KRN",101,"NM","B","RA CANCEL REMOTE EVENT",8)

"BLD",8909,"KRN",101,"NM","B","RA CANCEL REMOTE SUBS",9)

"BLD",8909,"KRN",101,"NM","B","RA EVSEND CPRS",10)

"BLD",8909,"KRN",101,"NM","B","RA EVSEND RMTE",11)

"BLD",8909,"KRN",101,"NM","B","RA REG RMTE EVENT",19)

"BLD",8909,"KRN",101,"NM","B","RA REG RMTE SUBS",20)

"BLD",8909,"KRN",101,"NM","B","RA REMOTE DC EVENT",12)

"BLD",8909,"KRN",101,"NM","B","RA REMOTE DC SUBS",13)

"BLD",8909,"KRN",101,"NM","B","RA REMOTE ORM-O01 EVENT",14)

"BLD",8909,"KRN",101,"NM","B","RA REMOTE ORM-O01 SUBS",15)

"BLD",8909,"KRN",101,"NM","B","RA RPT RMTE EVENT",16)

"BLD",8909,"KRN",101,"NM","B","RA RPT RMTE SUBS",17)

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

"BLD",8909,"KRN",771,"NM","B","LA7V 565 CLIENT",1)

"BLD",8909,"KRN",771,"NM","B","LA7V HOST 500",2)

"BLD",8909,"KRN",771,"NM","B","LA7V HOST 565",3)

"BLD",8909,"KRN",771,"NM","B","LA7V REMOTE 565",4)

"BLD",8909,"KRN",771,"NM","B","RA 500 CLIENT",5)

"BLD",8909,"KRN",771,"NM","B","RA 565 CLIENT",6)

"BLD",8909,"KRN",771,"NM","B","RA HOST 500",7)

"BLD",8909,"KRN",771,"NM","B","RA HOST 565",8)

"BLD",8909,"KRN",779.2,0)
779.2
"BLD",8909,"KRN",870,0)
870
"BLD",8909,"KRN",870,"NM",0)
^9.68A^2^2
"BLD",8909,"KRN",870,"NM",1,0)
LA7RMTE1^^0
"BLD",8909,"KRN",870,"NM",2,0)
SPOKE1^^0
"BLD",8909,"KRN",870,"NM","B","LA7RMTE1",1)

"BLD",8909,"KRN",870,"NM","B","SPOKE1",2)

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

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

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

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

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

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

"BLD",8909,"KRN","B",3.6,3.6)

"BLD",8909,"KRN","B",3.8,3.8)

"BLD",8909,"KRN","B",9.2,9.2)

"BLD",8909,"KRN","B",9.8,9.8)

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

"BLD",8909,"KRN","B",19.1,19.1)

"BLD",8909,"KRN","B",101,101)

"BLD",8909,"KRN","B",409.61,409.61)

"BLD",8909,"KRN","B",771,771)

"BLD",8909,"KRN","B",779.2,779.2)

"BLD",8909,"KRN","B",870,870)

"BLD",8909,"KRN","B",8989.51,8989.51)

"BLD",8909,"KRN","B",8989.52,8989.52)

"BLD",8909,"KRN","B",8994,8994)

"BLD",8909,"QUES",0)
^9.62^^
"BLD",8909,"REQB",0)
^9.611^^
"KRN",101,6177,-1)
0^3
"KRN",101,6177,0)
LA7V REMOTE ORM-O01 EVENT^INCOMING FROM VISTA HUB^^E^^^^^^^^
"KRN",101,6177,99)
63964,50290
"KRN",101,6177,770)
LA7V HOST 500^^ORM^O01^49^^^AL^NE^2.4^
"KRN",101,6177,775,0)
^101.0775PA^1^1
"KRN",101,6177,775,1,0)
6178
"KRN",101,6177,775,1,"^")
LA7V REMOTE ORM-O01 SUBS
"KRN",101,6178,-1)
0^18
"KRN",101,6178,0)
LA7V REMOTE ORM-O01 SUBS^RECEIVE REMOTE ORDERS FROM VISTA^^S^^^^^^^^
"KRN",101,6178,99)
63964,50530
"KRN",101,6178,770)
^LA7V 565 CLIENT^^O01^^^^AL^NE^2.4^ACK
"KRN",101,6178,771)
D EN^LRRMTIN
"KRN",101,6178,773)
0^0^0
"KRN",101,6178,774)

"KRN",101,6179,-1)
0^4
"KRN",101,6179,0)
LR EVSEND CPRS^VISTA TO CPRS^^A^^^^^^^^
"KRN",101,6179,15)
K HLA("HLS")
"KRN",101,6179,20)
I $G(REMOTE)'=1,$D(XQORMSG) D EN^LRRMTOUT("",.XQORMSG)
"KRN",101,6179,99)
63973,35170
"KRN",101,6180,-1)
0^5
"KRN",101,6180,0)
LR EVSEND REMTE^REMOTE ORDERING PROTOCOL^^A^^^^^^^^
"KRN",101,6180,15)
K HLA("HLS")
"KRN",101,6180,20)
I $G(REMOTE)'=1,$D(XQORMSG) D EN^LRRMTOUT(.XQORMSG)
"KRN",101,6180,99)
63973,35112
"KRN",101,6181,-1)
0^1
"KRN",101,6181,0)
LA7V 500 ORM-O01 EVENT^SPOKE TO HUB MESSAGES^^E^^^^^^^^
"KRN",101,6181,99)
63977,37177
"KRN",101,6181,770)
LA7V HOST 565^^ORM^O01^^^^NE^NE^2.4^
"KRN",101,6181,773)
1^1^0
"KRN",101,6181,775,0)
^101.0775PA^1^1
"KRN",101,6181,775,1,0)
6182
"KRN",101,6181,775,1,"^")
LA7V 500 ORM-O01 SUBS
"KRN",101,6182,-1)
0^2
"KRN",101,6182,0)
LA7V 500 ORM-O01 SUBS^SPOKE TO HUB SUBSCRIBER^^S^^^^^^^^
"KRN",101,6182,99)
63977,37351
"KRN",101,6182,770)
^LA7V 500 CLIENT^^^^^LA7RMTE1^NE^NE^2.4^
"KRN",101,6182,773)
1^1^0
"KRN",101,6185,-1)
0^14
"KRN",101,6185,0)
RA REMOTE ORM-O01 EVENT^INCOMING RAD^^E^^^^^^^^
"KRN",101,6185,99)
64037,42810
"KRN",101,6185,770)
RA HOST 500^^ORM^O01^49^^^AL^NE^2.4^
"KRN",101,6185,775,0)
^101.0775PA^1^1
"KRN",101,6185,775,1,0)
6186
"KRN",101,6185,775,1,"^")
RA REMOTE ORM-O01 SUBS
"KRN",101,6186,-1)
0^15
"KRN",101,6186,0)
RA REMOTE ORM-O01 SUBS^RECEIVE REMOTE ORDER SUB^^S^^^^^^^^
"KRN",101,6186,99)
64037,42901
"KRN",101,6186,770)
^RA 565 CLIENT^^O01^^^^AL^NE^2.4^ACK
"KRN",101,6186,771)
D EN^LRRMTIN
"KRN",101,6186,773)
0^0^0
"KRN",101,6187,-1)
0^19
"KRN",101,6187,0)
RA REG RMTE EVENT^RAD SPOKE TO HUB^^E^^^^^^^^
"KRN",101,6187,20)
D EN^RARMTOUT
"KRN",101,6187,99)
64056,41395
"KRN",101,6187,770)
RA HOST 565^^ORM^O01^^^^NE^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,"^")
RA REG RMTE SUBS
"KRN",101,6188,-1)
0^20
"KRN",101,6188,0)
RA REG RMTE SUBS^SPOKE TO HUB RAD^^S^^^^^^^^
"KRN",101,6188,99)
64056,41539
"KRN",101,6188,770)
^RA 500 CLIENT^^^^^LA7RMTE1^NE^NE^2.4^
"KRN",101,6188,771)
Q
"KRN",101,6188,773)
1^1^0
"KRN",101,6189,-1)
0^17
"KRN",101,6189,0)
RA RPT RMTE SUBS^SPOKE TO HUB RESULTS^^S^^^^^^^^
"KRN",101,6189,99)
64058,35224
"KRN",101,6189,770)
^RA 500 CLIENT^^O01^^^LA7RMTE1^NE^NE^2.4^ACK
"KRN",101,6189,771)
Q
"KRN",101,6189,773)
1^1^0
"KRN",101,6190,-1)
0^16
"KRN",101,6190,0)
RA RPT RMTE EVENT^RAD RESULTS TO HUB^^E^^^^^^^^
"KRN",101,6190,20)
D EN^RARMTOUT
"KRN",101,6190,99)
64058,35317
"KRN",101,6190,770)
RA HOST 565^^ORM^O01^49^^^NE^NE^2.4^
"KRN",101,6190,773)
1^1^0
"KRN",101,6190,775,0)
^101.0775PA^1^1
"KRN",101,6190,775,1,0)
6189
"KRN",101,6190,775,1,"^")
RA RPT RMTE SUBS
"KRN",101,6191,-1)
0^11
"KRN",101,6191,0)
RA EVSEND RMTE^RAD OERR => VISTA^^A^^^^^^^^
"KRN",101,6191,15)
K HLA("HLS")
"KRN",101,6191,20)
I $G(REMOTE)'=1 D EN1^RARMTOUT(.XQORMSG)
"KRN",101,6191,99)
64061,51758
"KRN",101,6192,-1)
0^7
"KRN",101,6192,0)
RA 500 ORM-O01 SUBS^SPOKE TO HUB RAD^^S^^^^^^^^
"KRN",101,6192,99)
64063,66396
"KRN",101,6192,770)
^RA 500 CLIENT^^^^^LA7RMTE1^NE^NE^2.4^
"KRN",101,6192,773)
1^1^0
"KRN",101,6193,-1)
0^6
"KRN",101,6193,0)
RA 500 ORM-O01 EVENT^SPOKE TO HUB RAD^^E^^^^^^^^
"KRN",101,6193,99)
64063,66472
"KRN",101,6193,770)
RA HOST 565^^ORM^O01^^^^NE^NE^2.4^
"KRN",101,6193,773)
1^1^0
"KRN",101,6193,775,0)
^101.0775PA^1^1
"KRN",101,6193,775,1,0)
6192
"KRN",101,6193,775,1,"^")
RA 500 ORM-O01 SUBS
"KRN",101,6194,-1)
0^10
"KRN",101,6194,0)
RA EVSEND CPRS^SPOKE TO HUB ARRIVALS^^A^^^^^^^^
"KRN",101,6194,15)
K HLA("HLS")
"KRN",101,6194,20)
I $G(REMOTE)'=1 D EN1^RARMTOUT(.XQORMSG)
"KRN",101,6194,99)
64080,42541
"KRN",101,6195,-1)
0^8
"KRN",101,6195,0)
RA CANCEL REMOTE EVENT^^^E^^^^^^^^
"KRN",101,6195,20)
D EN^RARMTOUT
"KRN",101,6195,770)
RA HOST 565^^ORM^O01^49^^^NE^NE^2.4^
"KRN",101,6195,772)
Q
"KRN",101,6195,773)
1^1^0
"KRN",101,6195,775,0)
^101.0775PA^1^1
"KRN",101,6195,775,1,0)
6196
"KRN",101,6195,775,1,"^")
RA CANCEL REMOTE SUBS
"KRN",101,6196,-1)
0^9
"KRN",101,6196,0)
RA CANCEL REMOTE SUBS^^^S^^^^^^^^
"KRN",101,6196,770)
^RA 500 CLIENT^^O01^^^LA7RMTE1^NE^NE^2.4^ACK
"KRN",101,6196,771)
Q
"KRN",101,6196,773)
1^1^0
"KRN",101,6197,-1)
0^12
"KRN",101,6197,0)
RA REMOTE DC EVENT^CPRS DC AT SPOKE^^E^^^^^^^^
"KRN",101,6197,99)
64081,53999
"KRN",101,6197,770)
RA HOST 565^^ORM^O01^49^^^NE^NE^2.4^
"KRN",101,6197,771)

"KRN",101,6197,772)
Q
"KRN",101,6197,773)
1^1^0
"KRN",101,6197,775,0)
^101.0775PA^1^1
"KRN",101,6197,775,1,0)
6198
"KRN",101,6197,775,1,"^")
RA REMOTE DC SUBS
"KRN",101,6198,-1)
0^13
"KRN",101,6198,0)
RA REMOTE DC SUBS^SPOKE CPRS DC^^S^^^^^^^^
"KRN",101,6198,99)
64081,54086
"KRN",101,6198,770)
^RA 500 CLIENT^^O01^^^LA7RMTE1^NE^NE^2.4^ACK
"KRN",101,6198,771)
Q
"KRN",101,6198,772)

"KRN",101,6198,773)
1^1^0
"KRN",101,6198,775,0)
^101.0775PA^^0
"KRN",771,36,-1)
0^2
"KRN",771,36,0)
LA7V HOST 500^a^^^^^USA
"KRN",771,36,"EC")
^~\&
"KRN",771,36,"FS")
|
"KRN",771,244,-1)
0^1
"KRN",771,244,0)
LA7V 565 CLIENT^a^565^^^^USA
"KRN",771,244,"EC")
^~\&
"KRN",771,244,"FS")
|
"KRN",771,245,-1)
0^4
"KRN",771,245,0)
LA7V REMOTE 565^a^^^^^USA
"KRN",771,245,"EC")
^~\&
"KRN",771,245,"FS")
|
"KRN",771,246,-1)
0^9
"KRN",771,246,0)
LA7V 500 CLIENT^a^500^^^^USA
"KRN",771,246,"EC")
^~\&
"KRN",771,246,"FS")
|
"KRN",771,247,-1)
0^3
"KRN",771,247,0)
LA7V HOST 565^a^565^^^^USA
"KRN",771,247,"EC")
^~\&
"KRN",771,247,"FS")
|
"KRN",771,248,-1)
0^7
"KRN",771,248,0)
RA HOST 500^a^^^^^USA
"KRN",771,248,"EC")
^~\&
"KRN",771,248,"FS")
|
"KRN",771,249,-1)
0^6
"KRN",771,249,0)
RA 565 CLIENT^a^565^^^^USA
"KRN",771,249,"EC")
^~\&
"KRN",771,249,"FS")
|
"KRN",771,251,-1)
0^5
"KRN",771,251,0)
RA 500 CLIENT^a^500^^^^USA
"KRN",771,251,"EC")
^~\&
"KRN",771,251,"FS")
|
"KRN",771,252,-1)
0^8
"KRN",771,252,0)
RA HOST 565^a^565^^^^USA
"KRN",771,252,"EC")
^~\&
"KRN",771,252,"FS")
|
"KRN",870,147,-1)
0^1
"KRN",870,147,0)
LA7RMTE1^^TCP^^^^^^^^^^^^^^^^^^10
"KRN",870,147,200)
^^^^^11^28
"KRN",870,147,400)
54.243.51.253^5026^C^N^^^^5026^
"KRN",870,148,-1)
0^2
"KRN",870,148,0)
SPOKE1^^TCP^^^^^^^^^^^^^^^^^^10
"KRN",870,148,3,0)
^870.02^1^1^3160308^^^^
"KRN",870,148,3,1,0)
Remote Ordering project Spoke 1
"KRN",870,148,200)
^5^245^10^60^^^^^I
"KRN",870,148,400)
54.157.56.194^5026^S^Y^^^^5027^
"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",470,-1)
1^1
"PKG",470,0)
ZZTEST^ZZZZ^TEST
"PKG",470,20,0)
^9.402P^^
"PKG",470,22,0)
^9.49I^1^1
"PKG",470,22,1,0)
2.0^3160906
"PKG",470,"VERSION")
2.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")
6
"RTN","LRHBR1")
0^1^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 2
"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^2^B169207416
"RTN","LRHBR2",1,0)
LRHBR2 ;LEIDOS/TCK - REMOTE ORDERING - REMOTE LAB/RAD ORDERS BY TEST/IMAGE ; 5/20/16 7:35am
"RTN","LRHBR2",2,0)
 ;;1.0;REMOTE ORDERS;;OCT 1,2016;Build 2
"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","LRRMTIN")
0^3^B22418784
"RTN","LRRMTIN",1,0)
LRRMTIN ;;LEIDOS/TCK - REMOTE ORDER - INCOMING ; 7/1/16 9:43am
"RTN","LRRMTIN",2,0)
 ;;1.0;REMOTE ORDERS;;OCT 1,2016;Build 2
"RTN","LRRMTIN",3,0)
 ; Reference to UNESC^ORHLESC supported by IA #4922
"RTN","LRRMTIN",4,0)
 ;; TEST
"RTN","LRRMTIN",5,0)
 ;
"RTN","LRRMTIN",6,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN",7,0)
EN ; Entry point for INCOMING ORDERS FROM A HOST FACILITY
"RTN","LRRMTIN",8,0)
 ;
"RTN","LRRMTIN",9,0)
 ;    Input: HLMTIEN - ^HL(772,IEN
"RTN","LRRMTIN",10,0)
 ;
"RTN","LRRMTIN",11,0)
 ;   Output: None.
"RTN","LRRMTIN",12,0)
 ;
"RTN","LRRMTIN",13,0)
 N I
"RTN","LRRMTIN",14,0)
 S (I,TYPE)="",ACKERR=0
"RTN","LRRMTIN",15,0)
 ;
"RTN","LRRMTIN",16,0)
 I $G(HLMTIEN)'>0 Q
"RTN","LRRMTIN",17,0)
 ;
"RTN","LRRMTIN",18,0)
 S REMOTE=1
"RTN","LRRMTIN",19,0)
 S HLMA=$O(^HLMA("B",HLMTIEN,""))
"RTN","LRRMTIN",20,0)
 I $G(HLMA)'>0 Q
"RTN","LRRMTIN",21,0)
 ;
"RTN","LRRMTIN",22,0)
 I '$D(^HLMA(HLMA,0)) Q
"RTN","LRRMTIN",23,0)
 I '$D(^HLMA(HLMA,"MSH")) Q
"RTN","LRRMTIN",24,0)
 ;
"RTN","LRRMTIN",25,0)
 I $P(^HLMA(HLMA,"MSH",1,0),"|",3)["LA7V HOST" S TYPE="LAB"
"RTN","LRRMTIN",26,0)
 I $P(^HLMA(HLMA,"MSH",1,0),"|",3)["RA HOST" S TYPE="RAD"
"RTN","LRRMTIN",27,0)
 S LOC=+$P(^HLMA(HLMA,"MSH",1,0),"|",4)
"RTN","LRRMTIN",28,0)
 S I=0 F  S I=$O(^HL(772,HLMTIEN,"IN",I)) Q:I=""  D
"RTN","LRRMTIN",29,0)
  .S REC(I)=^HL(772,HLMTIEN,"IN",I,0)
"RTN","LRRMTIN",30,0)
 ;
"RTN","LRRMTIN",31,0)
 M ^TMP("POLICY")=REC
"RTN","LRRMTIN",32,0)
 ;Q
"RTN","LRRMTIN",33,0)
 Q:'$D(REC)
"RTN","LRRMTIN",34,0)
 ;
"RTN","LRRMTIN",35,0)
 D EN^LRRMTIN1(.REC,TYPE,LOC)
"RTN","LRRMTIN",36,0)
 ;
"RTN","LRRMTIN",37,0)
 I 'ACKERR D ACK(HLMA,HLMTIEN,"AA")
"RTN","LRRMTIN",38,0)
 ;
"RTN","LRRMTIN",39,0)
 Q
"RTN","LRRMTIN",40,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN",41,0)
ACK(HLMA,HLMTIEN,CODE,ERR) ; This sub-routine will handle the Application Errors
"RTN","LRRMTIN",42,0)
 ;                   (AE) or Rejects (AR) or Accepts (AA) back to the
"RTN","LRRMTIN",43,0)
 ;                   Hub (Ordering Lab).
"RTN","LRRMTIN",44,0)
 ;
"RTN","LRRMTIN",45,0)
 ;    Input:    HLMA - ^HLMA IEN                        [required]
"RTN","LRRMTIN",46,0)
 ;           HLMTIEN - ^HL(772 IEN                      [required]
"RTN","LRRMTIN",47,0)
 ;              CODE - AA=Accept, AE=Error, AR=Reject   [optional]
"RTN","LRRMTIN",48,0)
 ;               ERR - Error Text to be returned.       [optional]
"RTN","LRRMTIN",49,0)
 ;
"RTN","LRRMTIN",50,0)
 ;   Output: None.
"RTN","LRRMTIN",51,0)
 ;
"RTN","LRRMTIN",52,0)
 N HLEID,HLEIDS,MSA1,PROT,SLOC
"RTN","LRRMTIN",53,0)
 ;
"RTN","LRRMTIN",54,0)
 S MSA1=$G(CODE) S:$G(ERR)="" MSA1="AA"     ; acknowledgement code
"RTN","LRRMTIN",55,0)
 S SLOC=+$P(^HLMA(HLMA,"MSH",1,0),"|",4)    ; sending facility
"RTN","LRRMTIN",56,0)
 S PROT="LA7V "_SLOC_" ORM-O01 EVENT"       ; event prototcol
"RTN","LRRMTIN",57,0)
 S HLEID=$O(^ORD(101,"B",PROT,0))           ; event protocol IEN
"RTN","LRRMTIN",58,0)
 S HL("MID")=$P(^HLMA(HLMA,0),U,2)          ; Message Control ID
"RTN","LRRMTIN",59,0)
 S HLEIDS=$P(^HLMA(HLMA,0),U,8)             ; Subscriber Protocol
"RTN","LRRMTIN",60,0)
 ;
"RTN","LRRMTIN",61,0)
 S HLA("HLS",1)="MSA|"_MSA1_"|"_HL("MID")_$S($G(ERR)]"":"|"_ERR,1:"")
"RTN","LRRMTIN",62,0)
 ;
"RTN","LRRMTIN",63,0)
 D GENERATE^HLMA(HLEID,"LM",1,.RESULT,"",.HLP)
"RTN","LRRMTIN",64,0)
 ;
"RTN","LRRMTIN",65,0)
 Q
"RTN","LRRMTIN",66,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN",67,0)
TEST(LROROUT,HLMTIEN) ; HLMTIEN=IEN to ^HL(772
"RTN","LRRMTIN",68,0)
 D EN
"RTN","LRRMTIN",69,0)
 Q
"RTN","LRRMTIN",70,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN",71,0)
GTDOM(R) ; Get the list of performing labs from the "E" cross reference.
"RTN","LRRMTIN",72,0)
 ;
"RTN","LRRMTIN",73,0)
 N NME,INST,CNT
"RTN","LRRMTIN",74,0)
 S (DOM,INST,R)=""
"RTN","LRRMTIN",75,0)
 Q:'$D(^DIC(4,"E"))
"RTN","LRRMTIN",76,0)
 ;
"RTN","LRRMTIN",77,0)
 F  S INST=$O(^DIC(4,"E",INST)) Q:INST=""  D
"RTN","LRRMTIN",78,0)
  .S NME=$$GET1^DIQ(4,INST,.01,"E")
"RTN","LRRMTIN",79,0)
  .S CNT=$G(CNT)+1
"RTN","LRRMTIN",80,0)
  .S R(CNT)=INST_U_NME
"RTN","LRRMTIN",81,0)
 ;
"RTN","LRRMTIN",82,0)
 Q
"RTN","LRRMTIN",83,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN",84,0)
DC(REC,ORID,ORVP,ORNP,ORL,REASON,DCORIG,ISNEWORD) ;
"RTN","LRRMTIN",85,0)
 N FLG,FLAG,LRSEND,LRODT,LRSN,LRSEND,ORN,LRIEN,LRFILE,LRAA,LRAN,LRAD
"RTN","LRRMTIN",86,0)
 S (FLG,FLAG)=0,(LRAA,LRAN,LRAD)=""
"RTN","LRRMTIN",87,0)
 S (DCORIG,ISNEWORD)=0
"RTN","LRRMTIN",88,0)
 I $G(REASON)'?.N,$D(^ORD(100.03,"B",REASON)) D
"RTN","LRRMTIN",89,0)
 .S REASIEN="",REASIEN=$O(^ORD(100.03,"B",REASON,REASIEN))
"RTN","LRRMTIN",90,0)
 I $G(REASIEN)>0 S REASON=REASIEN
"RTN","LRRMTIN",91,0)
 I $G(REASON)?.N S REASIEN=REASON
"RTN","LRRMTIN",92,0)
 I $G(REASIEN)="" S REASIEN=6
"RTN","LRRMTIN",93,0)
 S ORDNUM=+ORID
"RTN","LRRMTIN",94,0)
 S FILE=100,ORIEN=ORDNUM_","
"RTN","LRRMTIN",95,0)
 I $$GET1^DIQ(FILE,ORIEN,31,"I") D  Q:FLG
"RTN","LRRMTIN",96,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","LRRMTIN",97,0)
 Q:FLG
"RTN","LRRMTIN",98,0)
 S STATUS=$$GET1^DIQ(100,ORDNUM_",",5,"I")
"RTN","LRRMTIN",99,0)
 S PTYPE=$$GET1^DIQ(100,ORDNUM_",",12)
"RTN","LRRMTIN",100,0)
 ;4900 send error msg for a Lab DC try for a completed order
"RTN","LRRMTIN",101,0)
 I STATUS=2&(PTYPE'["RAD") D  Q
"RTN","LRRMTIN",102,0)
 .S REC(1)="Warning: Not cancelled. Lab order is already completed."
"RTN","LRRMTIN",103,0)
 I PTYPE'["RAD" D
"RTN","LRRMTIN",104,0)
 .S LRFILE=100,LRIEN=ORDNUM_","
"RTN","LRRMTIN",105,0)
 .S LRDATA=$$GET1^DIQ(LRFILE,LRIEN,33,"I") I LRDATA="" Q
"RTN","LRRMTIN",106,0)
 .S LRORD=$P(LRDATA,";"),LRODT=$P(LRDATA,";",2),LRSND=$P(LRDATA,";",3)
"RTN","LRRMTIN",107,0)
 .Q:$G(LRORD)=""
"RTN","LRRMTIN",108,0)
 .Q:$G(LRODT)=""
"RTN","LRRMTIN",109,0)
 .Q:$G(LRSND)=""
"RTN","LRRMTIN",110,0)
 .I '$D(^LRO(69,LRODT,1,LRSND)) Q
"RTN","LRRMTIN",111,0)
 .I '$D(^LRO(69,LRODT,1,LRSND,2)) Q
"RTN","LRRMTIN",112,0)
 .S LRSEND=0 F  S LRSEND=$O(^LRO(69,LRODT,1,LRSND,2,LRSEND)) Q:LRSEND'?.N  D
"RTN","LRRMTIN",113,0)
 ..S ORN=$P(^LRO(69,LRODT,1,LRSND,2,LRSEND,0),U,7)
"RTN","LRRMTIN",114,0)
 ..I ORN=ORDNUM D
"RTN","LRRMTIN",115,0)
 ...S LRSN=LRSND,LRI=LRSEND,ORIFN=ORN
"RTN","LRRMTIN",116,0)
 ...S LRTEST=$P(^LRO(69,LRODT,1,LRSND,2,LRSEND,0),U)
"RTN","LRRMTIN",117,0)
 ...S LRSS=$$GET1^DIQ(60,LRTEST,4,"I")
"RTN","LRRMTIN",118,0)
 ...S LIEN=LRSN_","_LRODT_","
"RTN","LRRMTIN",119,0)
 ...S LRDFN=$$GET1^DIQ(69.01,LIEN,.01,"I")
"RTN","LRRMTIN",120,0)
 ...S PNM=$$GET1^DIQ(2,ORVP,.01,"I"),LRDPF=2
"RTN","LRRMTIN",121,0)
 ...S LRAA=$P(^LRO(69,LRODT,1,LRSND,2,LRSEND,0),U,4)
"RTN","LRRMTIN",122,0)
 ...S LRAD=$P(^LRO(69,LRODT,1,LRSND,2,LRSEND,0),U,3)
"RTN","LRRMTIN",123,0)
 ...S LRAN=$P(^LRO(69,LRODT,1,LRSND,2,LRSEND,0),U,5)
"RTN","LRRMTIN",124,0)
 .I LRAA'="",LRAD'="",LRAN'="" S FLAG=1
"RTN","LRRMTIN",125,0)
 I 'FLAG D
"RTN","LRRMTIN",126,0)
 .D DC^ORWDXA(.REC,ORID,ORNP,ORL,REASON,DCORIG,ISNEWORD)
"RTN","LRRMTIN",127,0)
 .D BLDSND^LRRMTIN1(.REC,.ORWREC)
"RTN","LRRMTIN",128,0)
 .K REC S ES="AA",ORWLST=""
"RTN","LRRMTIN",129,0)
 .D SEND^ORWDX(.ORWLST,ORVP,ORNP,ORL,ES,.ORWREC)
"RTN","LRRMTIN",130,0)
 .M REC=ORWLST K ORWLST
"RTN","LRRMTIN",131,0)
 .D UPDTOR(ORID)
"RTN","LRRMTIN",132,0)
 ;
"RTN","LRRMTIN",133,0)
 Q
"RTN","LRRMTIN",134,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN",135,0)
UPDTOR(ORID) ;
"RTN","LRRMTIN",136,0)
 S USR=$P(^OR(100,+ORID,8,2,0),"^",3)
"RTN","LRRMTIN",137,0)
 S $P(^OR(100,+ORID,8,2,0),"^",5)=USR
"RTN","LRRMTIN",138,0)
 S $P(^OR(100,+ORID,8,2,0),"^",13)=USR
"RTN","LRRMTIN",139,0)
 ;
"RTN","LRRMTIN",140,0)
 Q
"RTN","LRRMTIN1")
0^4^B159894830
"RTN","LRRMTIN1",1,0)
LRRMTIN1 ;LEIDOS/TCK; REMOTE ORDERING; 12/14/15 6:09pm ; 9/5/16 11:39am
"RTN","LRRMTIN1",2,0)
 ;;1.0;Remote orders;;JAN 1, 2016;Build 2
"RTN","LRRMTIN1",3,0)
 ;
"RTN","LRRMTIN1",4,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN1",5,0)
EN(REC,TYPE,LOC) ; Continuation of EN^LRRMTIN
"RTN","LRRMTIN1",6,0)
 ;
"RTN","LRRMTIN1",7,0)
 ;    Input:  REC - ^HL(772 data                     [required]
"RTN","LRRMTIN1",8,0)
 ;           TYPE - Order type (Lab, Imaging,...)    [required]
"RTN","LRRMTIN1",9,0)
 ;            LOC - Sending Facility                 [required]
"RTN","LRRMTIN1",10,0)
 ;
"RTN","LRRMTIN1",11,0)
 ;   Output: None.
"RTN","LRRMTIN1",12,0)
 ;
"RTN","LRRMTIN1",13,0)
 K ORD,OR,OLDOR,ORNUM
"RTN","LRRMTIN1",14,0)
 ;
"RTN","LRRMTIN1",15,0)
 Q:'$D(REC)
"RTN","LRRMTIN1",16,0)
 ;
"RTN","LRRMTIN1",17,0)
 S ACT=""
"RTN","LRRMTIN1",18,0)
 D ACTION(.REC,.ACT,.ORN)   ; get the Order Action and Ordering Lab Number
"RTN","LRRMTIN1",19,0)
 ;
"RTN","LRRMTIN1",20,0)
 I TYPE="LAB" D GTLDATA(.REC,.ORVP,.ORNP,.ORL,.DLG,.ORDG,.ORIT,.ORIFN,.OLDOR,TYPE,.REAS)
"RTN","LRRMTIN1",21,0)
 I ACKERR Q
"RTN","LRRMTIN1",22,0)
 ;
"RTN","LRRMTIN1",23,0)
 B
"RTN","LRRMTIN1",24,0)
 I TYPE="RAD" D GTRDATA(.REC,.ORVP,.ORNP,.ORL,.DLG,.ORDG,.ORIT,.ORIFN,.OLDOR,TYPE,.REAS)
"RTN","LRRMTIN1",25,0)
 I ACKERR Q
"RTN","LRRMTIN1",26,0)
 ;
"RTN","LRRMTIN1",27,0)
 I ACT="NW" D
"RTN","LRRMTIN1",28,0)
 .S PKG=$S(DLG="RA OERR EXAM":"RAD",DLG="LR OTHER LAB TESTS":"LAB")
"RTN","LRRMTIN1",29,0)
 .Q:'$D(REC)
"RTN","LRRMTIN1",30,0)
 .D @PKG
"RTN","LRRMTIN1",31,0)
 .I ACKERR Q
"RTN","LRRMTIN1",32,0)
 .;I $D(REC) D GTDATA(.REC,.ORVP,.ORNP,.ORL,.DLG,.ORDG,.ORIT,.ORIFN,TYPE)
"RTN","LRRMTIN1",33,0)
 .S (STS,REAS,ORUSR,ORTYP)=""
"RTN","LRRMTIN1",34,0)
 .I $D(REC) D SAVE^ORWDX(.REC,ORVP,ORNP,ORL,DLG,ORDG,ORIT,ORIFN,.ORDIALOG,STS,REAS,ORUSR,ORTYP)
"RTN","LRRMTIN1",35,0)
 .Q:'$D(REC)
"RTN","LRRMTIN1",36,0)
 .D BLDSND(.REC,.ORWREC,.ORNUM)
"RTN","LRRMTIN1",37,0)
 .Q:ERR
"RTN","LRRMTIN1",38,0)
 .S ES="AA"
"RTN","LRRMTIN1",39,0)
 .K REC
"RTN","LRRMTIN1",40,0)
 .D SEND^ORWDX(.ORWLST,ORVP,ORNP,ORL,ES,.ORWREC)
"RTN","LRRMTIN1",41,0)
 .M REC=ORWLST K ORWLST
"RTN","LRRMTIN1",42,0)
 .D UPDTOR(ORNUM,ORNP),BLDXRF(OLDOR,ORNUM)
"RTN","LRRMTIN1",43,0)
 .D CLNOR(ORNUM)
"RTN","LRRMTIN1",44,0)
 I ACKERR Q
"RTN","LRRMTIN1",45,0)
 I (ACT["OC")!(ACT["CA")!(ACT["DC") D
"RTN","LRRMTIN1",46,0)
 .Q:'$D(^XTMP(TYPE))
"RTN","LRRMTIN1",47,0)
 .I $D(^XTMP(TYPE,ORN)) S ORIFN=^XTMP(TYPE,ORN)
"RTN","LRRMTIN1",48,0)
 .Q:$G(ORIFN)'>0
"RTN","LRRMTIN1",49,0)
 .S ORID=$G(ORIFN),STAT=$G(STS),(DCORIG,ISNEWORD)=0
"RTN","LRRMTIN1",50,0)
 .I ORID'="" D
"RTN","LRRMTIN1",51,0)
 ..; GET ORDER LOCATION
"RTN","LRRMTIN1",52,0)
 ..S ORL=+$$GET1^DIQ(100,ORID,6,"I")
"RTN","LRRMTIN1",53,0)
 ..I ORID'[";" S ORID=ORID_";1"
"RTN","LRRMTIN1",54,0)
 ..D DC^LRRMTIN(.REC,ORID,ORVP,ORNP,ORL,REAS,DCORIG,ISNEWORD)
"RTN","LRRMTIN1",55,0)
 ;
"RTN","LRRMTIN1",56,0)
 Q
"RTN","LRRMTIN1",57,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN1",58,0)
CLNOR(ORNUM) ;
"RTN","LRRMTIN1",59,0)
 Q:$G(ORNUM)'>0
"RTN","LRRMTIN1",60,0)
 S ORNUM=+ORNUM,ORIFN=ORNUM
"RTN","LRRMTIN1",61,0)
 I $D(^OR(100,ORIFN,8,1,.1)) S N=$P(^OR(100,ORIFN,8,1,.1,0),"^",3)
"RTN","LRRMTIN1",62,0)
 Q:$G(N)'>1
"RTN","LRRMTIN1",63,0)
 S ST=^OR(100,ORIFN,8,1,.1,2,0),ST=$TR(ST," ","")
"RTN","LRRMTIN1",64,0)
 I ST[":" S ST=$P(ST,":",2)
"RTN","LRRMTIN1",65,0)
 I ST?.A D
"RTN","LRRMTIN1",66,0)
 .S $P(^OR(100,ORIFN,8,1,.1,0),"^",3)=N-1,$P(^OR(100,ORIFN,8,1,.1,0),"^",4)=N-1
"RTN","LRRMTIN1",67,0)
 .K ^OR(100,ORIFN,8,1,.1,2,0)
"RTN","LRRMTIN1",68,0)
 ;
"RTN","LRRMTIN1",69,0)
 Q
"RTN","LRRMTIN1",70,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN1",71,0)
UPDTOR(ORNUM,ORNP) ;
"RTN","LRRMTIN1",72,0)
 Q:$G(OR)'>0
"RTN","LRRMTIN1",73,0)
 S ORNUM=+ORNUM
"RTN","LRRMTIN1",74,0)
 S LRIENS=1_","_ORNUM_","
"RTN","LRRMTIN1",75,0)
 S LRFDA(1,100.008,LRIENS,13)=ORNP
"RTN","LRRMTIN1",76,0)
 D UPDATE^DIE("","LRFDA(1)","LRMSG")
"RTN","LRRMTIN1",77,0)
 ;S LRIEN="+1,"_+OR_","
"RTN","LRRMTIN1",78,0)
 ;S LRFDA(2,100.002,LRIEN,.01)=$G(OLDOR)
"RTN","LRRMTIN1",79,0)
 ;D UPDATE^DIE("","LRFDA(2)","LRMSG")
"RTN","LRRMTIN1",80,0)
 ;
"RTN","LRRMTIN1",81,0)
 Q
"RTN","LRRMTIN1",82,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN1",83,0)
BLDXRF(OLDOR,ORNUM) ;
"RTN","LRRMTIN1",84,0)
 I '$D(^XTMP(TYPE)) D SETZERO(TYPE)
"RTN","LRRMTIN1",85,0)
 Q:'$D(^XTMP(TYPE))
"RTN","LRRMTIN1",86,0)
 I $D(^XTMP(TYPE)) D
"RTN","LRRMTIN1",87,0)
 .S ^XTMP(TYPE,+OLDOR)=+ORNUM
"RTN","LRRMTIN1",88,0)
 .S ^XTMP(TYPE,"B",+ORNUM)=+OLDOR
"RTN","LRRMTIN1",89,0)
 .S ^XTMP(TYPE,"CNT")=$G(^XTMP(TYPE,"CNT"))+1
"RTN","LRRMTIN1",90,0)
 I '$D(^XTMP(TYPE)) D SETZERO(TYPE)
"RTN","LRRMTIN1",91,0)
 ;
"RTN","LRRMTIN1",92,0)
 Q
"RTN","LRRMTIN1",93,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN1",94,0)
SETZERO(TYPE) ;
"RTN","LRRMTIN1",95,0)
 D NOW^%DTC S X1=$P(%,".",1),X2=365,Y=X1 D C^%DTC
"RTN","LRRMTIN1",96,0)
 S ^XTMP(TYPE,0)=X_"^"_Y_" OR XREF FOR REMOTE ORDER"
"RTN","LRRMTIN1",97,0)
 S ^XTMP(TYPE,0,"CNT")=0
"RTN","LRRMTIN1",98,0)
 ;
"RTN","LRRMTIN1",99,0)
 Q
"RTN","LRRMTIN1",100,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN1",101,0)
ACTION(REC,ACT,ORN) ; Search for order segment, return ordering lab
"RTN","LRRMTIN1",102,0)
 ;                    number, and order action.
"RTN","LRRMTIN1",103,0)
 ;
"RTN","LRRMTIN1",104,0)
 ;    Input: REC - ^HL(772 data                     [required]
"RTN","LRRMTIN1",105,0)
 ;
"RTN","LRRMTIN1",106,0)
 ;   Output: ACT - Order Control (NW=New, CA=Cancel, DC=Discontinue,
"RTN","LRRMTIN1",107,0)
 ;                                HD=Hold, RL=Release/cancel previous
"RTN","LRRMTIN1",108,0)
 ;                                hold, XO=Change/Update)
"RTN","LRRMTIN1",109,0)
 ;           ORN - Ordering Lab Number
"RTN","LRRMTIN1",110,0)
 ;
"RTN","LRRMTIN1",111,0)
 N I,STOP
"RTN","LRRMTIN1",112,0)
 ;
"RTN","LRRMTIN1",113,0)
 S (ACT,I)="",STOP=0
"RTN","LRRMTIN1",114,0)
 ;
"RTN","LRRMTIN1",115,0)
 F  S I=$O(REC(I)) Q:I=""  D  Q:STOP
"RTN","LRRMTIN1",116,0)
  .I $P(REC(I),"|")="ORC" D            ; order segment
"RTN","LRRMTIN1",117,0)
   ..S ORN=+$P(REC(I),"|",3)           ; Ordering Lab Number
"RTN","LRRMTIN1",118,0)
   ..S ACT=$P(REC(I),"|",2)            ; Order Action
"RTN","LRRMTIN1",119,0)
   ..S STOP=1
"RTN","LRRMTIN1",120,0)
 ;
"RTN","LRRMTIN1",121,0)
 Q
"RTN","LRRMTIN1",122,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN1",123,0)
BLDSND(REC,ORWREC,ORNUM) ;
"RTN","LRRMTIN1",124,0)
 Q:'$D(REC(1))
"RTN","LRRMTIN1",125,0)
 S ORNUM=$P(REC(1),"^")
"RTN","LRRMTIN1",126,0)
 S ORNUM=$E(ORNUM,2,99)
"RTN","LRRMTIN1",127,0)
 S ORWREC(1)=ORNUM_"^"_1_"^"_1_"^"_"E"
"RTN","LRRMTIN1",128,0)
 ;
"RTN","LRRMTIN1",129,0)
 Q
"RTN","LRRMTIN1",130,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN1",131,0)
GTRDATA(REC,ORVP,ORNP,ORL,DLG,ORDG,ORIT,ORIFN,OLDOR,TYPE,REAS) ;
"RTN","LRRMTIN1",132,0)
 ;
"RTN","LRRMTIN1",133,0)
 ;    Input: REC - ^HL(772 data                      [required]
"RTN","LRRMTIN1",134,0)
 ;           TYPE - Order type = RAD                 [required]
"RTN","LRRMTIN1",135,0)
 ;
"RTN","LRRMTIN1",136,0)
 ;    Output: None.
"RTN","LRRMTIN1",137,0)
 ;
"RTN","LRRMTIN1",138,0)
 N I,CNT
"RTN","LRRMTIN1",139,0)
 ;
"RTN","LRRMTIN1",140,0)
 S (ORVP,ORNP,ORL,DLG,ORDG,ORIT,ORIFN)=""
"RTN","LRRMTIN1",141,0)
 ;
"RTN","LRRMTIN1",142,0)
 S DLG="RA OERR EXAM"
"RTN","LRRMTIN1",143,0)
 S ORIT=$O(^ORD(101.41,"AB",DLG,0))
"RTN","LRRMTIN1",144,0)
 S ORDG=$O(^ORD(100.98,"B",TYPE,0))
"RTN","LRRMTIN1",145,0)
 B
"RTN","LRRMTIN1",146,0)
 S I="" F  S I=$O(REC(I)) Q:I=""  D
"RTN","LRRMTIN1",147,0)
 .S MSGNDE=REC(I),MSGTYP=$P($G(MSGNDE),"|")
"RTN","LRRMTIN1",148,0)
 .Q:MSGTYP=""
"RTN","LRRMTIN1",149,0)
 .Q:MSGTYP["BHS"
"RTN","LRRMTIN1",150,0)
 .I MSGTYP["MSH",$P(MSGNDE,"|",9)="ORR" Q
"RTN","LRRMTIN1",151,0)
 .I MSGTYP["PID" D
"RTN","LRRMTIN1",152,0)
 ..S ORVP=$P(MSGNDE,"|",4),ORVPNME=$P(MSGNDE,"|",6)
"RTN","LRRMTIN1",153,0)
 ..I $D(^DPT("B",ORVPNME)) D
"RTN","LRRMTIN1",154,0)
 ...S ORVP="",ORVP=$O(^DPT("B",ORVPNME,ORVP))
"RTN","LRRMTIN1",155,0)
 .I MSGTYP["PV1" D
"RTN","LRRMTIN1",156,0)
 ..S ORL=$P(REC(I),"|",4)
"RTN","LRRMTIN1",157,0)
 ..S CAT=$P(REC(I),"|",3)
"RTN","LRRMTIN1",158,0)
 .I MSGTYP["ORC" D
"RTN","LRRMTIN1",159,0)
 ..S OLDOR=+$P(MSGNDE,"|",3)
"RTN","LRRMTIN1",160,0)
 ..S ORNPNME=$P($P(MSGNDE,"|",13),"^",2)
"RTN","LRRMTIN1",161,0)
 ..I $D(^VA(200,"B",ORNPNME)) D
"RTN","LRRMTIN1",162,0)
 ...S ORNP="",ORNP=$O(^VA(200,"B",ORNPNME,ORNP)),ORUSR=ORNP,DUZ=ORNP
"RTN","LRRMTIN1",163,0)
 ..S DTDSIRED=$P($P(MSGNDE,"|",8),"^",4)
"RTN","LRRMTIN1",164,0)
 ..S URG=$P($P(MSGNDE,"|",8),"^",6)
"RTN","LRRMTIN1",165,0)
 ..I $G(URG)'="" S URIEN="",URIEN=$O(^ORD(101.42,"C",URG,URIEN))
"RTN","LRRMTIN1",166,0)
 ..I $G(URIEN)'="" S URG=URIEN
"RTN","LRRMTIN1",167,0)
 ..S REAS=$P($P(MSGNDE,"|",17),"^",5)
"RTN","LRRMTIN1",168,0)
 .I MSGTYP["OBR" D  Q:ACKERR
"RTN","LRRMTIN1",169,0)
 ..S OBRNDE=REC(I)
"RTN","LRRMTIN1",170,0)
 ..S PROC=$P($P(OBRNDE,"|",5),"^",4),PROCNME=$P($P(OBRNDE,"|",5),"^",5)
"RTN","LRRMTIN1",171,0)
 ..I PROCNME="" D  S ACKERR=1 Q
"RTN","LRRMTIN1",172,0)
 ...D ACK^LRRMTIN(HLMA,HLMTIEN,"AE","RAD PROCEDURE NOT FOUND")
"RTN","LRRMTIN1",173,0)
 ..S ISOL=$P(OBRNDE,"|",13) I ISOL'="" S ISOL=1
"RTN","LRRMTIN1",174,0)
 ..S PMOD=$P(OBRNDE,"|",19)
"RTN","LRRMTIN1",175,0)
 ..I $G(PMOD)'["~" D
"RTN","LRRMTIN1",176,0)
 ...S X=PMOD
"RTN","LRRMTIN1",177,0)
 ...Q:X=""
"RTN","LRRMTIN1",178,0)
 ...S PTR="",PTR=$O(^RAMIS(71.2,"B",X,PTR))
"RTN","LRRMTIN1",179,0)
 ...I PTR'="" S PMOD(1)=PTR
"RTN","LRRMTIN1",180,0)
 ..I $G(PMOD)["~" D
"RTN","LRRMTIN1",181,0)
 ...F III=1:1 S X=$P(PMOD,"~",III)  D  Q:X=""
"RTN","LRRMTIN1",182,0)
 ....Q:X=""
"RTN","LRRMTIN1",183,0)
 ....S PTR="",PTR=$O(^RAMIS(71.2,"B",X,PTR))
"RTN","LRRMTIN1",184,0)
 ....I PTR'="" S PMOD(III)=PTR
"RTN","LRRMTIN1",185,0)
 ..S MDE=$P(OBRNDE,"|",31),MDE=$E(MDE,1)
"RTN","LRRMTIN1",186,0)
 ..I REAS="" S REAS=$P($P(OBRNDE,"|",32),"^",2)
"RTN","LRRMTIN1",187,0)
 ..S LOC=565,LOCNME=$$GET1^DIQ(4,LOC,.01,"E")
"RTN","LRRMTIN1",188,0)
 ..S SBRQ=+$P(OBRNDE,"|",20)
"RTN","LRRMTIN1",189,0)
 .I MSGTYP["OBX" D  Q:ACKERR
"RTN","LRRMTIN1",190,0)
 ..S OBXNDE=REC(I)
"RTN","LRRMTIN1",191,0)
 ..S FLD=$P($P(OBXNDE,"|",4),"^",2)
"RTN","LRRMTIN1",192,0)
 ..I FLD["PRE-OP" D
"RTN","LRRMTIN1",193,0)
 ...S PREOP=$P(OBXNDE,"|",6),PREOP=$$HL7TFM^XLFDT(PREOP)
"RTN","LRRMTIN1",194,0)
 ..I FLD["PREG" D
"RTN","LRRMTIN1",195,0)
 ...S PREG=$P(OBXNDE,"|",6),PREG=$E(PREG,1)
"RTN","LRRMTIN1",196,0)
 ..I FLD["CLINICAL" D
"RTN","LRRMTIN1",197,0)
 ...I '$D(BCH) S CNT=1,BCH(CNT)=$P(OBXNDE,"|",6)
"RTN","LRRMTIN1",198,0)
 ...I $D(BCH) S CNT=$O(BCH(99),-1),CNT=$G(CNT)+1,BCH(CNT)=$P(OBXNDE,"|",6)
"RTN","LRRMTIN1",199,0)
 W !,"END OF GETRDATA"
"RTN","LRRMTIN1",200,0)
 B
"RTN","LRRMTIN1",201,0)
 ;
"RTN","LRRMTIN1",202,0)
 Q
"RTN","LRRMTIN1",203,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN1",204,0)
GTLDATA(REC,ORVP,ORNP,ORL,DLG,ORDG,ORIT,ORIFN,OLDOR,TYPE,REAS) ;
"RTN","LRRMTIN1",205,0)
 ;
"RTN","LRRMTIN1",206,0)
 ;    Function: get lab data in HL7 MESSAGE
"RTN","LRRMTIN1",207,0)
 ;       Input:  REC - ^HL(772 data                     [required]
"RTN","LRRMTIN1",208,0)
 ;              TYPE - Order type = LAB                 [required]
"RTN","LRRMTIN1",209,0)
 ;
"RTN","LRRMTIN1",210,0)
 ;   Output: None.
"RTN","LRRMTIN1",211,0)
 ;
"RTN","LRRMTIN1",212,0)
 N I,CNT
"RTN","LRRMTIN1",213,0)
 ;
"RTN","LRRMTIN1",214,0)
 S (ORVP,ORNP,ORL,DLG,ORDG,ORIT,ORIFN)=""
"RTN","LRRMTIN1",215,0)
 ;
"RTN","LRRMTIN1",216,0)
 S DLG="LR OTHER LAB TESTS"
"RTN","LRRMTIN1",217,0)
 ;I TYPE="RAD" S DLG="RA OERR EXAM"
"RTN","LRRMTIN1",218,0)
 S ORIT=$O(^ORD(101.41,"AB",DLG,0))
"RTN","LRRMTIN1",219,0)
 S ORDG=$O(^ORD(100.98,"B",TYPE,0))
"RTN","LRRMTIN1",220,0)
 S I="" F  S I=$O(REC(I)) Q:I=""  D
"RTN","LRRMTIN1",221,0)
 .S MSGNDE=REC(I),MSGTYP=$P($G(MSGNDE),"|")
"RTN","LRRMTIN1",222,0)
 .Q:MSGTYP=""
"RTN","LRRMTIN1",223,0)
 .Q:MSGTYP["BHS"
"RTN","LRRMTIN1",224,0)
 .I MSGTYP["MSH",$P(MSGNDE,"|",9)="ORR" Q
"RTN","LRRMTIN1",225,0)
 .I MSGTYP["PID" D
"RTN","LRRMTIN1",226,0)
 ..S ORVP=$P(MSGNDE,"|",4),ORVPNME=$P(MSGNDE,"|",6)
"RTN","LRRMTIN1",227,0)
 ..I $D(^DPT("B",ORVPNME)) D
"RTN","LRRMTIN1",228,0)
 ...S ORVP="",ORVP=$O(^DPT("B",ORVPNME,ORVP))
"RTN","LRRMTIN1",229,0)
 .I MSGTYP["PV1" D
"RTN","LRRMTIN1",230,0)
 ..S ORL=$P(REC(I),"|",4)
"RTN","LRRMTIN1",231,0)
 .I MSGTYP["ORC" D
"RTN","LRRMTIN1",232,0)
 ..S OLDOR=+$P(MSGNDE,"|",3)
"RTN","LRRMTIN1",233,0)
 ..S ORNPNME=$P($P(MSGNDE,"|",13),"^",2)
"RTN","LRRMTIN1",234,0)
 ..I $D(^VA(200,"B",ORNPNME)) D
"RTN","LRRMTIN1",235,0)
 ...S ORNP="",ORNP=$O(^VA(200,"B",ORNPNME,ORNP)),DUZ=ORNP,ORUSR=ORNP
"RTN","LRRMTIN1",236,0)
 ..S COL=$P($P(MSGNDE,"|",8),"^",4)
"RTN","LRRMTIN1",237,0)
 ..S COL=$$HL7TFM^XLFDT(COL,"L")
"RTN","LRRMTIN1",238,0)
 ..;I $P(COL,".",2)="" S COL="TODAY"
"RTN","LRRMTIN1",239,0)
 ..S COLLECTIONDATETIME=COL
"RTN","LRRMTIN1",240,0)
 ..S START=COLLECTIONDATETIME
"RTN","LRRMTIN1",241,0)
 ..S REAS=$P($P(MSGNDE,"|",17),"^",4)
"RTN","LRRMTIN1",242,0)
 .I MSGTYP["OBR" D  Q:ACKERR
"RTN","LRRMTIN1",243,0)
 ..S OBRNDE=REC(I)
"RTN","LRRMTIN1",244,0)
 ..S TSTNDE=$P(OBRNDE,"|",5)
"RTN","LRRMTIN1",245,0)
 ..I TSTNDE'="" S TSTNME=$P(TSTNDE,"^",5)
"RTN","LRRMTIN1",246,0)
 ..I TSTNME="" D  S ACKERR=1 Q
"RTN","LRRMTIN1",247,0)
 ...D ACK^LRRMTIN(HLMA,HLMTIEN,"AE","LAB TEST NOT FOUND")
"RTN","LRRMTIN1",248,0)
 ..I '$D(^LAB(60,"B",TSTNME)) D  S ACKERR=1 Q
"RTN","LRRMTIN1",249,0)
 ...D ACK^LRRMTIN(HLMA,HLMTIEN,"AE","LAB TEST NOT FOUND")
"RTN","LRRMTIN1",250,0)
 ..S LABTEST="",LABTEST=$O(^LAB(60,"B",TSTNME,LABTEST))
"RTN","LRRMTIN1",251,0)
 ..I LABTEST="" D  S ACKERR=1 Q
"RTN","LRRMTIN1",252,0)
 ...D ACK^LRRMTIN(HLMA,HLMTIEN,"AE","LAB TEST NOT FOUND")
"RTN","LRRMTIN1",253,0)
 ..S SAMPLE=$P(OBRNDE,"|",16),SAMPLE=+$P(SAMPLE,"^",4)
"RTN","LRRMTIN1",254,0)
 ..S SPECIMEN=$P(OBRNDE,"|",16),SPECIMEN=$P(SPECIMEN,";",4)
"RTN","LRRMTIN1",255,0)
 ..S COLLECTEDBY="SP",HOWOFTEN=28
"RTN","LRRMTIN1",256,0)
 ..S URG=$P($P(OBRNDE,"|",28),"^",6),URGENCY=$P(URG,";",2)
"RTN","LRRMTIN1",257,0)
 ..S LOC=565
"RTN","LRRMTIN1",258,0)
 ..S LOCNME=$$GET1^DIQ(4,LOC,.01,"E")
"RTN","LRRMTIN1",259,0)
 K OR,ORDT,ORD
"RTN","LRRMTIN1",260,0)
 ;
"RTN","LRRMTIN1",261,0)
 Q
"RTN","LRRMTIN1",262,0)
 ;--------------------------------------------------------------------
"RTN","LRRMTIN1",263,0)
RAD ;
"RTN","LRRMTIN1",264,0)
 N DA,NDE,TMP,CTYP,CTYPE,OI,JVORD,D,UR,HL,HO
"RTN","LRRMTIN1",265,0)
 S ERR=0,(OI,OR)=""
"RTN","LRRMTIN1",266,0)
 Q:$G(ORIT)'>0
"RTN","LRRMTIN1",267,0)
 K ORDIALOG D BLDARY(ORIT,.OR,.ORT)
"RTN","LRRMTIN1",268,0)
 K ORDIALOG
"RTN","LRRMTIN1",269,0)
 B
"RTN","LRRMTIN1",270,0)
 S VAL="" F  S VAL=$O(ORT(VAL)) Q:VAL=""!(ERR)  D  Q:ACKERR
"RTN","LRRMTIN1",271,0)
 .S (CTYP,CTYPE)=""
"RTN","LRRMTIN1",272,0)
 .S STRG=VAL
"RTN","LRRMTIN1",273,0)
 .I $TR(STRG," ")="PROCEDURE" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D  Q:ACKERR
"RTN","LRRMTIN1",274,0)
 ..Q:$G(PROC)'>0
"RTN","LRRMTIN1",275,0)
 ..S TEST=PROC_";99RAP"
"RTN","LRRMTIN1",276,0)
 ..D GETOINUM^ORWDCN32(.OI,TEST)
"RTN","LRRMTIN1",277,0)
 ..I $G(OI)="" D  S ACKERR=1 Q
"RTN","LRRMTIN1",278,0)
 ...D ACK^LRRMTIN(HLMA,HLMTIEN,"AE","Radiology order number is missing or invalid.")
"RTN","LRRMTIN1",279,0)
 ..;I $G(OI)="" S ERR=1,LSTN=LSTN+1,REC(LSTN)="Error: Radiology order number is missing or invalid." Q
"RTN","LRRMTIN1",280,0)
 ..S ORDIALOG(NN,1)=$G(OI)      D
"RTN","LRRMTIN1",281,0)
 ..K ORT(STRG)
"RTN","LRRMTIN1",282,0)
 .I $TR(STRG," ")="MODEOFTRANSPORT" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",283,0)
 ..S ORDIALOG(NN,1)=$G(MDE)
"RTN","LRRMTIN1",284,0)
 ..K ORT(STRG)
"RTN","LRRMTIN1",285,0)
 .I $TR(STRG," ")="DATEDESIRED" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",286,0)
 ..S DTDSIRED=$$HL7TFM^XLFDT(DTDSIRED)
"RTN","LRRMTIN1",287,0)
 ..S ORDIALOG(NN,1)=$G(DTDSIRED)
"RTN","LRRMTIN1",288,0)
 .I $TR(STRG," ")="REASONFORSTUDY" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",289,0)
 ..S ORDIALOG(NN,1)=$G(REAS)
"RTN","LRRMTIN1",290,0)
 .I $TR(STRG," ")="PREGNANT" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",291,0)
 ..S ORDIALOG(NN,1)=$G(PREG)
"RTN","LRRMTIN1",292,0)
 ..K ORT(STRG)
"RTN","LRRMTIN1",293,0)
 .I $TR(STRG," ")="PRE-OPSCHEDULEDDATE/TIME" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",294,0)
 ..S ORDIALOG(NN,1)=$G(PREOP)
"RTN","LRRMTIN1",295,0)
 .I $TR(STRG," ")="CLINICALHISTORY" S NN="",NN=$O(ORT(STRG,"")) D
"RTN","LRRMTIN1",296,0)
 ..Q:'$D(BCH)
"RTN","LRRMTIN1",297,0)
 ..D BLDWP(NN,.BCH)
"RTN","LRRMTIN1",298,0)
 ..;S ORDIALOG(NN,1)=$G(BCH) D BLDWP(NN,BCH)
"RTN","LRRMTIN1",299,0)
 .I $TR(STRG," ")="SUBMITREQUESTTO" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",300,0)
 ..S ORDIALOG(NN,1)=$G(SBRQ)
"RTN","LRRMTIN1",301,0)
 ..K ORT(STRG)
"RTN","LRRMTIN1",302,0)
 .I $TR(STRG," ")="PROCEDUREMODIFIER" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",303,0)
 ..Q:'$D(PMOD(1))
"RTN","LRRMTIN1",304,0)
 ..S CNT="" F  S CNT=$O(PMOD(CNT)) Q:CNT=""  D
"RTN","LRRMTIN1",305,0)
 ...Q:$G(CNT)'>0
"RTN","LRRMTIN1",306,0)
 ...S ORDIALOG(NN,CNT)=$G(PMOD(CNT))
"RTN","LRRMTIN1",307,0)
 ..K ORT(STRG)
"RTN","LRRMTIN1",308,0)
 .I $TR(STRG," ")="CATEGORY" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",309,0)
 ..S ORDIALOG(NN,1)=$G(CAT)
"RTN","LRRMTIN1",310,0)
 .I $TR(STRG," ")="URGENCY" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",311,0)
 ..S ORDIALOG(NN,1)=$G(URG)
"RTN","LRRMTIN1",312,0)
 ..K ORT(STRG)
"RTN","LRRMTIN1",313,0)
 .I $TR(STRG," ")="ORDERINGLOCATION" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",314,0)
 ..S ORDIALOG(NN,1)=$G(ORL)
"RTN","LRRMTIN1",315,0)
 .I $TR(STRG," ")="APPROVINGRAD/NUCMEDPHYS" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",316,0)
 ..S ORDIALOG(NN,1)=$G(ORNP)
"RTN","LRRMTIN1",317,0)
  .I $TR(STRG," ")="ISPATIENTONISOLATIONPROCEDURES?" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",318,0)
 ..S ORDIALOG(NN,1)=$G(ISOL)
"RTN","LRRMTIN1",319,0)
 .I $TR(STRG," ")="LOCATION" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",320,0)
 ..S ORDIALOG(NN,1)=$G(LOCNME)
"RTN","LRRMTIN1",321,0)
 Q
"RTN","LRRMTIN1",322,0)
 ;
"RTN","LRRMTIN1",323,0)
LAB ;
"RTN","LRRMTIN1",324,0)
 N DA,NDE,TMP,CTYP,CTYPE,OI,JVORD,D,UR,HL,HO
"RTN","LRRMTIN1",325,0)
 S ERR=0,(OI,OR)=""
"RTN","LRRMTIN1",326,0)
 Q:$G(ORIT)'>0
"RTN","LRRMTIN1",327,0)
 K ORDIALOG D BLDARY(ORIT,.OR,.ORT)
"RTN","LRRMTIN1",328,0)
 K ORDIALOG ;M ORDIALOG=ORD K ORD
"RTN","LRRMTIN1",329,0)
 S VAL="" F  S VAL=$O(ORT(VAL)) Q:VAL=""!(ERR)  D  Q:ACKERR
"RTN","LRRMTIN1",330,0)
 .S (CTYP,CTYPE)=""
"RTN","LRRMTIN1",331,0)
 .S STRG=VAL
"RTN","LRRMTIN1",332,0)
 .I $TR(STRG," ")="LABTEST" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D  Q:ACKERR
"RTN","LRRMTIN1",333,0)
 ..Q:$G(LABTEST)'>0
"RTN","LRRMTIN1",334,0)
 ..S TST=LABTEST_";99LRT"
"RTN","LRRMTIN1",335,0)
 ..D GETOINUM^ORWDCN32(.OI,TST)
"RTN","LRRMTIN1",336,0)
 ..I $G(OI)="" D  S ACKERR=1 Q
"RTN","LRRMTIN1",337,0)
 ...D ACK^LRRMTIN(HLMA,HLMTIEN,"AE","Laboratory order number is missing or invalid.")
"RTN","LRRMTIN1",338,0)
 ..S ORDIALOG(NN,1)=$G(OI)
"RTN","LRRMTIN1",339,0)
 ..K ORT(STRG)
"RTN","LRRMTIN1",340,0)
 .I $TR(STRG," ")="COLLECTIONDATE/TIME" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",341,0)
 ..S ORDIALOG(NN,1)=$G(START)
"RTN","LRRMTIN1",342,0)
 ..K ORT(STRG)
"RTN","LRRMTIN1",343,0)
 .;I $TR(STRG," ")="COMMENTS" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",344,0)
 ..;S ORDIALOG(NN,1)=COMMENT I COMMENT'="" D BLDWP(NN,COMMENT)
"RTN","LRRMTIN1",345,0)
 .I $TR(STRG," ")="COLLECTEDBY" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",346,0)
 ..S ORDIALOG(NN,1)="SP"
"RTN","LRRMTIN1",347,0)
 .I $TR(STRG," ")="HOWOFTEN" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",348,0)
 ..S ORDIALOG(NN,1)=28
"RTN","LRRMTIN1",349,0)
 ..K ORT(STRG)
"RTN","LRRMTIN1",350,0)
 .I $TR(STRG," ")="SPECIMEN" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",351,0)
 ..S ORDIALOG(NN,1)=SAMPLE
"RTN","LRRMTIN1",352,0)
 ..K ORT(STRG)
"RTN","LRRMTIN1",353,0)
 .I $TR(STRG," ")="COLLECTIONSAMPLE" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",354,0)
 ..S ORDIALOG(NN,1)=SPECIMEN
"RTN","LRRMTIN1",355,0)
 ..K ORT(STRG)
"RTN","LRRMTIN1",356,0)
 .I $TR(STRG," ")="URGENCY" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",357,0)
 ..S ORDIALOG(NN,1)=$G(URGENCY)
"RTN","LRRMTIN1",358,0)
 ..K ORT(STRG)
"RTN","LRRMTIN1",359,0)
 .I $TR(STRG," ")="LOCATION" S NN="",NN=$O(ORT(STRG,"")),ORDIALOG(NN,1)="" D
"RTN","LRRMTIN1",360,0)
 ..S ORDIALOG(NN,1)=$G(LOCNME)
"RTN","LRRMTIN1",361,0)
 ;
"RTN","LRRMTIN1",362,0)
 Q
"RTN","LRRMTIN1",363,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN1",364,0)
BLDWP(NN,BCH) ;
"RTN","LRRMTIN1",365,0)
 B
"RTN","LRRMTIN1",366,0)
 N I
"RTN","LRRMTIN1",367,0)
 ;S ORDIALOG(NN,1)="ORDIALOG(""WP"","_NN_",1)"
"RTN","LRRMTIN1",368,0)
 S CNT=99,CNT=$O(BCH(CNT),-1)
"RTN","LRRMTIN1",369,0)
 F I=1:1:CNT D
"RTN","LRRMTIN1",370,0)
 .S ORDIALOG("WP",NN,1,I,0)=$G(BCH(I))
"RTN","LRRMTIN1",371,0)
 S ORDIALOG(NN,1)="ORDIALOG(""WP"","_NN_",1)"
"RTN","LRRMTIN1",372,0)
 ;
"RTN","LRRMTIN1",373,0)
 Q
"RTN","LRRMTIN1",374,0)
 ;-----------------------------------------------------------------------
"RTN","LRRMTIN1",375,0)
BLDARY(ORIT,OR,ORT) ;
"RTN","LRRMTIN1",376,0)
 Q:$G(ORIT)'>0
"RTN","LRRMTIN1",377,0)
 N TXT,TMP,NM
"RTN","LRRMTIN1",378,0)
 ;S (ORDT("B"))="",ORD=""
"RTN","LRRMTIN1",379,0)
 D GETDLG^ORCD(ORIT)
"RTN","LRRMTIN1",380,0)
 S TXT="" F  S TXT=$O(ORDIALOG("B",TXT)) Q:TXT=""  D
"RTN","LRRMTIN1",381,0)
 .S TMP=$TR(TXT," "),ORDT("B",TMP)=ORDIALOG("B",TXT)
"RTN","LRRMTIN1",382,0)
 S TXT="" F  S TXT=$O(ORDT("B",TXT)) Q:TXT=""  D
"RTN","LRRMTIN1",383,0)
 .I $D(ORDT("B",$TR(TXT," "))) S NM=$P($G(ORDT("B",$TR(TXT," "))),U,2)
"RTN","LRRMTIN1",384,0)
 .S ORD(NM,1)="" S ORD(NM,1)=ORDT("B",TXT) S ORT(TXT,NM)="" S ORT(TXT,NM)=ORD(NM,1)
"RTN","LRRMTIN1",385,0)
 Q
"RTN","LRRMTOUT")
0^5^B23245720
"RTN","LRRMTOUT",1,0)
LRRMTOUT ;SAIC/TCK - REMOT~E ORDERING ; 7/31/16 8:36pm
"RTN","LRRMTOUT",2,0)
 ;;1.0;REMOTE ORDERING;;DEC 28, 2015;Build 2
"RTN","LRRMTOUT",3,0)
 Q
"RTN","LRRMTOUT",4,0)
 ;
"RTN","LRRMTOUT",5,0)
EN(MSG1,MSG2) ;Pass in message from VistA or CPRS
"RTN","LRRMTOUT",6,0)
 N HLA,PROT,PR,REC,FLG S (CHK,FLG)=0
"RTN","LRRMTOUT",7,0)
 Q:$G(REMOTE)=1
"RTN","LRRMTOUT",8,0)
 M XQORMSG=MSG2
"RTN","LRRMTOUT",9,0)
 I $D(MSG1)>1 M REC=XQORMSG M ^TMP=REC D GENMSG(.REC)
"RTN","LRRMTOUT",10,0)
 I $G(MSG2)'="" I $G(ORAPMSG)'="" M REC=@ORAPMSG D GENMSG(.REC)
"RTN","LRRMTOUT",11,0)
 I $G(MSG2)'="",$G(XQORMSG)'="" M REC=@XQORMSG D GENMSG(.REC)
"RTN","LRRMTOUT",12,0)
 I $G(MSG1)["TMP" M REC=@XQORMSG D GENMSG(.REC)
"RTN","LRRMTOUT",13,0)
 I $G(MSG)["TMP" M REC=@MSG D GENMSG(.REC)
"RTN","LRRMTOUT",14,0)
 K MSG,MSG1,REC,CHK,FLG,ODC,AP,VFGL,STOP,CHG,MSGTYP,MSGNDE
"RTN","LRRMTOUT",15,0)
 Q
"RTN","LRRMTOUT",16,0)
 ;
"RTN","LRRMTOUT",17,0)
GENMSG(REC) ;
"RTN","LRRMTOUT",18,0)
 S (CCDE,ZCNT,CDE)="",(CHK,FLG,ODC,AP,VFLG,STOP,CHG)=0,D1="|",D2="^"
"RTN","LRRMTOUT",19,0)
 F  S ZCNT=$O(REC(ZCNT)) Q:ZCNT=""  D  Q:FLG=2
"RTN","LRRMTOUT",20,0)
 .S MSGNDE=REC(ZCNT),MSGTYP=$P(MSGNDE,"|"),CCDE=$P(MSGNDE,"|",2)
"RTN","LRRMTOUT",21,0)
 .Q:MSGTYP=""
"RTN","LRRMTOUT",22,0)
 .Q:$G(CCDE)=""&(MSGTYP'="NTE")
"RTN","LRRMTOUT",23,0)
 .S TYP="LAB"
"RTN","LRRMTOUT",24,0)
 .;I MSGTYP="MSH" S TYP=$P(MSGNDE,"|",3),TYP=$E(TYP,1,3)
"RTN","LRRMTOUT",25,0)
 .;I TYP="" S TYP="LAB"
"RTN","LRRMTOUT",26,0)
 .;I TYP'="",TYP'["LAB" S TYP="LAB"
"RTN","LRRMTOUT",27,0)
 .I MSGTYP="ORC" D  Q:FLG
"RTN","LRRMTOUT",28,0)
 ..S ORN=$P(MSGNDE,"|",3),OR=+ORN
"RTN","LRRMTOUT",29,0)
 ..I CCDE="NA" S FLG=2 Q
"RTN","LRRMTOUT",30,0)
 ..I CCDE="SN" S FLG=2 Q
"RTN","LRRMTOUT",31,0)
 ..I CCDE="NW" S FLG=2 Q
"RTN","LRRMTOUT",32,0)
 ..I CCDE="OC" S FLG=1
"RTN","LRRMTOUT",33,0)
 ..I CCDE="CA" S FLG=1
"RTN","LRRMTOUT",34,0)
 ..I CCDE="DC",$P(MSGNDE,"|",4) S FLG=1
"RTN","LRRMTOUT",35,0)
 ..;I CCDE="DC",$P(MSGNDE,"|",4)'["RA" S TYP="LAB",FLG=1
"RTN","LRRMTOUT",36,0)
 ..I CCDE="SC" S CDE="SC",FLG=1
"RTN","LRRMTOUT",37,0)
 ..I CCDE="RE" S CDE="RE",FLG=1
"RTN","LRRMTOUT",38,0)
 ..S ORN=$P(MSGNDE,"|",3),OR=+ORN
"RTN","LRRMTOUT",39,0)
 ..S $P(REC(ZCNT),"|",14)=565
"RTN","LRRMTOUT",40,0)
 ..I $G(OR)>0,$D(^XTMP(TYP,"B")),$D(^XTMP(TYP,"B",OR)) S ORIFN=^XTMP(TYP,"B",OR)
"RTN","LRRMTOUT",41,0)
 ..I $G(ORIFN)>0 S ORIFN=ORIFN_";1^OR",$P(REC(ZCNT),"|",3)=ORIFN
"RTN","LRRMTOUT",42,0)
 .I MSGTYP="OBR" D
"RTN","LRRMTOUT",43,0)
 ..Q:CDE'="SC"
"RTN","LRRMTOUT",44,0)
 ..S CDE=""
"RTN","LRRMTOUT",45,0)
 ..S ACC=$P(REC(ZCNT),"|",21)
"RTN","LRRMTOUT",46,0)
 ..S LRTST=$P($P(REC(ZCNT),D1,5),D2,4)
"RTN","LRRMTOUT",47,0)
 ..D GTUID(.UID,ZCNT,LRTST,OR)
"RTN","LRRMTOUT",48,0)
 ..I $G(UID)="" S FLG=2 Q
"RTN","LRRMTOUT",49,0)
 .I MSGTYP="OBX" D
"RTN","LRRMTOUT",50,0)
 ..I $P(REC(ZCNT),"|",9)["HH" S $P(REC(ZCNT),"|",9)="H*"
"RTN","LRRMTOUT",51,0)
 ..I $P(REC(ZCNT),"|",9)["LL" S $P(REC(ZCNT),"|",9)="L*"
"RTN","LRRMTOUT",52,0)
 .I MSGTYP="NTE" D FIXNTE(.REC,ZCNT)
"RTN","LRRMTOUT",53,0)
 I $G(FLG)=1 D
"RTN","LRRMTOUT",54,0)
 .Q:$G(ORN)'>0
"RTN","LRRMTOUT",55,0)
 .Q:'FLG
"RTN","LRRMTOUT",56,0)
 .Q:FLG=2
"RTN","LRRMTOUT",57,0)
 .D GTNME(.REC)
"RTN","LRRMTOUT",58,0)
 .I $G(ORIFN)[";" S ORIFN=+ORIFN
"RTN","LRRMTOUT",59,0)
 .I $G(ORDERID)>0,ORDERID[";" S ORIFN=+ORDERID
"RTN","LRRMTOUT",60,0)
 .D GTREM(.PROT,OR,TYP)
"RTN","LRRMTOUT",61,0)
 .M HLA("HLS")=REC K HLA("HLS",1) D GENERATE^HLMA($O(^ORD(101,"B",PROT,0)),"LM",1,.HLREST,"",.HLP) S FLG=3
"RTN","LRRMTOUT",62,0)
 Q
"RTN","LRRMTOUT",63,0)
 ;
"RTN","LRRMTOUT",64,0)
FIXNTE(REC,ZCNT) ;
"RTN","LRRMTOUT",65,0)
 N CNT,INDX
"RTN","LRRMTOUT",66,0)
 S INDX="",CNT=ZCNT,AMEND=0
"RTN","LRRMTOUT",67,0)
 F  S INDX=$O(REC(ZCNT,INDX)) Q:INDX=""  D
"RTN","LRRMTOUT",68,0)
 .Q:$G(INDX)'>0
"RTN","LRRMTOUT",69,0)
 .;I INDX<TOT K REC(ZCNT,INDX)
"RTN","LRRMTOUT",70,0)
 .S TXT=REC(ZCNT,INDX)
"RTN","LRRMTOUT",71,0)
 .I TXT["reported" S AMEND=1
"RTN","LRRMTOUT",72,0)
 .I TXT["Ordering" K REC(ZCNT,INDX) Q
"RTN","LRRMTOUT",73,0)
 .I $E(TXT,1)=" " K REC(ZCNT,INDX) Q
"RTN","LRRMTOUT",74,0)
 .I TXT["Report" K REC(ZCNT,INDX) Q
"RTN","LRRMTOUT",75,0)
 .I TXT["Performing" K REC(ZCNT,INDX) Q
"RTN","LRRMTOUT",76,0)
 .I $E(TXT,1,4)="" K REC(ZCNT,INDX) Q
"RTN","LRRMTOUT",77,0)
 .I $E(TXT,1,5)["NP" S REC(ZCNT)=REC(ZCNT)_TXT K REC(ZCNT,INDX)
"RTN","LRRMTOUT",78,0)
 I AMEND D
"RTN","LRRMTOUT",79,0)
 .;S TOT=$O(REC(ZCNT,9999),-2)
"RTN","LRRMTOUT",80,0)
 .;I TOT>2 S TOT=TOT-1
"RTN","LRRMTOUT",81,0)
 .S INDX="",CNT=ZCNT
"RTN","LRRMTOUT",82,0)
 .F  S INDX=$O(REC(ZCNT,INDX)) Q:INDX=""  D
"RTN","LRRMTOUT",83,0)
 ..Q:$G(INDX)'>0
"RTN","LRRMTOUT",84,0)
 ..;I INDX<TOT K REC(ZCNT,INDX) Q
"RTN","LRRMTOUT",85,0)
 ..S TXT=REC(ZCNT,INDX),N=$G(N)+1
"RTN","LRRMTOUT",86,0)
 ..Q:$G(TXT)=""
"RTN","LRRMTOUT",87,0)
 ..S CNT=$G(CNT)+1
"RTN","LRRMTOUT",88,0)
 ..S REC(CNT)="NTE|"_N_"|L|"_TXT K REC(ZCNT,INDX)
"RTN","LRRMTOUT",89,0)
 S I=$P(REC(ZCNT),"|")
"RTN","LRRMTOUT",90,0)
 Q:I'="NTE"
"RTN","LRRMTOUT",91,0)
 ;I $P(REC(ZCNT),"|",2)="" K REC(ZCNT)
"RTN","LRRMTOUT",92,0)
 Q
"RTN","LRRMTOUT",93,0)
 ;
"RTN","LRRMTOUT",94,0)
GTUID(UID,ZCNT,LRTST,OR) ;
"RTN","LRRMTOUT",95,0)
 S LRDATA=^OR(100,OR,4)
"RTN","LRRMTOUT",96,0)
 S LRORD=$P(LRDATA,";"),LRODT=$P(LRDATA,";",2),LRSN=$P(LRDATA,";",3)
"RTN","LRRMTOUT",97,0)
 S LRSND="",LRSND=$O(^LRO(69,LRODT,1,LRSN,2,"B",LRTST,LRSND))
"RTN","LRRMTOUT",98,0)
 I '$D(^LRO(69,LRODT,1,LRSN,2,LRSND,.3)) S UID=0 Q
"RTN","LRRMTOUT",99,0)
 S UID=^LRO(69,LRODT,1,LRSN,2,LRSND,.3)
"RTN","LRRMTOUT",100,0)
 S $P(REC(ZCNT),"|",21)=UID,$P(REC(ZCNT),"|",22)=UID
"RTN","LRRMTOUT",101,0)
 Q
"RTN","LRRMTOUT",102,0)
GTNME(REC) ;
"RTN","LRRMTOUT",103,0)
 N CNT,MSGNDE,MSGTYP,TYP
"RTN","LRRMTOUT",104,0)
 S (MSGNDE,MSGTYP)="",CNT=0
"RTN","LRRMTOUT",105,0)
 F  S CNT=$O(REC(CNT)) Q:CNT=""  D
"RTN","LRRMTOUT",106,0)
 .S MSGNDE=REC(CNT)
"RTN","LRRMTOUT",107,0)
 .Q:$G(MSGNDE)=""
"RTN","LRRMTOUT",108,0)
 .S MSGTYP=$P(MSGNDE,"|"),CCDE=$P(MSGNDE,"|",2)
"RTN","LRRMTOUT",109,0)
 .I MSGTYP="MSH" D
"RTN","LRRMTOUT",110,0)
 ..S TYP=$P(MSGNDE,"|",3)
"RTN","LRRMTOUT",111,0)
 .I MSGTYP="ORC" D
"RTN","LRRMTOUT",112,0)
 ..S USR=+$P(MSGNDE,"|",11)
"RTN","LRRMTOUT",113,0)
 ..S PROV=+$P(MSGNDE,"|",13)
"RTN","LRRMTOUT",114,0)
 ..I USR'=PROV S USR=PROV
"RTN","LRRMTOUT",115,0)
 ..S USRNME=$$GET1^DIQ(200,USR,.01,"I")
"RTN","LRRMTOUT",116,0)
 ..S PROVNME=$$GET1^DIQ(200,PROV,.01,"I")
"RTN","LRRMTOUT",117,0)
 ..I $G(USRNME)'="" S $P(REC(CNT),"|",11)=USR_"^"_USRNME
"RTN","LRRMTOUT",118,0)
 ..I $G(PROVNME)'="" S $P(REC(CNT),"|",13)=PROV_"^"_PROVNME
"RTN","LRRMTOUT",119,0)
 Q
"RTN","LRRMTOUT",120,0)
 ;
"RTN","LRRMTOUT",121,0)
GTREM(PROT,OR,TYP) ;
"RTN","LRRMTOUT",122,0)
 N FAC,REM
"RTN","LRRMTOUT",123,0)
 S PROT=0
"RTN","LRRMTOUT",124,0)
 Q:$G(OR)'>0
"RTN","LRRMTOUT",125,0)
 Q:'$D(^OR(100,OR,4.5,"ID"))
"RTN","LRRMTOUT",126,0)
 Q:'$D(^OR(100,OR,4.5,"ID","Location"))
"RTN","LRRMTOUT",127,0)
 S IFN="",IFN=$O(^OR(100,OR,4.5,"ID","Location",IFN))
"RTN","LRRMTOUT",128,0)
 S FAC=^OR(100,OR,4.5,IFN,1)
"RTN","LRRMTOUT",129,0)
 S REM="",REM=$O(^DIC(4,"B",FAC,REM))
"RTN","LRRMTOUT",130,0)
 S REM=500
"RTN","LRRMTOUT",131,0)
 ;S PROT="LA7V "_REM_" ORM-O01 EVENT"
"RTN","LRRMTOUT",132,0)
 I TYP["LAB" S PROT="LA7V "_REM_" ORM-O01 EVENT"
"RTN","LRRMTOUT",133,0)
 I TYP["RAD" S PROT="RA "_REM_" ORM-O01 EVENT"
"RTN","LRRMTOUT",134,0)
 ;REMOVE STAION ID FROM 8 NODE
"RTN","LRRMTOUT",135,0)
 Q
"RTN","LRRMTOUT",136,0)
 ;
"RTN","LRRMTOUT",137,0)
GTDOM(R) ;
"RTN","LRRMTOUT",138,0)
 N NME,INST,CNT
"RTN","LRRMTOUT",139,0)
 S (DOM,INST,R)="",CNT=0
"RTN","LRRMTOUT",140,0)
 Q:'$D(^DIC(4,"E"))
"RTN","LRRMTOUT",141,0)
 S INST="" F  S INST=$O(^DIC(4,"E",INST)) Q:INST=""  D
"RTN","LRRMTOUT",142,0)
 .;Q:$G(DOM)'>0
"RTN","LRRMTOUT",143,0)
 .;S DOM=$$GET1^DIQ(4.2,DOM,.01,"E")
"RTN","LRRMTOUT",144,0)
 .S NME=$$GET1^DIQ(4,INST,.01,"E")
"RTN","LRRMTOUT",145,0)
 .S CNT=$G(CNT)+1
"RTN","LRRMTOUT",146,0)
 .S R(CNT)=INST_"^"_NME
"RTN","LRRMTOUT",147,0)
 Q
"RTN","RARMTOUT")
0^6^B68106880
"RTN","RARMTOUT",1,0)
RARMTOUT ;;LEIDOS/TCK - RQEMOTE ORDER - OUTGOING ; 6/30/16 11:43am
"RTN","RARMTOUT",2,0)
 ;;1.0;REMOTE ORDERS;;OCT 1,2016;Build 2
"RTN","RARMTOUT",3,0)
 ; Reference to UNESC^ORHLESC supported by IA #4922
"RTN","RARMTOUT",4,0)
 ;; TEST
"RTN","RARMTOUT",5,0)
 ;
"RTN","RARMTOUT",6,0)
 Q
"RTN","RARMTOUT",7,0)
 ;
"RTN","RARMTOUT",8,0)
 ; Order#  (ien for #100) to be set in ORC-2 & ORB-2
"RTN","RARMTOUT",9,0)
 ; add pregnancy segment if needed.
"RTN","RARMTOUT",10,0)
 ;
"RTN","RARMTOUT",11,0)
 ; 2752 - cancel exam & order and send back cancel reason in ORC16
"RTN","RARMTOUT",12,0)
 ; 4954 - insure OBR7 has timezone
"RTN","RARMTOUT",13,0)
 ; 4453/2722 - cancel exam but put order on HOLD, ORC/OBR fix
"RTN","RARMTOUT",14,0)
 ; 5204 - Parent/Child events, add B to OBR.25 for Cancels of some
"RTN","RARMTOUT",15,0)
 ;        child exams, also when results go out for a cancelled case 
"RTN","RARMTOUT",16,0)
EN1(MSG1,MSG2) ;
"RTN","RARMTOUT",17,0)
 ;
"RTN","RARMTOUT",18,0)
 N HLA,PROT,PR,REC,FLG S (CHK,FLG)=0
"RTN","RARMTOUT",19,0)
 Q:$G(REMOTE)=1
"RTN","RARMTOUT",20,0)
 I $D(MSG1)>1 M HLA("HLS")=MSG1
"RTN","RARMTOUT",21,0)
 I $G(MSG2)'="",$G(XQORMSG)'="" M HLA=@XQORMSG
"RTN","RARMTOUT",22,0)
 I $G(MSG1)["TMP" M HLA=@XQORMSG
"RTN","RARMTOUT",23,0)
 K MSG,MSG1,REC,CHK,FLG,ODC,AP,VFGL,STOP,CHG,MSGTYP,MSGNDE
"RTN","RARMTOUT",24,0)
 ;
"RTN","RARMTOUT",25,0)
EN ;
"RTN","RARMTOUT",26,0)
 Q:'$D(HLA)
"RTN","RARMTOUT",27,0)
 N QQ,RAIEN,ORST
"RTN","RARMTOUT",28,0)
 N HLFS S HLFS="|"
"RTN","RARMTOUT",29,0)
 N HLCS S HLCS="^"
"RTN","RARMTOUT",30,0)
 N RAOIEN,RPTIEN S RAOIEN=0,RPTIEN=""
"RTN","RARMTOUT",31,0)
 ;
"RTN","RARMTOUT",32,0)
 N ORDNB S ORDNB="" ; Order#; ien of ^OR(100
"RTN","RARMTOUT",33,0)
 N SEGARY D GETSEG
"RTN","RARMTOUT",34,0)
 N XCASE S XCASE=""
"RTN","RARMTOUT",35,0)
 ;
"RTN","RARMTOUT",36,0)
 D ORC
"RTN","RARMTOUT",37,0)
 I $G(ORC1)="DC" D  Q
"RTN","RARMTOUT",38,0)
 .D FIX,MSG Q
"RTN","RARMTOUT",39,0)
 Q:$G(ORC1)="DC"
"RTN","RARMTOUT",40,0)
 I ORDNB'="" D FIX G PREG ; Case 1
"RTN","RARMTOUT",41,0)
 D OBR I XCASE'="" D
"RTN","RARMTOUT",42,0)
 . S ORDNB=$$GETORD(XCASE) Q:'ORDNB
"RTN","RARMTOUT",43,0)
 . D FIX G EXIT ; Case 2&3
"RTN","RARMTOUT",44,0)
 ;
"RTN","RARMTOUT",45,0)
PREG ;  add preg obx segment if needed
"RTN","RARMTOUT",46,0)
 I RAOIEN D OBXPRG
"RTN","RARMTOUT",47,0)
 ;
"RTN","RARMTOUT",48,0)
EXIT ;
"RTN","RARMTOUT",49,0)
 D DBG1("END")
"RTN","RARMTOUT",50,0)
 Q
"RTN","RARMTOUT",51,0)
 ;
"RTN","RARMTOUT",52,0)
MSG ;
"RTN","RARMTOUT",53,0)
 S PROT="RA REMOTE DC EVENT"
"RTN","RARMTOUT",54,0)
 K HLA("HLS",1) 
"RTN","RARMTOUT",55,0)
 D GENERATE^HLMA($O(^ORD(101,"B",PROT,0)),"LM",1,.HLREST,"",.HLP)
"RTN","RARMTOUT",56,0)
 Q
"RTN","RARMTOUT",57,0)
 ;
"RTN","RARMTOUT",58,0)
GETSEG ;
"RTN","RARMTOUT",59,0)
 N XI S XI=""
"RTN","RARMTOUT",60,0)
 N XSEG
"RTN","RARMTOUT",61,0)
 ;THERE IS A POSSIBLE ISSUE WITH DELIMETERS HERE
"RTN","RARMTOUT",62,0)
 ;THIS CODE IS NOT ABLE TO SEE THE XSEG PROPERLY
"RTN","RARMTOUT",63,0)
 ;FOR REG PATIENTS ESB MAY BE PULLING THE XCASE AND REPLACING
"RTN","RARMTOUT",64,0)
 ;
"RTN","RARMTOUT",65,0)
 FOR  S XI=$O(HLA("HLS",XI)) Q:'XI  S XSEG=$P(HLA("HLS",XI),HLFS,1) D
"RTN","RARMTOUT",66,0)
 . I XSEG="ORC" S SEGARY("ORC")=XI_"^"_$D(HLA("HLS",XI))
"RTN","RARMTOUT",67,0)
 . I XSEG="OBR" S SEGARY("OBR")=XI_"^"_$D(HLA("HLS",XI))
"RTN","RARMTOUT",68,0)
 Q
"RTN","RARMTOUT",69,0)
 ;
"RTN","RARMTOUT",70,0)
GETORD(XCASE) ; get Order# from Case#
"RTN","RARMTOUT",71,0)
 ;  XCASE= big Case#,
"RTN","RARMTOUT",72,0)
 N XEXAM ; exam line
"RTN","RARMTOUT",73,0)
 N XDFN  ; dfn
"RTN","RARMTOUT",74,0)
 N XDT   ; order date
"RTN","RARMTOUT",75,0)
 N XD2   ; 70.03 ien
"RTN","RARMTOUT",76,0)
 N X11   ; 11 piece of exam line;  ien of RAO(75.1
"RTN","RARMTOUT",77,0)
 ;
"RTN","RARMTOUT",78,0)
 ;S:$D(HLA("HLS",XI))=1 XCASE=$P(HLA("HLS",XI),"|",3)
"RTN","RARMTOUT",79,0)
 ;S:$D(HLA("HLS",XI))=11 XCASE=$P(HLA("HLS",XI,1),"|",2)
"RTN","RARMTOUT",80,0)
 S ORDNB=""
"RTN","RARMTOUT",81,0)
 ;
"RTN","RARMTOUT",82,0)
 S XDFN=$O(^RADPT("ADC",XCASE,"")) Q:'XDFN  D
"RTN","RARMTOUT",83,0)
 . S XDT=$O(^RADPT("ADC",XCASE,XDFN,"")) Q:XDT=""  D
"RTN","RARMTOUT",84,0)
 . . S XD2=$O(^RADPT("ADC",XCASE,XDFN,XDT,"")) Q:XD2=""
"RTN","RARMTOUT",85,0)
 . . S XEXAM=$G(^RADPT(XDFN,"DT",XDT,"P",XD2,0)) Q:XEXAM=""
"RTN","RARMTOUT",86,0)
 . . S EXMSTA=$P(XEXAM,"^",3)
"RTN","RARMTOUT",87,0)
 . . S CATEG=$P(XEXAM,"^",4)
"RTN","RARMTOUT",88,0)
 . . S WARD=$P(XEXAM,"^",6)
"RTN","RARMTOUT",89,0)
 . . S SERVICE=$P(XEXAM,"^",7)
"RTN","RARMTOUT",90,0)
 . . S RPTIEN=$P(XEXAM,"^",17)
"RTN","RARMTOUT",91,0)
 . . I +XEXAM=$P(XCASE,"-",2) S X11=$P(XEXAM,"^",11) S:X11'="" ORDNB=$P(^RAO(75.1,X11,0),"^",7),RAOIEN=X11
"RTN","RARMTOUT",92,0)
 I ORDNB["-" S ORDNB=0 Q
"RTN","RARMTOUT",93,0)
 I $G(RPTIEN)>0 D
"RTN","RARMTOUT",94,0)
 .Q:'$D(^RARPT(RPTIEN,"H"))
"RTN","RARMTOUT",95,0)
 .S STOP=$P(^RARPT(RPTIEN,"H",0),"^",3)
"RTN","RARMTOUT",96,0)
 .S INDX=0 F  S INDX=$O(^RARPT(RPTIEN,"H",INDX)) Q:INDX=""  D
"RTN","RARMTOUT",97,0)
 ..S HIST("TXT",INDX)=^RARPT(RPTIEN,"H",INDX,0)
"RTN","RARMTOUT",98,0)
 Q ORDNB
"RTN","RARMTOUT",99,0)
 ;
"RTN","RARMTOUT",100,0)
 ;====================================================================
"RTN","RARMTOUT",101,0)
 S:$D(HLA("HLS",XI))=1 $P(HLA("HLS",XI),"|",3)=XCASE_"^"_ORDNB
"RTN","RARMTOUT",102,0)
 S:$D(HLA("HLS",XI))=11 $P(HLA("HLS",XI,1),"|",2)=XCASE_"^"_ORDNB
"RTN","RARMTOUT",103,0)
 Q ORDNB
"RTN","RARMTOUT",104,0)
 ;
"RTN","RARMTOUT",105,0)
ORC ;
"RTN","RARMTOUT",106,0)
 Q:$G(SEGARY("ORC"))=""
"RTN","RARMTOUT",107,0)
 N XI,XD
"RTN","RARMTOUT",108,0)
 S XI=$P(SEGARY("ORC"),"^",1),XD=$P(SEGARY("ORC"),"^",2)
"RTN","RARMTOUT",109,0)
 I XD=1,$P(HLA("HLS",XI),HLFS,3)'="" S ORDNB=$P($P(HLA("HLS",XI),HLFS,3),";",1)
"RTN","RARMTOUT",110,0)
 I ORDNB'="" D
"RTN","RARMTOUT",111,0)
 .I '$D(^OR(100,ORDNB)) S $P(HLA("HLS",XI),HLFS,3)="",ORDNB=""
"RTN","RARMTOUT",112,0)
 S ORC1=$P(HLA("HLS",XI),HLFS,2)
"RTN","RARMTOUT",113,0)
 I $G(DUZ)'="" D
"RTN","RARMTOUT",114,0)
 .S USNM=$$GET1^DIQ(200,DUZ,.01,"E")
"RTN","RARMTOUT",115,0)
 .S USNM=$TR(USNM,",","^")
"RTN","RARMTOUT",116,0)
 .S $P(HLA("HLS",XI),HLFS,11)=DUZ_"^"_$G(USNM)
"RTN","RARMTOUT",117,0)
 .S PRVID=$P(HLA("HLS",XI),HLFS,13)
"RTN","RARMTOUT",118,0)
 .I PRVID'="" S PRVNME=$$GET1^DIQ(200,PRVID,.01,"E")
"RTN","RARMTOUT",119,0)
 .I $G(PRVNME)'="" S $P(HLA("HLS",XI),HLFS,13)=PRVID_"^"_$G(PRVNME)
"RTN","RARMTOUT",120,0)
 Q
"RTN","RARMTOUT",121,0)
 ;
"RTN","RARMTOUT",122,0)
OBR ;
"RTN","RARMTOUT",123,0)
 Q:'$D(SEGARY("OBR"))
"RTN","RARMTOUT",124,0)
 N XI,XD,XSEG
"RTN","RARMTOUT",125,0)
 N OBR2,OBR3
"RTN","RARMTOUT",126,0)
 S XI=$P($G(SEGARY("OBR")),"^",1),XD=$P(SEGARY("OBR"),"^",2)
"RTN","RARMTOUT",127,0)
 I XD=1 S XSEG=HLA("HLS",XI),OBR2=$P(XSEG,HLFS,3),OBR3=$P(XSEG,HLFS,4) S:OBR2'="" XCASE=OBR2 S:OBR2="" XCASE=$P(OBR3,HLCS,2)
"RTN","RARMTOUT",128,0)
 I XD=11 S XSEG=HLA("HLS",XI,1),OBR2=$P(XSEG,HLFS,2),OBR3=$P(XSEG,HLFS,3) S:OBR2'="" XCASE=OBR2 S:OBR2="" XCASE=$P(OBR3,HLCS,2)
"RTN","RARMTOUT",129,0)
 Q
"RTN","RARMTOUT",130,0)
 ;
"RTN","RARMTOUT",131,0)
FIX ; put ORDNB into ORC-2, OBR-2 and add Adittional clinical history
"RTN","RARMTOUT",132,0)
 N XI,XD,XSEG,TP,CNTR,ORST,SCNTR,OBRSEG,RAIEN,REAIEN,REASON,ORB7,OBRTZ
"RTN","RARMTOUT",133,0)
 N REQST,ORCTR,ORC
"RTN","RARMTOUT",134,0)
 ;
"RTN","RARMTOUT",135,0)
 S TYP="RAD"
"RTN","RARMTOUT",136,0)
 S CNTR="",DONE=0
"RTN","RARMTOUT",137,0)
 I $G(ORDNB)>0,$D(^XTMP(TYP,"B")),$D(^XTMP(TYP,"B",ORDNB)) S ORIFN=^XTMP(TYP,"B",ORDNB)
"RTN","RARMTOUT",138,0)
 F  S CNTR=$O(HLA("HLS",CNTR)) Q:CNTR=""  D
"RTN","RARMTOUT",139,0)
 .S TP=$P(HLA("HLS",CNTR),HLFS) D
"RTN","RARMTOUT",140,0)
 ..I TP="ORC" D    ;ORC segment mods
"RTN","RARMTOUT",141,0)
 ...M ORC=HLA("HLS",CNTR)
"RTN","RARMTOUT",142,0)
 ...S ORCTR=$P(HLA("HLS",CNTR),HLFS,2)
"RTN","RARMTOUT",143,0)
 ...;Get hub order number from cross ref
"RTN","RARMTOUT",144,0)
 ...I $G(ORIFN)>0 S $P(HLA("HLS",CNTR),HLFS,3)=ORIFN
"RTN","RARMTOUT",145,0)
 ...;  Check Cancel/Hold and get reason - 2752
"RTN","RARMTOUT",146,0)
 ...; get ien that points to file RAD/NUC MED ORDERS file #75.1
"RTN","RARMTOUT",147,0)
 ...S RAIEN=+$$GET1^DIQ(100,ORDNB,"PACKAGE REFERENCE","I")
"RTN","RARMTOUT",148,0)
 ...D:RAIEN ;Cancel/Hold Reason exists
"RTN","RARMTOUT",149,0)
 ....S REAIEN=$$GET1^DIQ(75.1,RAIEN,"REASON","I")
"RTN","RARMTOUT",150,0)
 ....S REASON=$$GET1^DIQ(75.1,RAIEN,"REASON")
"RTN","RARMTOUT",151,0)
 ....S REQST=$$GET1^DIQ(75.1,RAIEN,"REQUEST STATUS")   ;Sts, Hold?
"RTN","RARMTOUT",152,0)
 ....I $G(ORC1)'="DC" S $P(HLA("HLS",CNTR),HLFS,17)="X"_HLCS_HLCS_"99OR"_HLCS_REAIEN_HLCS_REASON
"RTN","RARMTOUT",153,0)
 ....;S $P(HLA("HLS",CNTR),HLFS,18)=$G(EXMSTA)_HLCS_$G(CATEG)_HLCS_$G(WARD)_HLCS_$G(SERVICE)
"RTN","RARMTOUT",154,0)
 ....D:REQST="HOLD"    ;4453 Sts=Hold
"RTN","RARMTOUT",155,0)
 .....S $P(HLA("HLS",CNTR),HLFS,2)="SC"        ;orc.1
"RTN","RARMTOUT",156,0)
 .....S $P(HLA("HLS",CNTR),HLFS,6)="IP"        ;orc.5
"RTN","RARMTOUT",157,0)
 ..I TP="OBR" D ;OBR segment mods
"RTN","RARMTOUT",158,0)
 ...S SCNTR=""
"RTN","RARMTOUT",159,0)
 ...F  S SCNTR=$O(HLA("HLS",CNTR,SCNTR)) Q:SCNTR=""  D
"RTN","RARMTOUT",160,0)
 ....S OBRSEG=HLA("HLS",CNTR),STRNG=HLA("HLS",CNTR,SCNTR)
"RTN","RARMTOUT",161,0)
 ....S OBRSEG=OBRSEG_STRNG,HLA("HLS",CNTR)=OBRSEG
"RTN","RARMTOUT",162,0)
 ....K HLA("HLS",CNTR,SCNTR)
"RTN","RARMTOUT",163,0)
 ...S $P(HLA("HLS",CNTR),HLFS,3)=ORIFN
"RTN","RARMTOUT",164,0)
 ...;CCR 5331 PUT TECHNOLOGIST ID IN OBR.34
"RTN","RARMTOUT",165,0)
 ...I $G(RADTI)'="" D
"RTN","RARMTOUT",166,0)
 ....I $O(^RADPT($G(RADFN),"DT",$G(RADTI),"P",$G(RACNI),"TC",0)) D
"RTN","RARMTOUT",167,0)
 .....S INDX=$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"TC",0),"^",3)
"RTN","RARMTOUT",168,0)
 .....Q:INDX'>0
"RTN","RARMTOUT",169,0)
 .....S RAIEN=INDX_","_RACNI_","_RADTI_","_RADFN_","
"RTN","RARMTOUT",170,0)
 .....S TECHID=$$GET1^DIQ(70.12,RAIEN,.01,"I")
"RTN","RARMTOUT",171,0)
 .....I $G(TECHID)>0 S $P(HLA("HLS",CNTR),HLFS,35)=TECHID
"RTN","RARMTOUT",172,0)
 ...I $G(TECHID)'>0 S $P(HLA("HLS",CNTR),HLFS,35)=DUZ
"RTN","RARMTOUT",173,0)
 ...S OBR7=$P(HLA("HLS",CNTR),HLFS,8)
"RTN","RARMTOUT",174,0)
 ...S OBR25=$P(HLA("HLS",CNTR),HLFS,26)
"RTN","RARMTOUT",175,0)
 ...I OBR25="" S $P(HLA("HLS",CNTR),HLFS,26)="I"
"RTN","RARMTOUT",176,0)
 ...S OBR25=$P(HLA("HLS",CNTR),HLFS,26)
"RTN","RARMTOUT",177,0)
 ...;
"RTN","RARMTOUT",178,0)
 ...; Timezone missing, add it  4954
"RTN","RARMTOUT",179,0)
 ...D:$P(OBR7,"-",2)=""
"RTN","RARMTOUT",180,0)
 ....S OBRTZ=$P($$HLDATE^HLFNC($$NOW^XLFDT,"TS"),"-",2)
"RTN","RARMTOUT",181,0)
 ....S $P(OBR7,"-",2)=OBRTZ
"RTN","RARMTOUT",182,0)
 ....S $P(HLA("HLS",CNTR),HLFS,8)=OBR7
"RTN","RARMTOUT",183,0)
 ...;
"RTN","RARMTOUT",184,0)
 ...; Hold Order event, set obr.25 = X  4453
"RTN","RARMTOUT",185,0)
 ...S:$G(REQST)="HOLD" $P(HLA("HLS",CNTR),HLFS,26)="X"
"RTN","RARMTOUT",186,0)
 ...;
"RTN","RARMTOUT",187,0)
 ...; Set obr.25 = B to block transmissison to DoD, when cancel of
"RTN","RARMTOUT",188,0)
 ...; child and order still Active.     5204
"RTN","RARMTOUT",189,0)
 ...I $G(ORCTR)="CA",$G(REQST)="ACTIVE" S $P(HLA("HLS",CNTR),HLFS,26)="B"
"RTN","RARMTOUT",190,0)
 ...;
"RTN","RARMTOUT",191,0)
 ...; Check IF report/result type HL7 and is a cancelled case.  5204
"RTN","RARMTOUT",192,0)
 ...; If so, then this is a bad case, so ESB will need to block this.
"RTN","RARMTOUT",193,0)
 ...; Legacy RA code creates this message erroneously as they only
"RTN","RARMTOUT",194,0)
 ...; check for if the exam case belongs to a Printset (parent/child).
"RTN","RARMTOUT",195,0)
 ...;
"RTN","RARMTOUT",196,0)
 ...I '$D(ORC),OBR25="F" D
"RTN","RARMTOUT",197,0)
 ....S RDIENS=RACNI_","_RADTI_","_RADFN_","
"RTN","RARMTOUT",198,0)
 ....I $$GET1^DIQ(70.03,RDIENS,3)="CANCELLED" D
"RTN","RARMTOUT",199,0)
 .....S $P(HLA("HLS",CNTR),HLFS,26)="B"
"RTN","RARMTOUT",200,0)
 ..I TP="OBX",'DONE D
"RTN","RARMTOUT",201,0)
 ...Q:'$D(HIST)
"RTN","RARMTOUT",202,0)
 ...S XH=$O(HLA("HLS",999999999),-1)
"RTN","RARMTOUT",203,0)
 ...S I="" F  S I=$O(HIST("TXT",I)) Q:I=""  D
"RTN","RARMTOUT",204,0)
 ....S TXT=HIST("TXT",I)
"RTN","RARMTOUT",205,0)
 ....Q:$G(TXT)=""
"RTN","RARMTOUT",206,0)
 ....S XH=$G(XH)+1
"RTN","RARMTOUT",207,0)
 ....S HLA("HLS",XH)="OBX"_"|"_XH_"|"_"TX"_"|"_"H^HISTORY^L"_"||"_TXT
"RTN","RARMTOUT",208,0)
 ....S DONE=1
"RTN","RARMTOUT",209,0)
 S DONE=""
"RTN","RARMTOUT",210,0)
 ;
"RTN","RARMTOUT",211,0)
 Q
"RTN","RARMTOUT",212,0)
 ;
"RTN","RARMTOUT",213,0)
DBG1(X) ;
"RTN","RARMTOUT",214,0)
 ;N FIXCNT S FIXCNT=$G(^XXRHL("FIX"))+1,^XXRHL("FIX")=FIXCNT
"RTN","RARMTOUT",215,0)
 ;M ^XXRHL("FIX",FIXCNT)=HLA("HLS")
"RTN","RARMTOUT",216,0)
 ;S ^XXRHL("FIX",FIXCNT)=X
"RTN","RARMTOUT",217,0)
 Q
"RTN","RARMTOUT",218,0)
 ;
"RTN","RARMTOUT",219,0)
OBXPRG ;
"RTN","RARMTOUT",220,0)
 N X,X13
"RTN","RARMTOUT",221,0)
 N XN S XN=0
"RTN","RARMTOUT",222,0)
 N PRGSEG S PRGSEG=0
"RTN","RARMTOUT",223,0)
 S X13=$P(^RAO(75.1,RAOIEN,0),"^",13)
"RTN","RARMTOUT",224,0)
 Q:X13=""
"RTN","RARMTOUT",225,0)
 ;
"RTN","RARMTOUT",226,0)
 S:X13="y" X13="YES" S:X13="n" X13="NO" S:X13="u" X13="UNKNOWN"
"RTN","RARMTOUT",227,0)
 FOR  S XN=$O(HLA("HLS",XN)) Q:XN=""  D  Q:PRGSEG
"RTN","RARMTOUT",228,0)
 . S X=HLA("HLS",XN) Q:$P(X,HLFS,1)'="OBX"
"RTN","RARMTOUT",229,0)
 . I $P(X,HLFS,4)["PREGNANT" S PRGSEG=1 Q  ; already a OBX preg seg
"RTN","RARMTOUT",230,0)
 Q:PRGSEG  ; already a OBX preg seg
"RTN","RARMTOUT",231,0)
 S XN=$O(HLA("HLS",999999999999999),-1),XN=XN+1
"RTN","RARMTOUT",232,0)
 S HLA("HLS",XN)="OBX"_HLFS_HLFS_"TX"_HLFS_"2000.33"_HLCS_"PREGNANT"_HLCS_"AS4"_HLFS_HLFS_X13
"RTN","RARMTOUT",233,0)
 ;
"RTN","RARMTOUT",234,0)
 Q
"RTN","RARMTOUT",235,0)
 ;=====================================================================================================================
"RTN","RARMTOUT",236,0)
 ; NOTES:
"RTN","RARMTOUT",237,0)
 ;   The purpose of this routine is to adjust the HL7 message stored in HLA("HLS" before it is stored in ^HL(772
"RTN","RARMTOUT",238,0)
 ;     the MSH segment can't be altered her ( Not in HLA("HLS"
"RTN","RARMTOUT",239,0)
 ;
"RTN","RARMTOUT",240,0)
 ;
"RTN","RARMTOUT",241,0)
 ;    The Order# (ien for OR(100)  is to be stored in ORC-2 & ORB-2  ( except for ORU messages which do not have a ORC)
"RTN","RARMTOUT",242,0)
 ;       3 cases of finding Order#
"RTN","RARMTOUT",243,0)
 ;  1.  order generated by CPRS:  case# in ORC-2  e.g. ORC|NW|29080;1^OR ; take $P(ORC-2),";",1)
"RTN","RARMTOUT",244,0)
 ;  2.  for ORM messages generated by Vista Registration, Cancellation, or Examined.
"RTN","RARMTOUT",245,0)
 ;      Order# not is in message so must use case# in OBR-2 to find Order#  (Order#=$$GETORD(Case#))
"RTN","RARMTOUT",246,0)
 ;      OBR||031710-72|...  where case# is '031710-72'
"RTN","RARMTOUT",247,0)
 ;  3.  for ORU messages, no ORC segment, Case# in OBR-3 as  OBR|||6899682.8165-1^031710-72^L
"RTN","RARMTOUT",248,0)
 ;       Case#=$P($P(OBR-3),"^",2) AND Order#=$$GETORD(Case#)
"RTN","RARMTOUT",249,0)
 ;
"RTN","RARMTOUT",250,0)
 ;   HLA("HLS" structure for ORM-messages:
"RTN","RARMTOUT",251,0)
 ;
"RTN","RARMTOUT",252,0)
 ;     HLA("HLS",1)=PID segment
"RTN","RARMTOUT",253,0)
 ;     HLA("HLS",2)=ORC segment
"RTN","RARMTOUT",254,0)
 ;        if $L(OBR) < 245  :
"RTN","RARMTOUT",255,0)
 ;     HLA("HLS",3)=OBR segment  
"RTN","RARMTOUT",256,0)
 ;        if $L(OBR)> 245
"RTN","RARMTOUT",257,0)
 ;     HLA("HLS",3)="OBR|"
"RTN","RARMTOUT",258,0)
 ;     HLA("HLS",3,1)=$P(OBR,"|",2,99)
"RTN","RARMTOUT",259,0)
 ;     HLA("HLS",3,2)=$P(OBR,"|",100,9999)
"RTN","RARMTOUT",260,0)
 ;     HLA("HLS",4-n)=OBX segments
"RTN","RARMTOUT",261,0)
 ;
"RTN","RARMTOUT",262,0)
 ;   HLA("HLS" structure for ORM-messas:
"VER")
8.0^22.0
**END**
**END**
