- ORWDXVB ;SLC/DCM - Order dialog utilities for Blood Bank ;Dec 02, 2021@12:46:23
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243,212,309,332,405**;Dec 17 1997;Build 211
- ;
- ; DBIA 2503 RR^LR7OR1 ^TMP("LRRR",$J)
- ;
- GETPAT(ORX,DFN,ORL) ;Get Patient data from VBECS
- ;Needs patient DFN and Location (ORL)
- N ORSTN,DIV
- S DIV=+$P($G(^SC(+$G(ORL),0)),U,15),ORSTN=$P($$SITE^VASITE(DT,DIV),U,3)
- D OEAPI^VBECA3(.ORX,DFN,ORSTN)
- Q
- PTINFO(OROOT,ORX) ;Format patient BB info
- Q:'$D(ORX)
- D PTINFO^ORWDXVB1
- Q
- RESULTS(OROOT,DFN,ORX) ;Get test results
- Q:'$O(ORX(0)) ;ORX contains a list of tests to retrieve results for
- N ORCOM,ORT,ORTST,ORTDT,ORTMP,GCNT,CCNT,GIOSL,GIOM,I,ORZ
- S GCNT=0,CCNT=1,GIOSL=999999,GIOM=80
- S OROOT=$NA(^TMP("ORVBEC",$J))
- K ^TMP("ORVBEC",$J)
- D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"RECENT LAB RESULTS:",.CCNT)
- D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"Test Result Units Range Collected Accession Sts",.CCNT)
- D LN
- S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,"---- ------ ----- ----- --------- --------- ---",.CCNT)
- S ORT=0 F S ORT=$O(ORX(ORT)) Q:'ORT S ORTST=$P(ORX(ORT),"^",1) D
- . K ^TMP("LRRR",$J) D RR^LR7OR1(DFN,,,,,ORTST,,1) ;DBIA 2503
- . S ORTMP=$$FIRST^ORCDVBEC(DFN,ORTST) Q:'$L(ORTMP)
- . S ORTDT=9999999-+$P(ORTMP,",",5),ORZ=@ORTMP
- . D LN
- . S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,$P(ORZ,"^",15),.CCNT)_$$S^ORU4(8,CCNT,$J($P(ORZ,"^",2),7),.CCNT)_$$S^ORU4(16,CCNT,$P(ORZ,"^",3),.CCNT)_$$S^ORU4(19,CCNT,$P(ORZ,"^",4),.CCNT)_$$S^ORU4(30,CCNT,$P(ORZ,"^",5),.CCNT)
- . S ^(0)=^TMP("ORVBEC",$J,GCNT,0)_$$S^ORU4(40,CCNT,$$DATETIME^ORCHTAB(ORTDT),.CCNT)_$$S^ORU4(56,CCNT,$P(ORZ,"^",16),.CCNT)_$$S^ORU4(71,CCNT,$P(ORZ,"^",6),.CCNT)
- . S ORCOM=$P(ORTMP,",",1,5)_",""N""" ;check for comments
- . F S ORTMP=$Q(@ORTMP) Q:$P(ORTMP,",",1,6)'=ORCOM D
- .. D LN
- .. S ^TMP("ORVBEC",$J,GCNT,0)=$$S^ORU4(1,CCNT,@ORTMP,.CCNT)
- I GCNT<4 K ^TMP("ORVBEC",$J)
- K ^TMP("LRRR",$J)
- Q
- RAW(OROOT,DFN,ORX) ;Get RAW test results
- Q:'$O(ORX(0)) ;ORX contains a list of tests to retrieve results for
- N ORCOM,ORT,ORTST,ORTDT,ORTMP,GCNT,CCNT,GIOSL,GIOM,I
- S GCNT=0,CCNT=1,GIOSL=999999,GIOM=80
- S OROOT=$NA(^TMP("ORVBEC",$J))
- K ^TMP("ORVBEC",$J)
- S ORT=0 F S ORT=$O(ORX(ORT)) Q:'ORT S ORTST=$P(ORX(ORT),"^",1) D
- . K ^TMP("LRRR",$J) D RR^LR7OR1(DFN,,,,,ORTST,,1)
- . S ORTMP="^TMP(""LRRR"",$J,DFN)",ORTMP=$Q(@ORTMP)
- . Q:$P(ORTMP,",",1,3)'=("^TMP(""LRRR"","_$J_","_DFN)
- . S ORTDT=9999999-+$P(ORTMP,",",5),ORZ=@ORTMP
- . D LN
- . S ^TMP("ORVBEC",$J,GCNT,0)=$P(ORZ,"^",1,6)_"^"_ORTDT
- K ^TMP("LRRR",$J)
- Q
- SURG(OROOT,ORX) ;Get list of surgeries
- N I,CNT,X
- S (I,CNT)=0
- F S I=$O(ORX("SURGERY",I)) Q:'I S X=$G(ORX("SURGERY",I)) D
- . S CNT=CNT+1,OROOT(CNT)=X_U_X
- Q
- LN ;Increment counts
- S GCNT=GCNT+1,CCNT=1
- Q
- PATINFO(OROOT,DFN,LOC) ;Test ^TMP global output
- N ORX
- D GETPAT(.ORX,DFN,LOC)
- I $L($G(ORX("SPECIMEN"))) S:$P(ORX("SPECIMEN"),"^") $P(ORX("SPECIMEN"),"^")=$$HL7TFM^XLFDT($P(ORX("SPECIMEN"),"^"))
- D PTINFO(.OROOT,.ORX)
- ;S I=0 F S I=$O(@OROOT@(I)) Q:'I W !,^(I,0)
- ;K @OROOT
- Q
- GETALL(OROOT,DFN,LOC,EDATE) ;Get all data in one call and let the GUI divide it up
- N ORX,INFO,CNT,I,J,K,OREAS,OREASON
- S OROOT=$NA(^TMP("ORVBECINFO",$J)),CNT=1
- D GETPAT(.ORX,DFN,LOC)
- ;S ^TMP("ORVBECINFO",$J,CNT)="~RAWDATA",I=0
- ;F S I=$O(ORX(I)) Q:'I S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)=ORX(I)
- I $L($G(ORX("SPECIMEN"))) S:$P(ORX("SPECIMEN"),"^") $P(ORX("SPECIMEN"),"^")=$$HL7TFM^XLFDT($P(ORX("SPECIMEN"),"^")) S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~SPECIMEN",CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_ORX("SPECIMEN")
- I $L($G(ORX("ABORH"))) S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~ABORH",CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_ORX("ABORH")
- S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~TYPE AND SCREEN",CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_$O(^ORD(101.43,"ID","1;99VBC",0))
- S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~OTHER",CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_$O(^ORD(101.43,"ID","6;99VBC",0))
- S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~SPECIMENS",I=0
- F S I=$O(ORX(I)) Q:'I S J="" F S J=$O(ORX(I,J)) Q:J="" I J="SPECIMEN" S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_I_"^"_ORX(I,J)
- S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~TESTS",I=0
- F S I=$O(ORX(I)) Q:'I S J="" F S J=$O(ORX(I,J)) Q:J="" I J="TEST" S K=0 F S K=$O(ORX(I,J,K)) Q:'K S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_I_"^"_K_"^"_ORX(I,J,K)
- S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~MSBOS",I=0
- F S I=$O(ORX(I)) Q:'I S J="" F S J=$O(ORX(I,J)) Q:J="" I J="MSBOS" S K=0 F S K=$O(ORX(I,J,K)) Q:'K S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_I_"^"_K_"^"_ORX(I,J,K),$P(^(CNT),"^",4)=+$P(ORX(I,J,K),"^",2)
- S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~SURGERIES",I=0
- F S I=$O(ORX("SURGERY",I)) Q:'I S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_I_"^"_ORX("SURGERY",I)
- S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~URGENCIES",I=""
- F S I=$O(^ORD(101.42,"S.VBEC",I)) Q:I="" S J=0 F S J=$O(^ORD(101.42,"S.VBEC",I,J)) Q:'J S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_J_"^"_I
- S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~MODIFIERS",I=""
- N ORMODS D GETLST^XPAR(.ORMODS,"ALL","OR VBECS MODIFIERS","I")
- F S I=$O(ORMODS(I)) Q:'I S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_ORMODS(I)
- S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~REASONS",I=""
- N ORMODS D GETLST^XPAR(.ORMODS,"ALL","OR VBECS REASON FOR REQUEST","I")
- S OREASON=$$GET^XPAR("DIV^SYS^PKG","OR VBECS REASON SORT ALPHA",1,"Q")
- I OREASON D
- . F S I=$O(ORMODS(I)) Q:'I S OREAS(" "_$$UP^XLFSTR(ORMODS(I)))=ORMODS(I)
- . S I="" F S I=$O(OREAS(I)) Q:I="" S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_OREAS(I)
- I 'OREASON D
- . F S I=$O(ORMODS(I)) Q:'I S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_ORMODS(I)
- S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~INFO"
- D PTINFO(.INFO,.ORX)
- S I=0 F S I=$O(^TMP("ORVBEC",$J,I)) Q:'I S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_^TMP("ORVBEC",$J,I,0)
- S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="~TNS ORDERS"
- N ORMODS D PULL^ORWDXVB2(.ORMODS,DFN,,,$G(EDATE))
- S I=0 F S I=$O(ORMODS(I)) Q:'I S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)="i"_ORMODS(I)
- K ^TMP("ORVBEC",$J)
- Q
- STATALOW(OROOT,DFN) ;Allow stat for ORES ORELSE users
- S OROOT=$D(^XUSEC("ORES",DUZ))!($D(^XUSEC("ORELSE",DUZ)))
- Q
- NURSADMN(OROOT) ;Suppress Nursing Adiminstration Order Prompt
- S OROOT=+$$GET^XPAR("DIV^SYS^PKG","OR VBECS SUPPRESS NURS ADMIN")
- Q
- VBTNS(RETURN) ;RPC to get Days back to check for Type & Screen order
- S RETURN=$$GET^XPAR("ALL","ORWDXVB VBECS TNS CHECK",1,"I")
- Q
- COMPORD(OROOT) ;Get sequence order of Blood Components
- N ORLIST,I,X
- D GETLST^XPAR(.ORLIST,"ALL","OR VBECS COMPONENT ORDER")
- S I=0 F S I=$O(ORLIST(I)) Q:'I S X=ORLIST(I) I $D(^ORD(101.43,$P(X,"^",2),0)) S OROOT(I)=$P(X,"^",2)_"^"_$P(^(0),"^",1)_"^"_$P(^(0),"^",1)
- Q
- SUBCHK(OROOT,TSTNM) ;Check to see if selected test is a Blood Component or a Diagnostic Test
- S OROOT=""
- Q:'$L($G(TSTNM))
- I $O(^ORD(101.43,"S.VBT",TSTNM,0)) S OROOT="t"
- I $O(^ORD(101.43,"S.VBC",TSTNM,0)) S OROOT="c"
- Q
- TESTR ;Test results call
- N ORX
- S ORX(3)="3" ;HGB
- S ORX(4)="4" ;HCT
- S ORX(1)="1" ;WBC
- S ORX(113)="113" ;FERRITIN
- D RESULTS(.OROOT,66,.ORX)
- S I=0 F S I=$O(@OROOT@(I)) Q:'I W !,^(I,0)
- K @OROOT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDXVB 7278 printed Feb 19, 2025@00:02:38 Page 2
- ORWDXVB ;SLC/DCM - Order dialog utilities for Blood Bank ;Dec 02, 2021@12:46:23
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,243,212,309,332,405**;Dec 17 1997;Build 211
- +2 ;
- +3 ; DBIA 2503 RR^LR7OR1 ^TMP("LRRR",$J)
- +4 ;
- GETPAT(ORX,DFN,ORL) ;Get Patient data from VBECS
- +1 ;Needs patient DFN and Location (ORL)
- +2 NEW ORSTN,DIV
- +3 SET DIV=+$PIECE($GET(^SC(+$GET(ORL),0)),U,15)
- SET ORSTN=$PIECE($$SITE^VASITE(DT,DIV),U,3)
- +4 DO OEAPI^VBECA3(.ORX,DFN,ORSTN)
- +5 QUIT
- PTINFO(OROOT,ORX) ;Format patient BB info
- +1 if '$DATA(ORX)
- QUIT
- +2 DO PTINFO^ORWDXVB1
- +3 QUIT
- RESULTS(OROOT,DFN,ORX) ;Get test results
- +1 ;ORX contains a list of tests to retrieve results for
- if '$ORDER(ORX(0))
- QUIT
- +2 NEW ORCOM,ORT,ORTST,ORTDT,ORTMP,GCNT,CCNT,GIOSL,GIOM,I,ORZ
- +3 SET GCNT=0
- SET CCNT=1
- SET GIOSL=999999
- SET GIOM=80
- +4 SET OROOT=$NAME(^TMP("ORVBEC",$JOB))
- +5 KILL ^TMP("ORVBEC",$JOB)
- +6 DO LN
- +7 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"RECENT LAB RESULTS:",.CCNT)
- +8 DO LN
- +9 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"Test Result Units Range Collected Accession Sts",.CCNT)
- +10 DO LN
- +11 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,"---- ------ ----- ----- --------- --------- ---",.CCNT)
- +12 SET ORT=0
- FOR
- SET ORT=$ORDER(ORX(ORT))
- if 'ORT
- QUIT
- SET ORTST=$PIECE(ORX(ORT),"^",1)
- Begin DoDot:1
- +13 ;DBIA 2503
- KILL ^TMP("LRRR",$JOB)
- DO RR^LR7OR1(DFN,,,,,ORTST,,1)
- +14 SET ORTMP=$$FIRST^ORCDVBEC(DFN,ORTST)
- if '$LENGTH(ORTMP)
- QUIT
- +15 SET ORTDT=9999999-+$PIECE(ORTMP,",",5)
- SET ORZ=@ORTMP
- +16 DO LN
- +17 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,$PIECE(ORZ,"^",15),.CCNT)_$$S^ORU4(8,CCNT,$JUSTIFY($PIECE(ORZ,"^",2),7),.CCNT)_$$S^ORU4(16,CCNT,$PIECE(ORZ,"^",3),.CCNT)_$$S^ORU4(19,CCNT,$PIECE(ORZ,"^",4),.CCNT)_$$S^ORU4(30,CCNT,$PIECE(OR
- Z,"^",5),.CCNT)
- +18 SET ^(0)=^TMP("ORVBEC",$JOB,GCNT,0)_$$S^ORU4(40,CCNT,$$DATETIME^ORCHTAB(ORTDT),.CCNT)_$$S^ORU4(56,CCNT,$PIECE(ORZ,"^",16),.CCNT)_$$S^ORU4(71,CCNT,$PIECE(ORZ,"^",6),.CCNT)
- +19 ;check for comments
- SET ORCOM=$PIECE(ORTMP,",",1,5)_",""N"""
- +20 FOR
- SET ORTMP=$QUERY(@ORTMP)
- if $PIECE(ORTMP,",",1,6)'=ORCOM
- QUIT
- Begin DoDot:2
- +21 DO LN
- +22 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$$S^ORU4(1,CCNT,@ORTMP,.CCNT)
- End DoDot:2
- End DoDot:1
- +23 IF GCNT<4
- KILL ^TMP("ORVBEC",$JOB)
- +24 KILL ^TMP("LRRR",$JOB)
- +25 QUIT
- RAW(OROOT,DFN,ORX) ;Get RAW test results
- +1 ;ORX contains a list of tests to retrieve results for
- if '$ORDER(ORX(0))
- QUIT
- +2 NEW ORCOM,ORT,ORTST,ORTDT,ORTMP,GCNT,CCNT,GIOSL,GIOM,I
- +3 SET GCNT=0
- SET CCNT=1
- SET GIOSL=999999
- SET GIOM=80
- +4 SET OROOT=$NAME(^TMP("ORVBEC",$JOB))
- +5 KILL ^TMP("ORVBEC",$JOB)
- +6 SET ORT=0
- FOR
- SET ORT=$ORDER(ORX(ORT))
- if 'ORT
- QUIT
- SET ORTST=$PIECE(ORX(ORT),"^",1)
- Begin DoDot:1
- +7 KILL ^TMP("LRRR",$JOB)
- DO RR^LR7OR1(DFN,,,,,ORTST,,1)
- +8 SET ORTMP="^TMP(""LRRR"",$J,DFN)"
- SET ORTMP=$QUERY(@ORTMP)
- +9 if $PIECE(ORTMP,",",1,3)'=("^TMP(""LRRR"","_$JOB_","_DFN)
- QUIT
- +10 SET ORTDT=9999999-+$PIECE(ORTMP,",",5)
- SET ORZ=@ORTMP
- +11 DO LN
- +12 SET ^TMP("ORVBEC",$JOB,GCNT,0)=$PIECE(ORZ,"^",1,6)_"^"_ORTDT
- End DoDot:1
- +13 KILL ^TMP("LRRR",$JOB)
- +14 QUIT
- SURG(OROOT,ORX) ;Get list of surgeries
- +1 NEW I,CNT,X
- +2 SET (I,CNT)=0
- +3 FOR
- SET I=$ORDER(ORX("SURGERY",I))
- if 'I
- QUIT
- SET X=$GET(ORX("SURGERY",I))
- Begin DoDot:1
- +4 SET CNT=CNT+1
- SET OROOT(CNT)=X_U_X
- End DoDot:1
- +5 QUIT
- LN ;Increment counts
- +1 SET GCNT=GCNT+1
- SET CCNT=1
- +2 QUIT
- PATINFO(OROOT,DFN,LOC) ;Test ^TMP global output
- +1 NEW ORX
- +2 DO GETPAT(.ORX,DFN,LOC)
- +3 IF $LENGTH($GET(ORX("SPECIMEN")))
- if $PIECE(ORX("SPECIMEN"),"^")
- SET $PIECE(ORX("SPECIMEN"),"^")=$$HL7TFM^XLFDT($PIECE(ORX("SPECIMEN"),"^"))
- +4 DO PTINFO(.OROOT,.ORX)
- +5 ;S I=0 F S I=$O(@OROOT@(I)) Q:'I W !,^(I,0)
- +6 ;K @OROOT
- +7 QUIT
- GETALL(OROOT,DFN,LOC,EDATE) ;Get all data in one call and let the GUI divide it up
- +1 NEW ORX,INFO,CNT,I,J,K,OREAS,OREASON
- +2 SET OROOT=$NAME(^TMP("ORVBECINFO",$JOB))
- SET CNT=1
- +3 DO GETPAT(.ORX,DFN,LOC)
- +4 ;S ^TMP("ORVBECINFO",$J,CNT)="~RAWDATA",I=0
- +5 ;F S I=$O(ORX(I)) Q:'I S CNT=CNT+1,^TMP("ORVBECINFO",$J,CNT)=ORX(I)
- +6 IF $LENGTH($GET(ORX("SPECIMEN")))
- if $PIECE(ORX("SPECIMEN"),"^")
- SET $PIECE(ORX("SPECIMEN"),"^")=$$HL7TFM^XLFDT($PIECE(ORX("SPECIMEN"),"^"))
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~SPECIMEN"
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_ORX("SPECIMEN")
- +7 IF $LENGTH($GET(ORX("ABORH")))
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~ABORH"
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_ORX("ABORH")
- +8 SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~TYPE AND SCREEN"
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_$ORDER(^ORD(101.43,"ID","1;99VBC",0))
- +9 SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~OTHER"
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_$ORDER(^ORD(101.43,"ID","6;99VBC",0))
- +10 SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~SPECIMENS"
- SET I=0
- +11 FOR
- SET I=$ORDER(ORX(I))
- if 'I
- QUIT
- SET J=""
- FOR
- SET J=$ORDER(ORX(I,J))
- if J=""
- QUIT
- IF J="SPECIMEN"
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_I_"^"_ORX(I,J)
- +12 SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~TESTS"
- SET I=0
- +13 FOR
- SET I=$ORDER(ORX(I))
- if 'I
- QUIT
- SET J=""
- FOR
- SET J=$ORDER(ORX(I,J))
- if J=""
- QUIT
- IF J="TEST"
- SET K=0
- FOR
- SET K=$ORDER(ORX(I,J,K))
- if 'K
- QUIT
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_I_"^"_K_"^"_ORX(I,J,K)
- +14 SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~MSBOS"
- SET I=0
- +15 FOR
- SET I=$ORDER(ORX(I))
- if 'I
- QUIT
- SET J=""
- FOR
- SET J=$ORDER(ORX(I,J))
- if J=""
- QUIT
- IF J="MSBOS"
- SET K=0
- FOR
- SET K=$ORDER(ORX(I,J,K))
- if 'K
- QUIT
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_I_"^"_K_"^"_ORX(I,J,K)
- SET $PIECE(^(CNT),"^",4)=+$PIECE(ORX(I,J,K),"^",2)
- +16 SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~SURGERIES"
- SET I=0
- +17 FOR
- SET I=$ORDER(ORX("SURGERY",I))
- if 'I
- QUIT
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_I_"^"_ORX("SURGERY",I)
- +18 SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~URGENCIES"
- SET I=""
- +19 FOR
- SET I=$ORDER(^ORD(101.42,"S.VBEC",I))
- if I=""
- QUIT
- SET J=0
- FOR
- SET J=$ORDER(^ORD(101.42,"S.VBEC",I,J))
- if 'J
- QUIT
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_J_"^"_I
- +20 SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~MODIFIERS"
- SET I=""
- +21 NEW ORMODS
- DO GETLST^XPAR(.ORMODS,"ALL","OR VBECS MODIFIERS","I")
- +22 FOR
- SET I=$ORDER(ORMODS(I))
- if 'I
- QUIT
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_ORMODS(I)
- +23 SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~REASONS"
- SET I=""
- +24 NEW ORMODS
- DO GETLST^XPAR(.ORMODS,"ALL","OR VBECS REASON FOR REQUEST","I")
- +25 SET OREASON=$$GET^XPAR("DIV^SYS^PKG","OR VBECS REASON SORT ALPHA",1,"Q")
- +26 IF OREASON
- Begin DoDot:1
- +27 FOR
- SET I=$ORDER(ORMODS(I))
- if 'I
- QUIT
- SET OREAS(" "_$$UP^XLFSTR(ORMODS(I)))=ORMODS(I)
- +28 SET I=""
- FOR
- SET I=$ORDER(OREAS(I))
- if I=""
- QUIT
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_OREAS(I)
- End DoDot:1
- +29 IF 'OREASON
- Begin DoDot:1
- +30 FOR
- SET I=$ORDER(ORMODS(I))
- if 'I
- QUIT
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_ORMODS(I)
- End DoDot:1
- +31 SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~INFO"
- +32 DO PTINFO(.INFO,.ORX)
- +33 SET I=0
- FOR
- SET I=$ORDER(^TMP("ORVBEC",$JOB,I))
- if 'I
- QUIT
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_^TMP("ORVBEC",$JOB,I,0)
- +34 SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="~TNS ORDERS"
- +35 NEW ORMODS
- DO PULL^ORWDXVB2(.ORMODS,DFN,,,$GET(EDATE))
- +36 SET I=0
- FOR
- SET I=$ORDER(ORMODS(I))
- if 'I
- QUIT
- SET CNT=CNT+1
- SET ^TMP("ORVBECINFO",$JOB,CNT)="i"_ORMODS(I)
- +37 KILL ^TMP("ORVBEC",$JOB)
- +38 QUIT
- STATALOW(OROOT,DFN) ;Allow stat for ORES ORELSE users
- +1 SET OROOT=$DATA(^XUSEC("ORES",DUZ))!($DATA(^XUSEC("ORELSE",DUZ)))
- +2 QUIT
- NURSADMN(OROOT) ;Suppress Nursing Adiminstration Order Prompt
- +1 SET OROOT=+$$GET^XPAR("DIV^SYS^PKG","OR VBECS SUPPRESS NURS ADMIN")
- +2 QUIT
- VBTNS(RETURN) ;RPC to get Days back to check for Type & Screen order
- +1 SET RETURN=$$GET^XPAR("ALL","ORWDXVB VBECS TNS CHECK",1,"I")
- +2 QUIT
- COMPORD(OROOT) ;Get sequence order of Blood Components
- +1 NEW ORLIST,I,X
- +2 DO GETLST^XPAR(.ORLIST,"ALL","OR VBECS COMPONENT ORDER")
- +3 SET I=0
- FOR
- SET I=$ORDER(ORLIST(I))
- if 'I
- QUIT
- SET X=ORLIST(I)
- IF $DATA(^ORD(101.43,$PIECE(X,"^",2),0))
- SET OROOT(I)=$PIECE(X,"^",2)_"^"_$PIECE(^(0),"^",1)_"^"_$PIECE(^(0),"^",1)
- +4 QUIT
- SUBCHK(OROOT,TSTNM) ;Check to see if selected test is a Blood Component or a Diagnostic Test
- +1 SET OROOT=""
- +2 if '$LENGTH($GET(TSTNM))
- QUIT
- +3 IF $ORDER(^ORD(101.43,"S.VBT",TSTNM,0))
- SET OROOT="t"
- +4 IF $ORDER(^ORD(101.43,"S.VBC",TSTNM,0))
- SET OROOT="c"
- +5 QUIT
- TESTR ;Test results call
- +1 NEW ORX
- +2 ;HGB
- SET ORX(3)="3"
- +3 ;HCT
- SET ORX(4)="4"
- +4 ;WBC
- SET ORX(1)="1"
- +5 ;FERRITIN
- SET ORX(113)="113"
- +6 DO RESULTS(.OROOT,66,.ORX)
- +7 SET I=0
- FOR
- SET I=$ORDER(@OROOT@(I))
- if 'I
- QUIT
- WRITE !,^(I,0)
- +8 KILL @OROOT
- +9 QUIT