- ORDV02B ;SLC/DCM - OE/RR REPORT EXTRACTS ;MAY 17, 2024@15:40
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**350,423,377,534,610**;Dec 17, 1997;Build 11
- ;
- ; Reference to GCPR^OMGCOAS1 in ICR #3486
- ; Reference to ^TMP("60" in ICR #3486
- ; Reference to ^LAB(60 in ICR #2387
- ;
- LO(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Lab Orders All
- I '$D(ORDEND) S ORDEND=9999999 ;Acknowledging parameter input value in ORDEND DM-610
- S OROMEGA=ORDEND
- 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,ORCTR,ORSTOP
- 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,ORCTR=1,ORSTOP=0
- F S S=$O(^TMP("ORSORT",$J,S)) Q:'S!ORSTOP D
- . S D=IVSDT F S D=$O(^TMP("ORSORT",$J,S,D)) Q:'D!(D>IVEDT)!ORSTOP S SN=0 F S SN=$O(^TMP("ORSORT",$J,S,D,SN)) S:ORCTR>ORMAX ORSTOP=1 Q:'SN!ORSTOP S ORX0=^(SN),ORCTR=ORCTR+1 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
- I '$D(ORDEND) S ORDEND=9999999 ;Acknowledging parameter input value in ORDEND DM-610
- S OROMEGA=ORDEND
- 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,ORCTR,ORSTOP
- 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,ORCTR=1,ORSTOP=0
- F S D=$O(^TMP("ORSORT",$J,D)) Q:'D!(D>IVEDT)!ORSTOP D
- . S S=0 F S S=$O(^TMP("ORSORT",$J,D,S)) Q:'S!ORSTOP S SN=0 F S SN=$O(^TMP("ORSORT",$J,D,S,SN)) S:ORCTR>ORMAX ORSTOP=1 Q:'SN!ORSTOP S ORX0=^(SN),ORCTR=ORCTR+1 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 7705 printed Feb 18, 2025@23:56:39 Page 2
- ORDV02B ;SLC/DCM - OE/RR REPORT EXTRACTS ;MAY 17, 2024@15:40
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**350,423,377,534,610**;Dec 17, 1997;Build 11
- +2 ;
- +3 ; Reference to GCPR^OMGCOAS1 in ICR #3486
- +4 ; Reference to ^TMP("60" in ICR #3486
- +5 ; Reference to ^LAB(60 in ICR #2387
- +6 ;
- LO(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Lab Orders All
- +1 ;Acknowledging parameter input value in ORDEND DM-610
- IF '$DATA(ORDEND)
- SET ORDEND=9999999
- +2 SET OROMEGA=ORDEND
- +3 ; Call if FHIE station 200
- IF $LENGTH($TEXT(GCPR^OMGCOAS1))
- Begin DoDot:1
- +4 NEW BEG,END,MAX
- +5 if '$GET(ORALPHA)
- QUIT
- if '$GET(OROMEGA)
- QUIT
- +6 SET MAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
- +7 SET BEG=9999999
- SET END=9999999-ORALPHA
- +8 DO GCPR^OMGCOAS1(DFN,"LRO",BEG,END,MAX)
- End DoDot:1
- +9 NEW D,SN,ORX0,MAX,GMTS1,GMTS2,GMTSBEG,GMTSEND,ORSITE,SITE,GO,SORT,STATUS,S,LST,RSLT,Y,IVSDT,IVEDT,I,X,GMTSMERG,ORCTR,ORSTOP
- +10 if '$LENGTH(OREXT)
- QUIT
- +11 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
- +12 if '$LENGTH($TEXT(@GO))
- QUIT
- +13 SET GMTSBEG=0
- SET GMTSEND=9999999
- SET MAX=9999
- SET GMTSMERG=1
- +14 SET ORSITE=$$SITE^VASITE
- SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
- +15 KILL ^TMP("ORDATA",$JOB)
- +16 IF '$LENGTH($TEXT(GCPR^OMGCOAS1))
- Begin DoDot:1
- +17 KILL ^TMP("LRO",$JOB),^TMP("ORTXT",$JOB),^TMP("ORSORT",$JOB),^TMP("ORXPND",$JOB)
- +18 DO @GO
- End DoDot:1
- +19 SET S=0
- SET D=ORDBEG
- SET IVSDT=ORDBEG
- SET IVEDT=ORDEND
- SET ORCTR=1
- SET ORSTOP=0
- +20 FOR
- SET S=$ORDER(^TMP("ORSORT",$JOB,S))
- if 'S!ORSTOP
- QUIT
- Begin DoDot:1
- +21 SET D=IVSDT
- FOR
- SET D=$ORDER(^TMP("ORSORT",$JOB,S,D))
- if 'D!(D>IVEDT)!ORSTOP
- QUIT
- SET SN=0
- FOR
- SET SN=$ORDER(^TMP("ORSORT",$JOB,S,D,SN))
- if ORCTR>ORMAX
- SET ORSTOP=1
- if 'SN!ORSTOP
- QUIT
- SET ORX0=^(SN)
- SET ORCTR=ORCTR+1
- Begin DoDot:2
- +22 SET SITE=$SELECT($LENGTH($GET(^TMP("LRO",$JOB,D,SN,"facility"))):^("facility"),1:ORSITE)
- +23 ;Station ID
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",1)="1^"_SITE
- +24 ;collection date
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",2)="2^"_$PIECE(ORX0,U)
- +25 ;test name
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",3)="3^"_$PIECE($PIECE(ORX0,U,2),";",2)
- +26 ;test ien
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",15)="15^"_$PIECE($PIECE(ORX0,U,2),";")
- +27 ;critical value field (calculated)
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",4)="4^"_""
- +28 ;specimen name
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",5)="5^"_$PIECE($PIECE(ORX0,U,3),";",2)
- +29 ;specimen ien
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",16)="16^"_$PIECE($PIECE(ORX0,U,3),";")
- +30 ;order date/time
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",7)="7^"_$PIECE(ORX0,U,7)
- +31 ;status
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",8)="8^"_$PIECE(ORX0,U,5)
- +32 ;provider name
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",6)="6^"_$PIECE($PIECE(ORX0,U,6),";",2)
- +33 ;provider ien
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",17)="17^"_$PIECE($PIECE(ORX0,U,6),";")
- +34 ;available date/time
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",11)="11^"_$PIECE(ORX0,U,9)
- +35 ;OE/RR order #
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",18)="18^"_$PIECE(ORX0,U,12)
- +36 ;urgency
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",9)="9^"_$PIECE(ORX0,U,4)
- +37 ;accession number
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",10)="10^"_$PIECE(ORX0,U,8)
- +38 KILL ^TMP("ORXPND",$JOB)
- SET RSLT="^TMP(""ORXPND"",$J)"
- DO RESULT^ORWOR(.RSLT,DFN,$PIECE(ORX0,U,12),$PIECE(ORX0,U,12))
- +39 ;Test Results
- DO SPMRG^ORDVU("^TMP(""ORXPND"","_$JOB_")","^TMP(""ORDATA"","_$JOB_","_S_","_D_","_SN_",""WP"",13)",13)
- +40 KILL ^TMP("ORTXT",$JOB)
- SET LST="^TMP(""ORTXT"",$J)"
- DO DETAIL^ORWOR(.LST,$PIECE(ORX0,U,12),DFN)
- +41 ;order details
- DO SPMRG^ORDVU("^TMP(""ORTXT"","_$JOB_")","^TMP(""ORDATA"","_$JOB_","_S_","_D_","_SN_",""WP"",14)",14)
- +42 ;flag for details
- IF $ORDER(@LST@(0))!($ORDER(@RSLT@(0)))
- SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",12)="12^[+]"
- +43 NEW TSTNM,TSTIEN,GOTIT,T,TT,STOP,FLAG
- +44 SET TSTNM=$PIECE($PIECE(ORX0,U,2),";",2)
- SET TSTIEN=$PIECE($PIECE(ORX0,U,2),";")
- +45 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))
- +46 SET (I,GOTIT,STOP)=0
- SET T=""
- SET TT=""
- +47 ;***Test is NOT a panel
- IF '$ORDER(^LAB(60,+TSTIEN,2,0))
- Begin DoDot:3
- +48 FOR
- SET I=$ORDER(^TMP("ORXPND",$JOB,I))
- if 'I
- QUIT
- SET X=^(I,0)
- IF X["H*"!(X["L*")
- Begin DoDot:4
- +49 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
- +50 SET (I,GOTIT)=0
- SET (Y,FLAG)=""
- +51 ;***Test is a panel
- IF $ORDER(^LAB(60,+TSTIEN,2,0))
- SET T=$ORDER(^(0))
- SET TT=$GET(^(T,0))
- Begin DoDot:3
- +52 ;If panel only has 1 test, treat like a cosmic test
- IF '$ORDER(^LAB(60,+TSTIEN,2,T))
- Begin DoDot:4
- +53 NEW TSTNM
- SET STOP=1
- +54 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))
- +55 FOR
- SET I=$ORDER(^TMP("ORXPND",$JOB,I))
- if 'I
- QUIT
- SET X=^(I,0)
- IF X["H*"!(X["L*")
- Begin DoDot:5
- +56 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
- +57 if STOP
- QUIT
- +58 DO PANEL(TSTIEN)
- +59 SET ^TMP("ORDATA",$JOB,S,D,SN,"WP",4)="4^"_FLAG
- QUIT
- End DoDot:3
- QUIT
- End DoDot:2
- End DoDot:1
- +60 KILL ^TMP("LRO",$JOB),^TMP("ORTXT",$JOB),^TMP("ORSORT",$JOB),^TMP("ORXPND",$JOB)
- +61 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
- +62 QUIT
- LPEND(ROOT,ORALPHA,OROMEGA,ORMAX,ORDBEG,ORDEND,OREXT) ; Lab Orders Pending
- +1 ;Acknowledging parameter input value in ORDEND DM-610
- IF '$DATA(ORDEND)
- SET ORDEND=9999999
- +2 SET OROMEGA=ORDEND
- +3 ; Call if FHIE station 200
- IF $LENGTH($TEXT(GCPR^OMGCOAS1))
- Begin DoDot:1
- +4 NEW BEG,END,MAX
- +5 if '$GET(ORALPHA)
- QUIT
- if '$GET(OROMEGA)
- QUIT
- +6 SET MAX=$SELECT(+$GET(ORMAX)>0:ORMAX,1:999)
- +7 SET BEG=9999999
- SET END=9999999-ORALPHA
- +8 DO GCPR^OMGCOAS1(DFN,"LRO",BEG,END,MAX)
- End DoDot:1
- +9 NEW D,SN,ORX0,MAX,GMTS1,GMTS2,GMTSBEG,GMTSEND,ORSITE,SITE,GO,SORT,STATUS,S,IVSDT,IVEDT,I,X,ORCTR,ORSTOP
- +10 if '$LENGTH(OREXT)
- QUIT
- +11 SET GO=$PIECE(OREXT,";")_"^"_$PIECE(OREXT,";",2)
- +12 if '$LENGTH($TEXT(@GO))
- QUIT
- +13 SET GMTSBEG=0
- SET GMTSEND=9999999
- SET MAX=9999
- SET GMTSMERG=1
- +14 SET ORSITE=$$SITE^VASITE
- SET ORSITE=$PIECE(ORSITE,"^",2)_";"_$PIECE(ORSITE,"^",3)
- +15 KILL ^TMP("ORDATA",$JOB)
- +16 IF '$LENGTH($TEXT(GCPR^OMGCOAS1))
- Begin DoDot:1
- +17 KILL ^TMP("LRO",$JOB),^TMP("ORTXT",$JOB),^TMP("ORSORT",$JOB)
- +18 DO @GO
- End DoDot:1
- +19 SET IVEDT=9999999-ORDBEG
- SET IVSDT=9999999-ORDEND
- SET D=IVSDT
- SET ORCTR=1
- SET ORSTOP=0
- +20 FOR
- SET D=$ORDER(^TMP("ORSORT",$JOB,D))
- if 'D!(D>IVEDT)!ORSTOP
- QUIT
- Begin DoDot:1
- +21 SET S=0
- FOR
- SET S=$ORDER(^TMP("ORSORT",$JOB,D,S))
- if 'S!ORSTOP
- QUIT
- SET SN=0
- FOR
- SET SN=$ORDER(^TMP("ORSORT",$JOB,D,S,SN))
- if ORCTR>ORMAX
- SET ORSTOP=1
- if 'SN!ORSTOP
- QUIT
- SET ORX0=^(SN)
- SET ORCTR=ORCTR+1
- Begin DoDot:2
- +22 SET SITE=$SELECT($LENGTH($GET(^TMP("LRO",$JOB,D,SN,"facility"))):^("facility"),1:ORSITE)
- +23 ;Station ID
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",1)="1^"_SITE
- +24 ;collection date
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",2)="2^"_$PIECE(ORX0,U)
- +25 ;test name
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",3)="3^"_$PIECE($PIECE(ORX0,U,2),";",2)
- +26 ;test ien
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",13)="13^"_$PIECE($PIECE(ORX0,U,2),";")
- +27 ;specimen name
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",4)="4^"_$PIECE($PIECE(ORX0,U,3),";",2)
- +28 ;specimen ien
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",14)="14^"_$PIECE($PIECE(ORX0,U,3),";")
- +29 ;order date/time
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",6)="6^"_$PIECE(ORX0,U,7)
- +30 ;status
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",7)="7^"_$PIECE(ORX0,U,5)
- +31 ;provider name
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",5)="5^"_$PIECE($PIECE(ORX0,U,6),";",2)
- +32 ;provider ien
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",15)="15^"_$PIECE($PIECE(ORX0,U,6),";")
- +33 ;available date/time
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",10)="10^"_$PIECE(ORX0,U,9)
- +34 ;OE/RR order #
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",16)="16^"_$PIECE(ORX0,U,12)
- +35 ;urgency
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",8)="8^"_$PIECE(ORX0,U,4)
- +36 ;accession number
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",9)="9^"_$PIECE(ORX0,U,8)
- +37 KILL ^TMP("ORTXT",$JOB)
- SET LST="^TMP(""ORTXT"",$J)"
- DO DETAIL^ORWOR(.LST,$PIECE(ORX0,U,12),DFN)
- +38 ;order details
- DO SPMRG^ORDVU("^TMP(""ORTXT"","_$JOB_")","^TMP(""ORDATA"","_$JOB_","_D_","_S_","_SN_",""WP"",12)",12)
- +39 ;flag for details
- IF $ORDER(@LST@(0))
- SET ^TMP("ORDATA",$JOB,D,S,SN,"WP",11)="11^[+]"
- End DoDot:2
- End DoDot:1
- +40 KILL ^TMP("LRO",$JOB),^TMP("ORTXT",$JOB),^TMP("ORSORT",$JOB)
- +41 SET ROOT=$NAME(^TMP("ORDATA",$JOB))
- +42 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
