PSBVT ;BIRMINGHAM/EFC-BCMA ORDER VARIABLES UTILITY ; 8/4/05 8:05am
;;3.0;BAR CODE MED ADMIN;**6,3,38**;Mar 2004;Build 8
;Per VHA Directive 2004-038, this routine should not be modified.
;
; Reference/IA
; EN^PSJBCMA1/2829
; ^TMP("PSJ",$J/2828
;
PSJ(PSBX1) ;
S ^TMP("TK PSJ",PSBX1)=""
S PSBSCRT="^TMP(""PSB"",$J,""PSBORDA"")"
K @PSBSCRT M @PSBSCRT=^TMP("PSJ",$J,PSBX1)
S PSBDFN=DFN
S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",0))
S PSBON=+$P(PSBSCRT,U,3) ; ord num w/o type
S PSBONX=$P(PSBSCRT,U,3) ; ord num w/ type "U" or "V"
S PSBOTYP=$E(PSBONX,$L(PSBONX))
S PSBPONX=$P(PSBSCRT,U,4) ; prev ord num
S PSBFON=$P(PSBSCRT,U,5) ; foll ord num
S PSBIVT=$P(PSBSCRT,U,6) ; IV type
S PSBISYR=$P(PSBSCRT,U,7) ; intermit syrg
S PSBCHEMT=$P(PSBSCRT,U,8) ; chemo type
S PSBCPRS=$P(PSBSCRT,U,9) ; ords file entry (CPRS order #)
S PSBFOR=$P(PSBSCRT,U,10) ; reason for foll order
Q:PSBSCRT=-1
S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",1))
S PSBMR=$P($G(^TMP("PSB",$J,"PSBORDA",1,0)),U,2) ;med rt
S PSBMRAB=$P(PSBSCRT,U,1) ;med rt abbr
S PSBNJECT=+$G(^TMP("PSB",$J,"PSBORDA",1,0)) ;Inj site
S PSBIVPSH=+$P($G(^TMP("PSB",$J,"PSBORDA",1,0)),U,3) ;IV PUSH
S PSBSCHT=$P(PSBSCRT,U,2) ; sched type conversion
S PSBSCH=$P(PSBSCRT,U,3) ; sched
S PSBOST=$P(PSBSCRT,U,4) ; strt dte FM
S PSBOSP=$P(PSBSCRT,U,5) ; stp dte FM
S PSBADST=$P(PSBSCRT,U,6) ; admin times strin in NNNN- format
S PSBOSTS=$P(PSBSCRT,U,7) ; status
S PSBNGF=$P(PSBSCRT,U,8) ; not to be given flag
S PSBOSCHT=$P(PSBSCRT,U,9) ; origin sched type
S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",2))
S PSBDOSE=$P(PSBSCRT,U,1) ; dosage ordered
S PSBIFR=$P(PSBSCRT,U,2) ; infusn rate
S PSBSM=$P(PSBSCRT,U,3) ; self med
S PSBHSM=$P(PSBSCRT,U,4) ; hospital supplied self med
S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",3))
S PSBOIT=$P(PSBSCRT,U,1) ; order item IEN - > ^ORD(101.43)
S PSBOITX=$P(PSBSCRT,U,2) ; order item (expanded)_" "_dosage form
I PSBOITX="" S PSBOITX="ZZZZ NO ORDERABLE ITEM"
S PSBDOSEF=$P(PSBSCRT,U,3) ; dosage form
S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",4))
S PSBOTXT=PSBSCRT ; special inst/other print info
; get disp drug
I $G(^TMP("PSB",$J,"PSBORDA",700,0)) F PSBX2=1:1:^TMP("PSB",$J,"PSBORDA",700,0) M PSBDDA(PSBX2)=^TMP("PSB",$J,"PSBORDA",700,PSBX2,0) S PSBDDA(PSBX2)="DD^"_PSBDDA(PSBX2) ; # of DDrug
; "DD"^dispensed drug IEN -> ^PSDRUG() DRUG^dispensed drug name^units per dose^inactive date
; build unique id list
; add addits
I $D(^TMP("PSB",$J,"PSBORDA",800)) S PSBX2="" F S PSBX2=$O(^TMP("PSB",$J,"PSBORDA",800,PSBX2)) Q:PSBX2=""!(PSBX2="ERROR") D
.S PSBUIDA(PSBX2)="ID^"_PSBX2 F J=1:1:^TMP("PSB",$J,"PSBORDA",800,PSBX2,0) S PSBUIDA(PSBX2)=PSBUIDA(PSBX2)_"^"_"ADD;"_$P(^TMP("PSB",$J,"PSBORDA",800,PSBX2,J),U,1)
; add solutions
I $D(^TMP("PSB",$J,"PSBORDA",900)) S PSBX2="" F S PSBX2=$O(^TMP("PSB",$J,"PSBORDA",900,PSBX2)) Q:PSBX2=""!(PSBX2="ERROR") D
.I '$D(PSBUIDA(PSBX2)) S PSBUIDA(PSBX2)="ID^"_PSBX2
.F J=1:1:^TMP("PSB",$J,"PSBORDA",900,PSBX2,0) S PSBUIDA(PSBX2)=PSBUIDA(PSBX2)_"^"_"SOL;"_$P(^TMP("PSB",$J,"PSBORDA",900,PSBX2,J),U,1)
; "ID" ^ (piece 2,3,)... = type;IEN of each add/sol for this ID ex. "SOL;4"
; get addits
I $G(^TMP("PSB",$J,"PSBORDA",850,0)) F PSBX2=1:1:^TMP("PSB",$J,"PSBORDA",850,0) D
.M PSBADA(PSBX2)=^TMP("PSB",$J,"PSBORDA",850,PSBX2,0) ; number od additives (exists only for IV)
.S PSBADA(PSBX2)="ADD^"_PSBADA(PSBX2)
.S PSBBAGS=$P(PSBADA(PSBX2),U,5) I PSBBAGS'="" S PSBBAG=" IN BAG "_$P(PSBBAGS,",",1) F I=2:1 S X=$P(PSBBAGS,",",I) Q:X="" S PSBBAG=PSBBAG_" AND "_X
.S:PSBBAGS'="" $P(PSBADA(PSBX2),U,5)=PSBBAG,$P(PSBADA(PSBX2),U,6)=PSBBAGS
; "ADD"^additive IEN -> ^PS(52.6) IV ADDITIVES^additive name^strength ^bottle
; get soluts
I $G(^TMP("PSB",$J,"PSBORDA",950,0)) F PSBX2=1:1:^TMP("PSB",$J,"PSBORDA",950,0) M PSBSOLA(PSBX2)=^TMP("PSB",$J,"PSBORDA",950,PSBX2,0) S PSBSOLA(PSBX2)="SOL^"_PSBSOLA(PSBX2) ; # of SOL
; "SOL"^solution IEN -> ^PS(52.7) IV SOLUTIONS^solution name^volume
K ^TMP("PSB",$J,"PSBORDA"),PSBX1,PSBX2
Q
;
PSJ1(PSBPAR1,PSBPAR2) ; set the variables for an individual order
S ^TMP("TK PSJ1",PSBPAR1,PSBPAR2)=""
; PSBPAR1 = DFN
; PSBPAR2 = ORDNER NUMBER
S PSBSCRT="^TMP(""PSB"",$J,""PSBORDA"")"
K @PSBSCRT
N PSBX
K ^TMP("PSJ1",$J) D EN^PSJBCMA1(PSBPAR1,PSBPAR2,1)
M @PSBSCRT=^TMP("PSJ1",$J) K ^TMP("PSJ1",$J)
S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",0))
S PSBDFN=PSBPAR1
S PSBON=+$P(PSBSCRT,U,3) ; ord num w/o type
S PSBONX=$P(PSBSCRT,U,3) ; ord num w/ type "U" or "V"
S PSBOTYP=$E(PSBONX,$L(PSBONX))
S PSBPONX=$P(PSBSCRT,U,4) ; prev ord num
S PSBFON=$P(PSBSCRT,U,5) ; foll ord num
S PSBIVT=$P(PSBSCRT,U,6) ; IV type
S PSBISYR=$P(PSBSCRT,U,7) ; intermit syrg
S PSBCHEMT=$P(PSBSCRT,U,8) ; chemo type
S PSBCPRS=$P(PSBSCRT,U,0) ; ord file entry (CPRS order #)
Q:PSBSCRT=-1
S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",1))
S PSBMD=$P(PSBSCRT,U,1) ; prov IEN -> ^VA(200)
S PSBMDX=$P(PSBSCRT,U,2) ; prov name
S PSBMR=$P(PSBSCRT,U,3) ; med rt IEN -> ^PS(51.2)
I $G(PSBMR)'="" S PSBMR=$P(PSBSCRT,U,13) ;med rt
S PSBMRAB=$P(PSBSCRT,U,4) ;med rt abbr
S PSBNJECT=+$G(^TMP("PSB",$J,"PSBORDA",1,0)) ;Inj site
S PSBIVPSH=+$P($G(^TMP("PSB",$J,"PSBORDA",1,0)),U,2) ;IV PUSH
S PSBSM=$P(PSBSCRT,U,5) ; self med
S PSBSMX=$P(PSBSCRT,U,6) ; expnd to YES/NO
S PSBHSM=$P(PSBSCRT,U,7) ; hospital supplied self med
S PSBHSMX=$P(PSBSCRT,U,8) ; expnd to YES/NO
S PSBNGF=$P(PSBSCRT,U,9) ; not to be given flag
S PSBOSTS=$P(PSBSCRT,U,10) ; ord status
S PSBOSTSX=$P(PSBSCRT,U,11) ; ord status expans
S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",2))
S PSBOIT=$P(PSBSCRT,U,1) ; orderable item IEN -> ^ORD(101.43) ORDERABLE ITEM
S PSBOITX=$P(PSBSCRT,U,2) ; orderable item (expaned)_" "_ dosage form
I PSBOITX="" S PSBOITX="ZZZZ NO ORDERABLE ITEM"
S PSBDOSE=$P(PSBSCRT,U,3) ; dosage ordered
S PSBIFR=$P(PSBSCRT,U,4) ; infusion rate
S PSBSCH=$P(PSBSCRT,U,5) ; sched
S PSBDOSEF=$P(PSBSCRT,U,6) ; dosage form
S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",3))
S PSBOTXT=$P(PSBSCRT,U,1) ; UD special inst or IV other print info
S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",4))
S PSBSCHT=$P(PSBSCRT,U,1) ; sched type conversion
S PSBSCHTX=$P(PSBSCRT,U,2) ; sched type expansion
S PSBLDT=$P(PSBSCRT,U,3) ; log-in date FM
S PSBLDTX=$P(PSBSCRT,U,4) ; exp MM/DD/YYYY HH:MM
S PSBOST=$P(PSBSCRT,U,5) ; start date FM
S PSBOSTX=$P(PSBSCRT,U,6) ; exp MM/DD/YYYY HH:MM
S PSBOSP=$P(PSBSCRT,U,7) ; stop date FM
S PSBOSPX=$P(PSBSCRT,U,8) ; exp MM/DD/YYYY HH:MM
S PSBADST=$P(PSBSCRT,U,9) ; admin times string in NNNN- format
S PSBOSCHT=$P(PSBSCRT,U,10) ; original schedule type
S PSBFREQ=$P(PSBSCRT,U,11) ; frequency
S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",5))
S PSBVN=$P(PSBSCRT,U,1) ; verify nurse IEN -> ^VA(200)
S PSBVNX=$P(PSBSCRT,U,2) ; nurse name
S PSBVNI=$P(PSBSCRT,U,3) ; nurse initials
S PSBVPH=$P(PSBSCRT,U,4) ; verify pharm IEN -> ^VA(200)
S PSBVPHX=$P(PSBSCRT,U,5) ; pharm name
S PSBVPHI=$P(PSBSCRT,U,6) ; pharm initials
S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",6))
S PSBRMRK=$G(PSBSCRT)
;If DayOFWeek set frequen to NULL
I $$PSBDCHK1^PSBVT1(PSBSCH) S PSBFREQ=""
; get dispensed drug
I $G(^TMP("PSB",$J,"PSBORDA",700,0)) F PSBX=1:1:^TMP("PSB",$J,"PSBORDA",700,0) M PSBDDA(PSBX)=^TMP("PSB",$J,"PSBORDA",700,PSBX,0) S PSBDDA(PSBX)="DD^"_PSBDDA(PSBX) ; # of DDrug
; "DD"^dispensed drug IEN -> ^PSDRUG() DRUG^dispensed drug name^units per dose^inactive date
; build unique id list
; add addits
I $D(^TMP("PSB",$J,"PSBORDA",800)) S PSBX2="" F S PSBX2=$O(^TMP("PSB",$J,"PSBORDA",800,PSBX2)) Q:PSBX2=""!(PSBX2="ERROR") D
.S PSBUIDA(PSBX2)="ID^"_PSBX2 F J=1:1:^TMP("PSB",$J,"PSBORDA",800,PSBX2,0) S PSBUIDA(PSBX2)=PSBUIDA(PSBX2)_"^"_"ADD;"_$P(^TMP("PSB",$J,"PSBORDA",800,PSBX2,J),U,1)
; add soluts
I $D(^TMP("PSB",$J,"PSBORDA",900)) S PSBX2="" F S PSBX2=$O(^TMP("PSB",$J,"PSBORDA",900,PSBX2)) Q:PSBX2=""!(PSBX2="ERROR") D
.I '$D(PSBUIDA(PSBX2)) S PSBUIDA(PSBX2)="ID^"_PSBX2
.F J=1:1:^TMP("PSB",$J,"PSBORDA",900,PSBX2,0) S PSBUIDA(PSBX2)=PSBUIDA(PSBX2)_"^"_"SOL;"_$P(^TMP("PSB",$J,"PSBORDA",900,PSBX2,J),U,1)
; "ID" ^ (piece 2,3),... = type;IEN of each add/sol for this ID ex. "SOL;4"
; get addits
I $G(^TMP("PSB",$J,"PSBORDA",850,0)) F PSBX=1:1:^TMP("PSB",$J,"PSBORDA",850,0) D
.M PSBADA(PSBX)=^TMP("PSB",$J,"PSBORDA",850,PSBX,0) ; num of addits
.S PSBADA(PSBX)="ADD^"_PSBADA(PSBX)
.S PSBBAGS=$P(PSBADA(PSBX),U,5) I PSBBAGS'="" S PSBBAG=" IN BAG "_$P(PSBBAGS,",",1) D
..F I=2:1 S X=$P(PSBBAGS,",",I) Q:X="" S PSBBAG=PSBBAG_" AND "_X
.S:PSBBAGS'="" $P(PSBADA(PSBX),U,5)=PSBBAG
; "ADD"^additive IEN -> ^PS(52.6) IV ADDITIVES^additive name^strength^bottle
; get soluts
I $G(^TMP("PSB",$J,"PSBORDA",950,0)) F PSBX=1:1:^TMP("PSB",$J,"PSBORDA",950,0) M PSBSOLA(PSBX)=^TMP("PSB",$J,"PSBORDA",950,PSBX,0) S PSBSOLA(PSBX)="SOL^"_PSBSOLA(PSBX) ; # of SOLs
; "SOL" ^ solution IEN -> ^PS(52.7) IV SOLUTIONS^solution name^volume
; get label
I $D(^TMP("PSB",$J,"PSBORDA",1000)) M PSBLBLA=^TMP("PSB",$J,"PSBORDA",1000)
K ^TMP("PSB",$J,"PSBORDA")
Q
;
LACTION ; get last action info
S (PSBLADT,PSBLAIEN,PSBLASTS)=""
I '$D(^PSB(53.79,"AORDX",PSBDFN,PSBONX)) Q
S PSBLADT=$O(^PSB(53.79,"AORDX",PSBDFN,PSBONX,""),-1)
S PSBLAIEN=$O(^PSB(53.79,"AORDX",PSBDFN,PSBONX,PSBLADT,""))
S PSBLASTS=$P(^PSB(53.79,PSBLAIEN,0),U,9)
Q
;
CLEAN ;
K PSBONX,PSBPONX,PSBFON,PSBOTYP,PSBIVT,PSBISYR,PSBCHEMT,PSBMD,PSBMDX,PSBMR,PSBMRAB,PSBSM,PSBSMX,PSBHSM,PSBHSMX
K PSBDFN,PSBNGF,PSBOSTS,PSBOSTSX,PSBOIT,PSBOITX,PSBDOSE,PSBIFR,PSBSCH,PSBDOSEF,PSBOTXT,PSBSCHT,PSBSCHTX
K PSBLDT,PSBLDTX,PSBOST,PSBOSTX,PSBOSP,PSBOSPX,PSBADST,PSBOSCHT,PSBFREQ,PSBVN,PSBVNX,PSBVNI
K PSBVPH,PSBVPHX,PSBVPHI,PSBDDA,PSBADA,PSBSOLA,PSBUIDA,PSBCPRS,PSBON,PSBRMRK,PSBNJECT,PSBIVPSH
K PSBLADT,PSBLAIEN,PSBLASTS,PSBBAG,PSBBAGS,PSBLBLA,PSBFOR,PSBSCRT
Q
PSBVT ;BIRMINGHAM/EFC-BCMA ORDER VARIABLES UTILITY ; 8/4/05 8:05am
+1 ;;3.0;BAR CODE MED ADMIN;**6,3,38**;Mar 2004;Build 8
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ; EN^PSJBCMA1/2829
+6 ; ^TMP("PSJ",$J/2828
+7 ;
PSJ(PSBX1) ;
+1 SET ^TMP("TK PSJ",PSBX1)=""
+2 SET PSBSCRT="^TMP(""PSB"",$J,""PSBORDA"")"
+3 KILL @PSBSCRT
MERGE @PSBSCRT=^TMP("PSJ",$JOB,PSBX1)
+4 SET PSBDFN=DFN
+5 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",0))
+6 ; ord num w/o type
SET PSBON=+$PIECE(PSBSCRT,U,3)
+7 ; ord num w/ type "U" or "V"
SET PSBONX=$PIECE(PSBSCRT,U,3)
+8 SET PSBOTYP=$EXTRACT(PSBONX,$LENGTH(PSBONX))
+9 ; prev ord num
SET PSBPONX=$PIECE(PSBSCRT,U,4)
+10 ; foll ord num
SET PSBFON=$PIECE(PSBSCRT,U,5)
+11 ; IV type
SET PSBIVT=$PIECE(PSBSCRT,U,6)
+12 ; intermit syrg
SET PSBISYR=$PIECE(PSBSCRT,U,7)
+13 ; chemo type
SET PSBCHEMT=$PIECE(PSBSCRT,U,8)
+14 ; ords file entry (CPRS order #)
SET PSBCPRS=$PIECE(PSBSCRT,U,9)
+15 ; reason for foll order
SET PSBFOR=$PIECE(PSBSCRT,U,10)
+16 IF PSBSCRT=-1
QUIT
+17 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",1))
+18 ;med rt
SET PSBMR=$PIECE($GET(^TMP("PSB",$JOB,"PSBORDA",1,0)),U,2)
+19 ;med rt abbr
SET PSBMRAB=$PIECE(PSBSCRT,U,1)
+20 ;Inj site
SET PSBNJECT=+$GET(^TMP("PSB",$JOB,"PSBORDA",1,0))
+21 ;IV PUSH
SET PSBIVPSH=+$PIECE($GET(^TMP("PSB",$JOB,"PSBORDA",1,0)),U,3)
+22 ; sched type conversion
SET PSBSCHT=$PIECE(PSBSCRT,U,2)
+23 ; sched
SET PSBSCH=$PIECE(PSBSCRT,U,3)
+24 ; strt dte FM
SET PSBOST=$PIECE(PSBSCRT,U,4)
+25 ; stp dte FM
SET PSBOSP=$PIECE(PSBSCRT,U,5)
+26 ; admin times strin in NNNN- format
SET PSBADST=$PIECE(PSBSCRT,U,6)
+27 ; status
SET PSBOSTS=$PIECE(PSBSCRT,U,7)
+28 ; not to be given flag
SET PSBNGF=$PIECE(PSBSCRT,U,8)
+29 ; origin sched type
SET PSBOSCHT=$PIECE(PSBSCRT,U,9)
+30 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",2))
+31 ; dosage ordered
SET PSBDOSE=$PIECE(PSBSCRT,U,1)
+32 ; infusn rate
SET PSBIFR=$PIECE(PSBSCRT,U,2)
+33 ; self med
SET PSBSM=$PIECE(PSBSCRT,U,3)
+34 ; hospital supplied self med
SET PSBHSM=$PIECE(PSBSCRT,U,4)
+35 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",3))
+36 ; order item IEN - > ^ORD(101.43)
SET PSBOIT=$PIECE(PSBSCRT,U,1)
+37 ; order item (expanded)_" "_dosage form
SET PSBOITX=$PIECE(PSBSCRT,U,2)
+38 IF PSBOITX=""
SET PSBOITX="ZZZZ NO ORDERABLE ITEM"
+39 ; dosage form
SET PSBDOSEF=$PIECE(PSBSCRT,U,3)
+40 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",4))
+41 ; special inst/other print info
SET PSBOTXT=PSBSCRT
+42 ; get disp drug
+43 ; # of DDrug
IF $GET(^TMP("PSB",$JOB,"PSBORDA",700,0))
FOR PSBX2=1:1:^TMP("PSB",$JOB,"PSBORDA",700,0)
MERGE PSBDDA(PSBX2)=^TMP("PSB",$JOB,"PSBORDA",700,PSBX2,0)
SET PSBDDA(PSBX2)="DD^"_PSBDDA(PSBX2)
+44 ; "DD"^dispensed drug IEN -> ^PSDRUG() DRUG^dispensed drug name^units per dose^inactive date
+45 ; build unique id list
+46 ; add addits
+47 IF $DATA(^TMP("PSB",$JOB,"PSBORDA",800))
SET PSBX2=""
FOR
SET PSBX2=$ORDER(^TMP("PSB",$JOB,"PSBORDA",800,PSBX2))
IF PSBX2=""!(PSBX2="ERROR")
QUIT
Begin DoDot:1
+48 SET PSBUIDA(PSBX2)="ID^"_PSBX2
FOR J=1:1:^TMP("PSB",$JOB,"PSBORDA",800,PSBX2,0)
SET PSBUIDA(PSBX2)=PSBUIDA(PSBX2)_"^"_"ADD;"_$PIECE(^TMP("PSB",$JOB,"PSBORDA",800,PSBX2,J),U,1)
End DoDot:1
+49 ; add solutions
+50 IF $DATA(^TMP("PSB",$JOB,"PSBORDA",900))
SET PSBX2=""
FOR
SET PSBX2=$ORDER(^TMP("PSB",$JOB,"PSBORDA",900,PSBX2))
IF PSBX2=""!(PSBX2="ERROR")
QUIT
Begin DoDot:1
+51 IF '$DATA(PSBUIDA(PSBX2))
SET PSBUIDA(PSBX2)="ID^"_PSBX2
+52 FOR J=1:1:^TMP("PSB",$JOB,"PSBORDA",900,PSBX2,0)
SET PSBUIDA(PSBX2)=PSBUIDA(PSBX2)_"^"_"SOL;"_$PIECE(^TMP("PSB",$JOB,"PSBORDA",900,PSBX2,J),U,1)
End DoDot:1
+53 ; "ID" ^ (piece 2,3,)... = type;IEN of each add/sol for this ID ex. "SOL;4"
+54 ; get addits
+55 IF $GET(^TMP("PSB",$JOB,"PSBORDA",850,0))
FOR PSBX2=1:1:^TMP("PSB",$JOB,"PSBORDA",850,0)
Begin DoDot:1
+56 ; number od additives (exists only for IV)
MERGE PSBADA(PSBX2)=^TMP("PSB",$JOB,"PSBORDA",850,PSBX2,0)
+57 SET PSBADA(PSBX2)="ADD^"_PSBADA(PSBX2)
+58 SET PSBBAGS=$PIECE(PSBADA(PSBX2),U,5)
IF PSBBAGS'=""
SET PSBBAG=" IN BAG "_$PIECE(PSBBAGS,",",1)
FOR I=2:1
SET X=$PIECE(PSBBAGS,",",I)
IF X=""
QUIT
SET PSBBAG=PSBBAG_" AND "_X
+59 IF PSBBAGS'=""
SET $PIECE(PSBADA(PSBX2),U,5)=PSBBAG
SET $PIECE(PSBADA(PSBX2),U,6)=PSBBAGS
End DoDot:1
+60 ; "ADD"^additive IEN -> ^PS(52.6) IV ADDITIVES^additive name^strength ^bottle
+61 ; get soluts
+62 ; # of SOL
IF $GET(^TMP("PSB",$JOB,"PSBORDA",950,0))
FOR PSBX2=1:1:^TMP("PSB",$JOB,"PSBORDA",950,0)
MERGE PSBSOLA(PSBX2)=^TMP("PSB",$JOB,"PSBORDA",950,PSBX2,0)
SET PSBSOLA(PSBX2)="SOL^"_PSBSOLA(PSBX2)
+63 ; "SOL"^solution IEN -> ^PS(52.7) IV SOLUTIONS^solution name^volume
+64 KILL ^TMP("PSB",$JOB,"PSBORDA"),PSBX1,PSBX2
+65 QUIT
+66 ;
PSJ1(PSBPAR1,PSBPAR2) ; set the variables for an individual order
+1 SET ^TMP("TK PSJ1",PSBPAR1,PSBPAR2)=""
+2 ; PSBPAR1 = DFN
+3 ; PSBPAR2 = ORDNER NUMBER
+4 SET PSBSCRT="^TMP(""PSB"",$J,""PSBORDA"")"
+5 KILL @PSBSCRT
+6 NEW PSBX
+7 KILL ^TMP("PSJ1",$JOB)
DO EN^PSJBCMA1(PSBPAR1,PSBPAR2,1)
+8 MERGE @PSBSCRT=^TMP("PSJ1",$JOB)
KILL ^TMP("PSJ1",$JOB)
+9 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",0))
+10 SET PSBDFN=PSBPAR1
+11 ; ord num w/o type
SET PSBON=+$PIECE(PSBSCRT,U,3)
+12 ; ord num w/ type "U" or "V"
SET PSBONX=$PIECE(PSBSCRT,U,3)
+13 SET PSBOTYP=$EXTRACT(PSBONX,$LENGTH(PSBONX))
+14 ; prev ord num
SET PSBPONX=$PIECE(PSBSCRT,U,4)
+15 ; foll ord num
SET PSBFON=$PIECE(PSBSCRT,U,5)
+16 ; IV type
SET PSBIVT=$PIECE(PSBSCRT,U,6)
+17 ; intermit syrg
SET PSBISYR=$PIECE(PSBSCRT,U,7)
+18 ; chemo type
SET PSBCHEMT=$PIECE(PSBSCRT,U,8)
+19 ; ord file entry (CPRS order #)
SET PSBCPRS=$PIECE(PSBSCRT,U,0)
+20 IF PSBSCRT=-1
QUIT
+21 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",1))
+22 ; prov IEN -> ^VA(200)
SET PSBMD=$PIECE(PSBSCRT,U,1)
+23 ; prov name
SET PSBMDX=$PIECE(PSBSCRT,U,2)
+24 ; med rt IEN -> ^PS(51.2)
SET PSBMR=$PIECE(PSBSCRT,U,3)
+25 ;med rt
IF $GET(PSBMR)'=""
SET PSBMR=$PIECE(PSBSCRT,U,13)
+26 ;med rt abbr
SET PSBMRAB=$PIECE(PSBSCRT,U,4)
+27 ;Inj site
SET PSBNJECT=+$GET(^TMP("PSB",$JOB,"PSBORDA",1,0))
+28 ;IV PUSH
SET PSBIVPSH=+$PIECE($GET(^TMP("PSB",$JOB,"PSBORDA",1,0)),U,2)
+29 ; self med
SET PSBSM=$PIECE(PSBSCRT,U,5)
+30 ; expnd to YES/NO
SET PSBSMX=$PIECE(PSBSCRT,U,6)
+31 ; hospital supplied self med
SET PSBHSM=$PIECE(PSBSCRT,U,7)
+32 ; expnd to YES/NO
SET PSBHSMX=$PIECE(PSBSCRT,U,8)
+33 ; not to be given flag
SET PSBNGF=$PIECE(PSBSCRT,U,9)
+34 ; ord status
SET PSBOSTS=$PIECE(PSBSCRT,U,10)
+35 ; ord status expans
SET PSBOSTSX=$PIECE(PSBSCRT,U,11)
+36 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",2))
+37 ; orderable item IEN -> ^ORD(101.43) ORDERABLE ITEM
SET PSBOIT=$PIECE(PSBSCRT,U,1)
+38 ; orderable item (expaned)_" "_ dosage form
SET PSBOITX=$PIECE(PSBSCRT,U,2)
+39 IF PSBOITX=""
SET PSBOITX="ZZZZ NO ORDERABLE ITEM"
+40 ; dosage ordered
SET PSBDOSE=$PIECE(PSBSCRT,U,3)
+41 ; infusion rate
SET PSBIFR=$PIECE(PSBSCRT,U,4)
+42 ; sched
SET PSBSCH=$PIECE(PSBSCRT,U,5)
+43 ; dosage form
SET PSBDOSEF=$PIECE(PSBSCRT,U,6)
+44 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",3))
+45 ; UD special inst or IV other print info
SET PSBOTXT=$PIECE(PSBSCRT,U,1)
+46 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",4))
+47 ; sched type conversion
SET PSBSCHT=$PIECE(PSBSCRT,U,1)
+48 ; sched type expansion
SET PSBSCHTX=$PIECE(PSBSCRT,U,2)
+49 ; log-in date FM
SET PSBLDT=$PIECE(PSBSCRT,U,3)
+50 ; exp MM/DD/YYYY HH:MM
SET PSBLDTX=$PIECE(PSBSCRT,U,4)
+51 ; start date FM
SET PSBOST=$PIECE(PSBSCRT,U,5)
+52 ; exp MM/DD/YYYY HH:MM
SET PSBOSTX=$PIECE(PSBSCRT,U,6)
+53 ; stop date FM
SET PSBOSP=$PIECE(PSBSCRT,U,7)
+54 ; exp MM/DD/YYYY HH:MM
SET PSBOSPX=$PIECE(PSBSCRT,U,8)
+55 ; admin times string in NNNN- format
SET PSBADST=$PIECE(PSBSCRT,U,9)
+56 ; original schedule type
SET PSBOSCHT=$PIECE(PSBSCRT,U,10)
+57 ; frequency
SET PSBFREQ=$PIECE(PSBSCRT,U,11)
+58 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",5))
+59 ; verify nurse IEN -> ^VA(200)
SET PSBVN=$PIECE(PSBSCRT,U,1)
+60 ; nurse name
SET PSBVNX=$PIECE(PSBSCRT,U,2)
+61 ; nurse initials
SET PSBVNI=$PIECE(PSBSCRT,U,3)
+62 ; verify pharm IEN -> ^VA(200)
SET PSBVPH=$PIECE(PSBSCRT,U,4)
+63 ; pharm name
SET PSBVPHX=$PIECE(PSBSCRT,U,5)
+64 ; pharm initials
SET PSBVPHI=$PIECE(PSBSCRT,U,6)
+65 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",6))
+66 SET PSBRMRK=$GET(PSBSCRT)
+67 ;If DayOFWeek set frequen to NULL
+68 IF $$PSBDCHK1^PSBVT1(PSBSCH)
SET PSBFREQ=""
+69 ; get dispensed drug
+70 ; # of DDrug
IF $GET(^TMP("PSB",$JOB,"PSBORDA",700,0))
FOR PSBX=1:1:^TMP("PSB",$JOB,"PSBORDA",700,0)
MERGE PSBDDA(PSBX)=^TMP("PSB",$JOB,"PSBORDA",700,PSBX,0)
SET PSBDDA(PSBX)="DD^"_PSBDDA(PSBX)
+71 ; "DD"^dispensed drug IEN -> ^PSDRUG() DRUG^dispensed drug name^units per dose^inactive date
+72 ; build unique id list
+73 ; add addits
+74 IF $DATA(^TMP("PSB",$JOB,"PSBORDA",800))
SET PSBX2=""
FOR
SET PSBX2=$ORDER(^TMP("PSB",$JOB,"PSBORDA",800,PSBX2))
IF PSBX2=""!(PSBX2="ERROR")
QUIT
Begin DoDot:1
+75 SET PSBUIDA(PSBX2)="ID^"_PSBX2
FOR J=1:1:^TMP("PSB",$JOB,"PSBORDA",800,PSBX2,0)
SET PSBUIDA(PSBX2)=PSBUIDA(PSBX2)_"^"_"ADD;"_$PIECE(^TMP("PSB",$JOB,"PSBORDA",800,PSBX2,J),U,1)
End DoDot:1
+76 ; add soluts
+77 IF $DATA(^TMP("PSB",$JOB,"PSBORDA",900))
SET PSBX2=""
FOR
SET PSBX2=$ORDER(^TMP("PSB",$JOB,"PSBORDA",900,PSBX2))
IF PSBX2=""!(PSBX2="ERROR")
QUIT
Begin DoDot:1
+78 IF '$DATA(PSBUIDA(PSBX2))
SET PSBUIDA(PSBX2)="ID^"_PSBX2
+79 FOR J=1:1:^TMP("PSB",$JOB,"PSBORDA",900,PSBX2,0)
SET PSBUIDA(PSBX2)=PSBUIDA(PSBX2)_"^"_"SOL;"_$PIECE(^TMP("PSB",$JOB,"PSBORDA",900,PSBX2,J),U,1)
End DoDot:1
+80 ; "ID" ^ (piece 2,3),... = type;IEN of each add/sol for this ID ex. "SOL;4"
+81 ; get addits
+82 IF $GET(^TMP("PSB",$JOB,"PSBORDA",850,0))
FOR PSBX=1:1:^TMP("PSB",$JOB,"PSBORDA",850,0)
Begin DoDot:1
+83 ; num of addits
MERGE PSBADA(PSBX)=^TMP("PSB",$JOB,"PSBORDA",850,PSBX,0)
+84 SET PSBADA(PSBX)="ADD^"_PSBADA(PSBX)
+85 SET PSBBAGS=$PIECE(PSBADA(PSBX),U,5)
IF PSBBAGS'=""
SET PSBBAG=" IN BAG "_$PIECE(PSBBAGS,",",1)
Begin DoDot:2
+86 FOR I=2:1
SET X=$PIECE(PSBBAGS,",",I)
IF X=""
QUIT
SET PSBBAG=PSBBAG_" AND "_X
End DoDot:2
+87 IF PSBBAGS'=""
SET $PIECE(PSBADA(PSBX),U,5)=PSBBAG
End DoDot:1
+88 ; "ADD"^additive IEN -> ^PS(52.6) IV ADDITIVES^additive name^strength^bottle
+89 ; get soluts
+90 ; # of SOLs
IF $GET(^TMP("PSB",$JOB,"PSBORDA",950,0))
FOR PSBX=1:1:^TMP("PSB",$JOB,"PSBORDA",950,0)
MERGE PSBSOLA(PSBX)=^TMP("PSB",$JOB,"PSBORDA",950,PSBX,0)
SET PSBSOLA(PSBX)="SOL^"_PSBSOLA(PSBX)
+91 ; "SOL" ^ solution IEN -> ^PS(52.7) IV SOLUTIONS^solution name^volume
+92 ; get label
+93 IF $DATA(^TMP("PSB",$JOB,"PSBORDA",1000))
MERGE PSBLBLA=^TMP("PSB",$JOB,"PSBORDA",1000)
+94 KILL ^TMP("PSB",$JOB,"PSBORDA")
+95 QUIT
+96 ;
LACTION ; get last action info
+1 SET (PSBLADT,PSBLAIEN,PSBLASTS)=""
+2 IF '$DATA(^PSB(53.79,"AORDX",PSBDFN,PSBONX))
QUIT
+3 SET PSBLADT=$ORDER(^PSB(53.79,"AORDX",PSBDFN,PSBONX,""),-1)
+4 SET PSBLAIEN=$ORDER(^PSB(53.79,"AORDX",PSBDFN,PSBONX,PSBLADT,""))
+5 SET PSBLASTS=$PIECE(^PSB(53.79,PSBLAIEN,0),U,9)
+6 QUIT
+7 ;
CLEAN ;
+1 KILL PSBONX,PSBPONX,PSBFON,PSBOTYP,PSBIVT,PSBISYR,PSBCHEMT,PSBMD,PSBMDX,PSBMR,PSBMRAB,PSBSM,PSBSMX,PSBHSM,PSBHSMX
+2 KILL PSBDFN,PSBNGF,PSBOSTS,PSBOSTSX,PSBOIT,PSBOITX,PSBDOSE,PSBIFR,PSBSCH,PSBDOSEF,PSBOTXT,PSBSCHT,PSBSCHTX
+3 KILL PSBLDT,PSBLDTX,PSBOST,PSBOSTX,PSBOSP,PSBOSPX,PSBADST,PSBOSCHT,PSBFREQ,PSBVN,PSBVNX,PSBVNI
+4 KILL PSBVPH,PSBVPHX,PSBVPHI,PSBDDA,PSBADA,PSBSOLA,PSBUIDA,PSBCPRS,PSBON,PSBRMRK,PSBNJECT,PSBIVPSH
+5 KILL PSBLADT,PSBLAIEN,PSBLASTS,PSBBAG,PSBBAGS,PSBLBLA,PSBFOR,PSBSCRT
+6 QUIT
