ORDV02B ;SLC/DCM - OE/RR REPORT EXTRACTS ;Jul 10, 2020@17:54
;;3.0;ORDER ENTRY/RESULTS REPORTING;**350,423,377,534**;Dec 17, 1997;Build 1
;
LO(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Lab Orders All
S (ORDEND,OROMEGA)=9999999 ; Get all future orders
I $L($T(GCPR^OMGCOAS1)) D ; Call if FHIE station 200
. N BEG,END,MAX
. Q:'$G(ORALPHA) Q:'$G(OROMEGA)
. S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999)
. S BEG=9999999,END=9999999-ORALPHA
. D GCPR^OMGCOAS1(DFN,"LRO",BEG,END,MAX)
N D,SN,ORX0,MAX,GMTS1,GMTS2,GMTSBEG,GMTSEND,ORSITE,SITE,GO,SORT,STATUS,S,LST,RSLT,Y,IVSDT,IVEDT,I,X,GMTSMERG
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S GMTSBEG=0,GMTSEND=9999999,MAX=9999,GMTSMERG=1
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
K ^TMP("ORDATA",$J)
I '$L($T(GCPR^OMGCOAS1)) D
. K ^TMP("LRO",$J),^TMP("ORTXT",$J),^TMP("ORSORT",$J),^TMP("ORXPND",$J)
. D @GO
S S=0,D=ORDBEG,IVSDT=ORDBEG,IVEDT=ORDEND
F S S=$O(^TMP("ORSORT",$J,S)) Q:'S D
. S D=IVSDT F S D=$O(^TMP("ORSORT",$J,S,D)) Q:'D!(D>IVEDT) S SN=0 F S SN=$O(^TMP("ORSORT",$J,S,D,SN)) Q:'SN S ORX0=^(SN) D
.. S SITE=$S($L($G(^TMP("LRO",$J,D,SN,"facility"))):^("facility"),1:ORSITE)
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",1)="1^"_SITE ;Station ID
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",2)="2^"_$P(ORX0,U) ;collection date
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",3)="3^"_$P($P(ORX0,U,2),";",2) ;test name
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",15)="15^"_$P($P(ORX0,U,2),";") ;test ien
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",4)="4^"_"" ;critical value field (calculated)
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",5)="5^"_$P($P(ORX0,U,3),";",2) ;specimen name
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",16)="16^"_$P($P(ORX0,U,3),";") ;specimen ien
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",7)="7^"_$P(ORX0,U,7) ;order date/time
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",8)="8^"_$P(ORX0,U,5) ;status
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",6)="6^"_$P($P(ORX0,U,6),";",2) ;provider name
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",17)="17^"_$P($P(ORX0,U,6),";") ;provider ien
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",11)="11^"_$P(ORX0,U,9) ;available date/time
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",18)="18^"_$P(ORX0,U,12) ;OE/RR order #
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",9)="9^"_$P(ORX0,U,4) ;urgency
.. S ^TMP("ORDATA",$J,S,D,SN,"WP",10)="10^"_$P(ORX0,U,8) ;accession number
.. K ^TMP("ORXPND",$J) S RSLT="^TMP(""ORXPND"",$J)" D RESULT^ORWOR(.RSLT,DFN,$P(ORX0,U,12),$P(ORX0,U,12))
.. D SPMRG^ORDVU("^TMP(""ORXPND"","_$J_")","^TMP(""ORDATA"","_$J_","_S_","_D_","_SN_",""WP"",13)",13) ;Test Results
.. K ^TMP("ORTXT",$J) S LST="^TMP(""ORTXT"",$J)" D DETAIL^ORWOR(.LST,$P(ORX0,U,12),DFN)
.. D SPMRG^ORDVU("^TMP(""ORTXT"","_$J_")","^TMP(""ORDATA"","_$J_","_S_","_D_","_SN_",""WP"",14)",14) ;order details
.. I $O(@LST@(0))!($O(@RSLT@(0))) S ^TMP("ORDATA",$J,S,D,SN,"WP",12)="12^[+]" ;flag for details
.. N TSTNM,TSTIEN,GOTIT,T,TT,STOP,FLAG
.. S TSTNM=$P($P(ORX0,U,2),";",2),TSTIEN=$P($P(ORX0,U,2),";")
.. S TSTNM=$S($L($P(^LAB(60,+TSTIEN,0),U))>25:$S($L($P($G(^(.1)),U)):$P(^(.1),U),1:$E($P(^(0),U),1,25)),1:$E($P(^(0),U),1,25))
.. S (I,GOTIT,STOP)=0,T="",TT=""
.. I '$O(^LAB(60,+TSTIEN,2,0)) D Q ;***Test is NOT a panel
... F S I=$O(^TMP("ORXPND",$J,I)) Q:'I S X=^(I,0) I X["H*"!(X["L*") D Q:GOTIT
.... I $P(X," ")=TSTNM S GOTIT=1,^TMP("ORDATA",$J,S,D,SN,"WP",4)="4^"_$S(X["H*":"H*",X["L*":"L*",1:"") Q
.. S (I,GOTIT)=0,(Y,FLAG)=""
.. I $O(^LAB(60,+TSTIEN,2,0)) S T=$O(^(0)),TT=$G(^(T,0)) D Q ;***Test is a panel
... I '$O(^LAB(60,+TSTIEN,2,T)) D Q ;If panel only has 1 test, treat like a cosmic test
.... N TSTNM S STOP=1
.... S TSTNM=$S($L($P(^LAB(60,+TT,0),U))>25:$S($L($P($G(^(.1)),U)):$P(^(.1),U),1:$E($P(^(0),U),1,25)),1:$E($P(^(0),U),1,25))
.... F S I=$O(^TMP("ORXPND",$J,I)) Q:'I S X=^(I,0) I X["H*"!(X["L*") D Q:GOTIT
..... I $P(X," ")=TSTNM S GOTIT=1,^TMP("ORDATA",$J,S,D,SN,"WP",4)="4^"_$S(X["H*":"H*",X["L*":"L*",1:"") Q
... Q:STOP
... D PANEL(TSTIEN)
... S ^TMP("ORDATA",$J,S,D,SN,"WP",4)="4^"_FLAG Q
K ^TMP("LRO",$J),^TMP("ORTXT",$J),^TMP("ORSORT",$J),^TMP("ORXPND",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
LPEND(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Lab Orders Pending
S (ORDEND,OROMEGA)=9999999 ; Get all future orders
I $L($T(GCPR^OMGCOAS1)) D ; Call if FHIE station 200
. N BEG,END,MAX
. Q:'$G(ORALPHA) Q:'$G(OROMEGA)
. S MAX=$S(+$G(ORMAX)>0:ORMAX,1:999)
. S BEG=9999999,END=9999999-ORALPHA
. D GCPR^OMGCOAS1(DFN,"LRO",BEG,END,MAX)
N D,SN,ORX0,MAX,GMTS1,GMTS2,GMTSBEG,GMTSEND,ORSITE,SITE,GO,SORT,STATUS,S,IVSDT,IVEDT,I,X
Q:'$L(OREXT)
S GO=$P(OREXT,";")_"^"_$P(OREXT,";",2)
Q:'$L($T(@GO))
S GMTSBEG=0,GMTSEND=9999999,MAX=9999,GMTSMERG=1
S ORSITE=$$SITE^VASITE,ORSITE=$P(ORSITE,"^",2)_";"_$P(ORSITE,"^",3)
K ^TMP("ORDATA",$J)
I '$L($T(GCPR^OMGCOAS1)) D
. K ^TMP("LRO",$J),^TMP("ORTXT",$J),^TMP("ORSORT",$J)
. D @GO
S IVEDT=9999999-ORDBEG,IVSDT=9999999-ORDEND,D=IVSDT
F S D=$O(^TMP("ORSORT",$J,D)) Q:'D!(D>IVEDT) D
. S S=0 F S S=$O(^TMP("ORSORT",$J,D,S)) Q:'S S SN=0 F S SN=$O(^TMP("ORSORT",$J,D,S,SN)) Q:'SN S ORX0=^(SN) D
.. S SITE=$S($L($G(^TMP("LRO",$J,D,SN,"facility"))):^("facility"),1:ORSITE)
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",1)="1^"_SITE ;Station ID
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",2)="2^"_$P(ORX0,U) ;collection date
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",3)="3^"_$P($P(ORX0,U,2),";",2) ;test name
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",13)="13^"_$P($P(ORX0,U,2),";") ;test ien
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",4)="4^"_$P($P(ORX0,U,3),";",2) ;specimen name
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",14)="14^"_$P($P(ORX0,U,3),";") ;specimen ien
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",6)="6^"_$P(ORX0,U,7) ;order date/time
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",7)="7^"_$P(ORX0,U,5) ;status
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",5)="5^"_$P($P(ORX0,U,6),";",2) ;provider name
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",15)="15^"_$P($P(ORX0,U,6),";") ;provider ien
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",10)="10^"_$P(ORX0,U,9) ;available date/time
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",16)="16^"_$P(ORX0,U,12) ;OE/RR order #
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",8)="8^"_$P(ORX0,U,4) ;urgency
.. S ^TMP("ORDATA",$J,D,S,SN,"WP",9)="9^"_$P(ORX0,U,8) ;accession number
.. K ^TMP("ORTXT",$J) S LST="^TMP(""ORTXT"",$J)" D DETAIL^ORWOR(.LST,$P(ORX0,U,12),DFN)
.. D SPMRG^ORDVU("^TMP(""ORTXT"","_$J_")","^TMP(""ORDATA"","_$J_","_D_","_S_","_SN_",""WP"",12)",12) ;order details
.. I $O(@LST@(0)) S ^TMP("ORDATA",$J,D,S,SN,"WP",11)="11^[+]" ;flag for details
K ^TMP("LRO",$J),^TMP("ORTXT",$J),^TMP("ORSORT",$J)
S ROOT=$NA(^TMP("ORDATA",$J))
Q
PANEL(TEST) ;Check sub-panels for a match
;OR*3.0*534 - modified this section so that comment lines containing
;an L* and/or H* wouldn't flag as critical
N T,TT,TSTNM,X,I
S T=0
F S T=$O(^LAB(60,TEST,2,T)) Q:'T Q:FLAG="H* L*" S TT=+$G(^(T,0)) D
. I $O(^LAB(60,TT,2,0)) D PANEL(TT) Q:GOTIT
. S I=0,TSTNM=$S($L($P(^LAB(60,+TT,0),U))>25:$S($L($P($G(^(.1)),U)):$P(^(.1),U),1:$E($P(^(0),U),1,25)),1:$E($P(^(0),U),1,25))
. F S I=$O(^TMP("ORXPND",$J,I)) Q:'I S X=^(I,0) I $P(X," ")=TSTNM&(X["H*"!(X["L*")) D
.. S FLAG=$S(FLAG="H*"&(X["L*"):"H* L*",FLAG="L*"&(X["H*"):"H* L*",X["H*":"H*",X["L*":"L*",1:"*")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDV02B 7282 printed Apr 09, 2024@21:34:17 Page 2
ORDV02B ;SLC/DCM - OE/RR REPORT EXTRACTS ;Jul 10, 2020@17:54
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**350,423,377,534**;Dec 17, 1997;Build 1
+2 ;
LO(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Lab Orders All
+1 ; Get all future orders
SET (ORDEND,OROMEGA)=9999999
+2 ; Call if FHIE station 200
IF $LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+3 NEW BEG,END,MAX
+4 if '$GET(ORALPHA)
QUIT
if '$GET(OROMEGA)
QUIT
+5 SET MAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
+6 SET BEG=9999999
SET END=9999999-ORALPHA
+7 DO GCPR^OMGCOAS1(DFN,"LRO",BEG,END,MAX)
End DoDot:1
+8 NEW D,SN,ORX0,MAX,GMTS1,GMTS2,GMTSBEG,GMTSEND,ORSITE,SITE,GO,SORT,STATUS,S,LST,RSLT,Y,IVSDT,IVEDT,I,X,GMTSMERG
+9 if '$LENGTH(OREXT)
QUIT
+10 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+11 if '$LENGTH($TEXT(@GO))
QUIT
+12 SET GMTSBEG=0
SET GMTSEND=9999999
SET MAX=9999
SET GMTSMERG=1
+13 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+14 KILL ^TMP("ORDATA",$JOB)
+15 IF '$LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+16 KILL ^TMP("LRO",$JOB),^TMP("ORTXT",$JOB),^TMP("ORSORT",$JOB),^TMP("ORXPND",$JOB)
+17 DO @GO
End DoDot:1
+18 SET S=0
SET D=ORDBEG
SET IVSDT=ORDBEG
SET IVEDT=ORDEND
+19 FOR
SET S=$ORDER(^TMP("ORSORT",$JOB,S))
if 'S
QUIT
Begin DoDot:1
+20 SET D=IVSDT
FOR
SET D=$ORDER(^TMP("ORSORT",$JOB,S,D))
if 'D!(D>IVEDT)
QUIT
SET SN=0
FOR
SET SN=$ORDER(^TMP("ORSORT",$JOB,S,D,SN))
if 'SN
QUIT
SET ORX0=^(SN)
Begin DoDot:2
+21 SET SITE=$SELECT($LENGTH($GET(^TMP("LRO",$JOB,D,SN,"facility"))):^("facility"),1:ORSITE)
+22 ;Station ID
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",1)="1^"_SITE
+23 ;collection date
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",2)="2^"_$PIECE(ORX0,U)
+24 ;test name
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",3)="3^"_$PIECE($PIECE(ORX0,U,2),";",2)
+25 ;test ien
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",15)="15^"_$PIECE($PIECE(ORX0,U,2),";")
+26 ;critical value field (calculated)
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",4)="4^"_""
+27 ;specimen name
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",5)="5^"_$PIECE($PIECE(ORX0,U,3),";",2)
+28 ;specimen ien
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",16)="16^"_$PIECE($PIECE(ORX0,U,3),";")
+29 ;order date/time
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",7)="7^"_$PIECE(ORX0,U,7)
+30 ;status
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",8)="8^"_$PIECE(ORX0,U,5)
+31 ;provider name
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",6)="6^"_$PIECE($PIECE(ORX0,U,6),";",2)
+32 ;provider ien
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",17)="17^"_$PIECE($PIECE(ORX0,U,6),";")
+33 ;available date/time
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",11)="11^"_$PIECE(ORX0,U,9)
+34 ;OE/RR order #
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",18)="18^"_$PIECE(ORX0,U,12)
+35 ;urgency
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",9)="9^"_$PIECE(ORX0,U,4)
+36 ;accession number
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",10)="10^"_$PIECE(ORX0,U,8)
+37 KILL ^TMP("ORXPND",$JOB)
SET RSLT="^TMP(""ORXPND"",$J)"
DO RESULT^ORWOR(.RSLT,DFN,$PIECE(ORX0,U,12),$PIECE(ORX0,U,12))
+38 ;Test Results
DO SPMRG^ORDVU("^TMP(""ORXPND"","_$JOB_")","^TMP(""ORDATA"","_$JOB_","_S_","_D_","_SN_",""WP"",13)",13)
+39 KILL ^TMP("ORTXT",$JOB)
SET LST="^TMP(""ORTXT"",$J)"
DO DETAIL^ORWOR(.LST,$PIECE(ORX0,U,12),DFN)
+40 ;order details
DO SPMRG^ORDVU("^TMP(""ORTXT"","_$JOB_")","^TMP(""ORDATA"","_$JOB_","_S_","_D_","_SN_",""WP"",14)",14)
+41 ;flag for details
IF $ORDER(@LST@(0))!($ORDER(@RSLT@(0)))
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",12)="12^[+]"
+42 NEW TSTNM,TSTIEN,GOTIT,T,TT,STOP,FLAG
+43 SET TSTNM=$PIECE($PIECE(ORX0,U,2),";",2)
SET TSTIEN=$PIECE($PIECE(ORX0,U,2),";")
+44 SET TSTNM=$SELECT($LENGTH($PIECE(^LAB(60,+TSTIEN,0),U))>25:$SELECT($LENGTH($PIECE($GET(^(.1)),U)):$PIECE(^(.1),U),1:$EXTRACT($PIECE(^(0),U),1,25)),1:$EXTRACT($PIECE(^(0),U),1,25))
+45 SET (I,GOTIT,STOP)=0
SET T=""
SET TT=""
+46 ;***Test is NOT a panel
IF '$ORDER(^LAB(60,+TSTIEN,2,0))
Begin DoDot:3
+47 FOR
SET I=$ORDER(^TMP("ORXPND",$JOB,I))
if 'I
QUIT
SET X=^(I,0)
IF X["H*"!(X["L*")
Begin DoDot:4
+48 IF $PIECE(X," ")=TSTNM
SET GOTIT=1
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",4)="4^"_$SELECT(X["H*":"H*",X["L*":"L*",1:"")
QUIT
End DoDot:4
if GOTIT
QUIT
End DoDot:3
QUIT
+49 SET (I,GOTIT)=0
SET (Y,FLAG)=""
+50 ;***Test is a panel
IF $ORDER(^LAB(60,+TSTIEN,2,0))
SET T=$ORDER(^(0))
SET TT=$GET(^(T,0))
Begin DoDot:3
+51 ;If panel only has 1 test, treat like a cosmic test
IF '$ORDER(^LAB(60,+TSTIEN,2,T))
Begin DoDot:4
+52 NEW TSTNM
SET STOP=1
+53 SET TSTNM=$SELECT($LENGTH($PIECE(^LAB(60,+TT,0),U))>25:$SELECT($LENGTH($PIECE($GET(^(.1)),U)):$PIECE(^(.1),U),1:$EXTRACT($PIECE(^(0),U),1,25)),1:$EXTRACT($PIECE(^(0),U),1,25))
+54 FOR
SET I=$ORDER(^TMP("ORXPND",$JOB,I))
if 'I
QUIT
SET X=^(I,0)
IF X["H*"!(X["L*")
Begin DoDot:5
+55 IF $PIECE(X," ")=TSTNM
SET GOTIT=1
SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",4)="4^"_$SELECT(X["H*":"H*",X["L*":"L*",1:"")
QUIT
End DoDot:5
if GOTIT
QUIT
End DoDot:4
QUIT
+56 if STOP
QUIT
+57 DO PANEL(TSTIEN)
+58 SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",4)="4^"_FLAG
QUIT
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+59 KILL ^TMP("LRO",$JOB),^TMP("ORTXT",$JOB),^TMP("ORSORT",$JOB),^TMP("ORXPND",$JOB)
+60 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+61 QUIT
LPEND(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Lab Orders Pending
+1 ; Get all future orders
SET (ORDEND,OROMEGA)=9999999
+2 ; Call if FHIE station 200
IF $LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+3 NEW BEG,END,MAX
+4 if '$GET(ORALPHA)
QUIT
if '$GET(OROMEGA)
QUIT
+5 SET MAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
+6 SET BEG=9999999
SET END=9999999-ORALPHA
+7 DO GCPR^OMGCOAS1(DFN,"LRO",BEG,END,MAX)
End DoDot:1
+8 NEW D,SN,ORX0,MAX,GMTS1,GMTS2,GMTSBEG,GMTSEND,ORSITE,SITE,GO,SORT,STATUS,S,IVSDT,IVEDT,I,X
+9 if '$LENGTH(OREXT)
QUIT
+10 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
+11 if '$LENGTH($TEXT(@GO))
QUIT
+12 SET GMTSBEG=0
SET GMTSEND=9999999
SET MAX=9999
SET GMTSMERG=1
+13 SET ORSITE=$$SITE^VASITE
SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
+14 KILL ^TMP("ORDATA",$JOB)
+15 IF '$LENGTH($TEXT(GCPR^OMGCOAS1))
Begin DoDot:1
+16 KILL ^TMP("LRO",$JOB),^TMP("ORTXT",$JOB),^TMP("ORSORT",$JOB)
+17 DO @GO
End DoDot:1
+18 SET IVEDT=9999999-ORDBEG
SET IVSDT=9999999-ORDEND
SET D=IVSDT
+19 FOR
SET D=$ORDER(^TMP("ORSORT",$JOB,D))
if 'D!(D>IVEDT)
QUIT
Begin DoDot:1
+20 SET S=0
FOR
SET S=$ORDER(^TMP("ORSORT",$JOB,D,S))
if 'S
QUIT
SET SN=0
FOR
SET SN=$ORDER(^TMP("ORSORT",$JOB,D,S,SN))
if 'SN
QUIT
SET ORX0=^(SN)
Begin DoDot:2
+21 SET SITE=$SELECT($LENGTH($GET(^TMP("LRO",$JOB,D,SN,"facility"))):^("facility"),1:ORSITE)
+22 ;Station ID
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",1)="1^"_SITE
+23 ;collection date
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",2)="2^"_$PIECE(ORX0,U)
+24 ;test name
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",3)="3^"_$PIECE($PIECE(ORX0,U,2),";",2)
+25 ;test ien
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",13)="13^"_$PIECE($PIECE(ORX0,U,2),";")
+26 ;specimen name
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",4)="4^"_$PIECE($PIECE(ORX0,U,3),";",2)
+27 ;specimen ien
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",14)="14^"_$PIECE($PIECE(ORX0,U,3),";")
+28 ;order date/time
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",6)="6^"_$PIECE(ORX0,U,7)
+29 ;status
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",7)="7^"_$PIECE(ORX0,U,5)
+30 ;provider name
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",5)="5^"_$PIECE($PIECE(ORX0,U,6),";",2)
+31 ;provider ien
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",15)="15^"_$PIECE($PIECE(ORX0,U,6),";")
+32 ;available date/time
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",10)="10^"_$PIECE(ORX0,U,9)
+33 ;OE/RR order #
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",16)="16^"_$PIECE(ORX0,U,12)
+34 ;urgency
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",8)="8^"_$PIECE(ORX0,U,4)
+35 ;accession number
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",9)="9^"_$PIECE(ORX0,U,8)
+36 KILL ^TMP("ORTXT",$JOB)
SET LST="^TMP(""ORTXT"",$J)"
DO DETAIL^ORWOR(.LST,$PIECE(ORX0,U,12),DFN)
+37 ;order details
DO SPMRG^ORDVU("^TMP(""ORTXT"","_$JOB_")","^TMP(""ORDATA"","_$JOB_","_D_","_S_","_SN_",""WP"",12)",12)
+38 ;flag for details
IF $ORDER(@LST@(0))
SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",11)="11^[+]"
End DoDot:2
End DoDot:1
+39 KILL ^TMP("LRO",$JOB),^TMP("ORTXT",$JOB),^TMP("ORSORT",$JOB)
+40 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
+41 QUIT
PANEL(TEST) ;Check sub-panels for a match
+1 ;OR*3.0*534 - modified this section so that comment lines containing
+2 ;an L* and/or H* wouldn't flag as critical
+3 NEW T,TT,TSTNM,X,I
+4 SET T=0
+5 FOR
SET T=$ORDER(^LAB(60,TEST,2,T))
if 'T
QUIT
if FLAG="H* L*"
QUIT
SET TT=+$GET(^(T,0))
Begin DoDot:1
+6 IF $ORDER(^LAB(60,TT,2,0))
DO PANEL(TT)
if GOTIT
QUIT
+7 SET I=0
SET TSTNM=$SELECT($LENGTH($PIECE(^LAB(60,+TT,0),U))>25:$SELECT($LENGTH($PIECE($GET(^(.1)),U)):$PIECE(^(.1),U),1:$EXTRACT($PIECE(^(0),U),1,25)),1:$EXTRACT($PIECE(^(0),U),1,25))
+8 FOR
SET I=$ORDER(^TMP("ORXPND",$JOB,I))
if 'I
QUIT
SET X=^(I,0)
IF $PIECE(X," ")=TSTNM&(X["H*"!(X["L*"))
Begin DoDot:2
+9 SET FLAG=$SELECT(FLAG="H*"&(X["L*"):"H* L*",FLAG="L*"&(X["H*"):"H* L*",X["H*":"H*",X["L*":"L*",1:"*")
End DoDot:2
End DoDot:1
+10 QUIT
