PSBVT ;BIRMINGHAM/EFC-BCMA ORDER VARIABLES UTILITY ;03/06/16 3:06pm
;;3.0;BAR CODE MED ADMIN;**6,3,38,68,74,70,83,106**;Mar 2004;Build 43
;Per VHA Directive 2004-038, this routine should not be modified.
;
; Reference/IA
; EN^PSJBCMA1/2829
; ^TMP("PSJ",$J/2828
;
;*68 Define New Variable (IEN from Med Route file) in Tag PSJ which
; uses the TMP global built by a previous call to PSJBCMA Api.
;*70 - define new variable, 1/0 flag for is a Clinic order
; - 1489: Blended PSB*3*74 with PSB*3*70
;*83 - create remove string var from new rmst passed PSJBCMA1
;*106- add Hazardous Handle & Dispose flags
;
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)) ; "U" or "V"
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
S PSBCLORD=$P(PSBSCRT,U,11) ; clinic order Name (is a CO) *70
; send clinic file #44 ien ptr *70
S PSBCLIEN=$P(PSBSCRT,U,12) ;*70
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 PSBMRIEN=+$P($G(^TMP("PSB",$J,"PSBORDA",1,0)),U,4) ; med rt ien *68
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 str 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
;define 4 new MRR type fields *83
S PSBDOA=$P(PSBSCRT,U,12) ; duration of administration
S PSBRMST=$P(PSBSCRT,U,13) ; removal times str in NNNN- format
S PSBMRRFL=$P(PSBSCRT,U,14) ; MRR flag (prompt removal bcma)
S PSBOPRSP=$P(PSBSCRT,U,15) ; Order previous Stop date/time
;
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 (expand)_" "_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
;
; if any order's medication components involved are flagged 1 for Hazardous, then the whole order is flagged with that hazardous condition. *106
; so init Haz flags to 0 now, then only reset flags if '1 per each medical component tested later. *106
S (PSBHAZHN,PSBHAZDS)=0
;
;get disp drug
I $G(^TMP("PSB",$J,"PSBORDA",700,0)) F PSBX2=1:1:^TMP("PSB",$J,"PSBORDA",700,0) D
. M PSBDDA(PSBX2)=^TMP("PSB",$J,"PSBORDA",700,PSBX2,0)
. S PSBDDA(PSBX2)="DD^"_PSBDDA(PSBX2) ; # of DDrug
. S:'PSBHAZHN PSBHAZHN=$P(PSBDDA(PSBX2),U,9) ;*106
. S:'PSBHAZDS PSBHAZDS=$P(PSBDDA(PSBX2),U,10) ;*106
; "DD" ^drug file(#50) IEN ^drug name ^units per dose ^inactive date ^ ^ ^high risk med ^remove med ^haz handle ^haz dispose
; build unique id list
; add additives
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 additives
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 of 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
.S:'PSBHAZHN PSBHAZHN=$P(PSBADA(PSBX2),U,8) ;*106
.S:'PSBHAZDS PSBHAZDS=$P(PSBADA(PSBX2),U,9) ;*106
.D ZADD(2) ;*only executes for TEST accounts
; "ADD" ^additive IEN PS(52.6) ^additive name ^strength ^bottle ^ ^high risk ^haz handle ^haz dispose
;
; get solutions
I $G(^TMP("PSB",$J,"PSBORDA",950,0)) D
.F PSBX2=1:1:^TMP("PSB",$J,"PSBORDA",950,0) D
..M PSBSOLA(PSBX2)=^TMP("PSB",$J,"PSBORDA",950,PSBX2,0)
..S PSBSOLA(PSBX2)="SOL^"_PSBSOLA(PSBX2) ;# of SOL
..S:'PSBHAZHN PSBHAZHN=$P(PSBSOLA(PSBX2),U,8) ;*106
..S:'PSBHAZDS PSBHAZDS=$P(PSBSOLA(PSBX2),U,9) ;*106
..D ZSOL(2) ;*only executes for TEST accounts
; "SOL" ^solution IEN PS(52.7) ^solution name ^volume ^ ^ ^high risk ^haz handle ^haz dispose
;
K ^TMP("PSB",$J,"PSBORDA"),PSBX1,PSBX2
Q
;
PSJ1(PSBPAR1,PSBPAR2,PSBIGS2B,PSBEXIST) ; set the variables for an individual order
S ^TMP("TK PSJ1",PSBPAR1,PSBPAR2)=""
; PSBPAR1 = DFN
; PSBPAR2 = ORDER NUMBER
; PSBPAR3 = IGNORE "SEND TO BCMA" CLINIC PARAMETER (Label Invalidation)
S PSBSCRT="^TMP(""PSB"",$J,""PSBORDA"")"
K @PSBSCRT
N PSBX
K ^TMP("PSJ1",$J) D EN^PSJBCMA1(PSBPAR1,PSBPAR2,1,$G(PSBIGS2B),.PSBEXIST)
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,9) ; ord file entry (CPRS order #)
S PSBCLORD=$P(PSBSCRT,U,11) ; clinic order Name (is a CO) *70
; send clinic file #44 ien ptr *70
S PSBCLIEN=$S(PSBCLORD]"":$P(PSBSCRT,U,12),1:"") ;*70
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 PSBMRIEN=+$P($G(^TMP("PSB",$J,"PSBORDA",1,0)),U,4) ; med rt ien added in PSB*3*74 ;[*70-1489]
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 specl inst or IV oth 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
;define 4 new MRR type fields *83
S PSBDOA=$P(PSBSCRT,U,12) ; duration of administration
S PSBRMST=$P(PSBSCRT,U,13) ; removal times str in NNNN- format
S PSBMRRFL=$P(PSBSCRT,U,14) ; MRR flag (prompt removal bcma)
S PSBOPRSP=$P(PSBSCRT,U,15) ; Order previous Stop date/time
;
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=""
;
; if any order's medication components involved are flagged 1 for Hazardous, then the whole order is flagged with that hazardous condition. *106
; so init Haz flags to 0 now, then only reset flags if '1 per each medical component tested later. *106
S (PSBHAZHN,PSBHAZDS)=0
;
;get dispensed drug
I $G(^TMP("PSB",$J,"PSBORDA",700,0)) F PSBX=1:1:^TMP("PSB",$J,"PSBORDA",700,0) D ; # of DDrug
. M PSBDDA(PSBX)=^TMP("PSB",$J,"PSBORDA",700,PSBX,0)
. S PSBDDA(PSBX)="DD^"_PSBDDA(PSBX)
. S:'PSBHAZHN PSBHAZHN=$P(PSBDDA(PSBX),U,9) ;*106
. S:'PSBHAZDS PSBHAZDS=$P(PSBDDA(PSBX),U,10) ;*106
; "DD" ^drug file(#50) IEN ^drug name ^units per dose ^inactive date ^ ^ ^high risk med ^remove med ^haz handle ^haz dispose
; build unique id list
; add additives
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 additives
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
.S:'PSBHAZHN PSBHAZHN=$P(PSBADA(PSBX),U,8) ;*106
.S:'PSBHAZDS PSBHAZDS=$P(PSBADA(PSBX),U,9) ;*106
.D ZADD(1) ;*only executes for TEST accounts on piece 12
; "ADD" ^additive IEN PS(52.6) ^additive name ^strength ^bottle ^ ^high risk ^haz handle ^haz dispose
;
; get solutions
I $G(^TMP("PSB",$J,"PSBORDA",950,0)) D
.F PSBX=1:1:^TMP("PSB",$J,"PSBORDA",950,0) D
..M PSBSOLA(PSBX)=^TMP("PSB",$J,"PSBORDA",950,PSBX,0)
..S PSBSOLA(PSBX)="SOL^"_PSBSOLA(PSBX) ; # of SOLs
..S:'PSBHAZHN PSBHAZHN=$P(PSBSOLA(PSBX),U,8) ;*106
..S:'PSBHAZDS PSBHAZDS=$P(PSBSOLA(PSBX),U,9) ;*106
..D ZSOL(1) ;*only executes for TEST accounts on piece 12
; "SOL" ^solution IEN PS(52.7) ^solution name ^volume ^ ^ ^high risk ^haz handle ^haz dispose
;
; 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
K PSBCLIEN,PSBCLORD ;*70
K PSBMRIEN ;*68
K PSBDOA,PSBRMST,PSBMRRFL,PSBOPRSP ;*83
K PSBHAZHN,PSBHAZDS ;*106
Q
;
ZADD(XX) ;appends pointer to Drug file #50 for additives - Results(12) *106 piece 9 & 10 now have valid HAZ info
;*test mode only, drug ien stuffed in
Q:$$PROD^XUPROD ;quit if a production account
S:XX=1 $P(PSBADA(PSBX),U,12)=$P($G(^PS(52.6,$P(PSBADA(PSBX),U,2),0)),U,2)
S:XX=2 $P(PSBADA(PSBX2),U,12)=$P($G(^PS(52.6,$P(PSBADA(PSBX2),U,2),0)),U,2)
Q
;
ZSOL(XX) ;appends pointer to Drug file #50 for solutions - Results(12) *106 piece 8 & 9 now have valid HAZ info
;*test mode only, drug ien stuffed in
Q:$$PROD^XUPROD ;quit if a production account
S:XX=1 $P(PSBSOLA(PSBX),U,12)=$P($G(^PS(52.7,$P(PSBSOLA(PSBX),U,2),0)),U,2)
S:XX=2 $P(PSBSOLA(PSBX2),U,12)=$P($G(^PS(52.7,$P(PSBSOLA(PSBX2),U,2),0)),U,2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBVT 14937 printed Oct 16, 2024@17:42:19 Page 2
PSBVT ;BIRMINGHAM/EFC-BCMA ORDER VARIABLES UTILITY ;03/06/16 3:06pm
+1 ;;3.0;BAR CODE MED ADMIN;**6,3,38,68,74,70,83,106**;Mar 2004;Build 43
+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 ;
+8 ;*68 Define New Variable (IEN from Med Route file) in Tag PSJ which
+9 ; uses the TMP global built by a previous call to PSJBCMA Api.
+10 ;*70 - define new variable, 1/0 flag for is a Clinic order
+11 ; - 1489: Blended PSB*3*74 with PSB*3*70
+12 ;*83 - create remove string var from new rmst passed PSJBCMA1
+13 ;*106- add Hazardous Handle & Dispose flags
+14 ;
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 ;
+6 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",0))
+7 ; ord num w/o type
SET PSBON=+$PIECE(PSBSCRT,U,3)
+8 ; ord num w/ type "U" or "V"
SET PSBONX=$PIECE(PSBSCRT,U,3)
+9 ; "U" or "V"
SET PSBOTYP=$EXTRACT(PSBONX,$LENGTH(PSBONX))
+10 ; prev ord num
SET PSBPONX=$PIECE(PSBSCRT,U,4)
+11 ; foll ord num
SET PSBFON=$PIECE(PSBSCRT,U,5)
+12 ; IV type
SET PSBIVT=$PIECE(PSBSCRT,U,6)
+13 ; intermit syrg
SET PSBISYR=$PIECE(PSBSCRT,U,7)
+14 ; chemo type
SET PSBCHEMT=$PIECE(PSBSCRT,U,8)
+15 ; ords file entry (CPRS order #)
SET PSBCPRS=$PIECE(PSBSCRT,U,9)
+16 ; reason for foll order
SET PSBFOR=$PIECE(PSBSCRT,U,10)
+17 ; clinic order Name (is a CO) *70
SET PSBCLORD=$PIECE(PSBSCRT,U,11)
+18 ; send clinic file #44 ien ptr *70
+19 ;*70
SET PSBCLIEN=$PIECE(PSBSCRT,U,12)
+20 if PSBSCRT=-1
QUIT
+21 ;
+22 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",1))
+23 ; med rt
SET PSBMR=$PIECE($GET(^TMP("PSB",$JOB,"PSBORDA",1,0)),U,2)
+24 ; med rt abbr
SET PSBMRAB=$PIECE(PSBSCRT,U,1)
+25 ; med rt ien *68
SET PSBMRIEN=+$PIECE($GET(^TMP("PSB",$JOB,"PSBORDA",1,0)),U,4)
+26 ; Inj site
SET PSBNJECT=+$GET(^TMP("PSB",$JOB,"PSBORDA",1,0))
+27 ; IV PUSH
SET PSBIVPSH=+$PIECE($GET(^TMP("PSB",$JOB,"PSBORDA",1,0)),U,3)
+28 ; sched type conversion
SET PSBSCHT=$PIECE(PSBSCRT,U,2)
+29 ; sched
SET PSBSCH=$PIECE(PSBSCRT,U,3)
+30 ; strt dte FM
SET PSBOST=$PIECE(PSBSCRT,U,4)
+31 ; stp dte FM
SET PSBOSP=$PIECE(PSBSCRT,U,5)
+32 ; admin times str in NNNN- format
SET PSBADST=$PIECE(PSBSCRT,U,6)
+33 ; status
SET PSBOSTS=$PIECE(PSBSCRT,U,7)
+34 ; not to be given flag
SET PSBNGF=$PIECE(PSBSCRT,U,8)
+35 ; origin sched type
SET PSBOSCHT=$PIECE(PSBSCRT,U,9)
+36 ;define 4 new MRR type fields *83
+37 ; duration of administration
SET PSBDOA=$PIECE(PSBSCRT,U,12)
+38 ; removal times str in NNNN- format
SET PSBRMST=$PIECE(PSBSCRT,U,13)
+39 ; MRR flag (prompt removal bcma)
SET PSBMRRFL=$PIECE(PSBSCRT,U,14)
+40 ; Order previous Stop date/time
SET PSBOPRSP=$PIECE(PSBSCRT,U,15)
+41 ;
+42 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",2))
+43 ; dosage ordered
SET PSBDOSE=$PIECE(PSBSCRT,U,1)
+44 ; infusn rate
SET PSBIFR=$PIECE(PSBSCRT,U,2)
+45 ; self med
SET PSBSM=$PIECE(PSBSCRT,U,3)
+46 ; hospital supplied self med
SET PSBHSM=$PIECE(PSBSCRT,U,4)
+47 ;
+48 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",3))
+49 ; order item IEN - > ^ORD(101.43)
SET PSBOIT=$PIECE(PSBSCRT,U,1)
+50 ; order item (expand)_" "_dosage form
SET PSBOITX=$PIECE(PSBSCRT,U,2)
+51 IF PSBOITX=""
SET PSBOITX="ZZZZ NO ORDERABLE ITEM"
+52 ; dosage form
SET PSBDOSEF=$PIECE(PSBSCRT,U,3)
+53 ;
+54 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",4))
+55 ; special inst/other print info
SET PSBOTXT=PSBSCRT
+56 ;
+57 ; if any order's medication components involved are flagged 1 for Hazardous, then the whole order is flagged with that hazardous condition. *106
+58 ; so init Haz flags to 0 now, then only reset flags if '1 per each medical component tested later. *106
+59 SET (PSBHAZHN,PSBHAZDS)=0
+60 ;
+61 ;get disp drug
+62 IF $GET(^TMP("PSB",$JOB,"PSBORDA",700,0))
FOR PSBX2=1:1:^TMP("PSB",$JOB,"PSBORDA",700,0)
Begin DoDot:1
+63 MERGE PSBDDA(PSBX2)=^TMP("PSB",$JOB,"PSBORDA",700,PSBX2,0)
+64 ; # of DDrug
SET PSBDDA(PSBX2)="DD^"_PSBDDA(PSBX2)
+65 ;*106
if 'PSBHAZHN
SET PSBHAZHN=$PIECE(PSBDDA(PSBX2),U,9)
+66 ;*106
if 'PSBHAZDS
SET PSBHAZDS=$PIECE(PSBDDA(PSBX2),U,10)
End DoDot:1
+67 ; "DD" ^drug file(#50) IEN ^drug name ^units per dose ^inactive date ^ ^ ^high risk med ^remove med ^haz handle ^haz dispose
+68 ; build unique id list
+69 ; add additives
+70 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
+71 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
+72 ; add solutions
+73 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
+74 IF '$DATA(PSBUIDA(PSBX2))
SET PSBUIDA(PSBX2)="ID^"_PSBX2
+75 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
+76 ; "ID" ^ (piece 2,3,)... = type;IEN of each add/sol for this ID ex. "SOL;4"
+77 ; get additives
+78 IF $GET(^TMP("PSB",$JOB,"PSBORDA",850,0))
FOR PSBX2=1:1:^TMP("PSB",$JOB,"PSBORDA",850,0)
Begin DoDot:1
+79 ; number of additives (exists only for IV)
MERGE PSBADA(PSBX2)=^TMP("PSB",$JOB,"PSBORDA",850,PSBX2,0)
+80 SET PSBADA(PSBX2)="ADD^"_PSBADA(PSBX2)
+81 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
+82 if PSBBAGS'=""
SET $PIECE(PSBADA(PSBX2),U,5)=PSBBAG
SET $PIECE(PSBADA(PSBX2),U,6)=PSBBAGS
+83 ;*106
if 'PSBHAZHN
SET PSBHAZHN=$PIECE(PSBADA(PSBX2),U,8)
+84 ;*106
if 'PSBHAZDS
SET PSBHAZDS=$PIECE(PSBADA(PSBX2),U,9)
+85 ;*only executes for TEST accounts
DO ZADD(2)
End DoDot:1
+86 ; "ADD" ^additive IEN PS(52.6) ^additive name ^strength ^bottle ^ ^high risk ^haz handle ^haz dispose
+87 ;
+88 ; get solutions
+89 IF $GET(^TMP("PSB",$JOB,"PSBORDA",950,0))
Begin DoDot:1
+90 FOR PSBX2=1:1:^TMP("PSB",$JOB,"PSBORDA",950,0)
Begin DoDot:2
+91 MERGE PSBSOLA(PSBX2)=^TMP("PSB",$JOB,"PSBORDA",950,PSBX2,0)
+92 ;# of SOL
SET PSBSOLA(PSBX2)="SOL^"_PSBSOLA(PSBX2)
+93 ;*106
if 'PSBHAZHN
SET PSBHAZHN=$PIECE(PSBSOLA(PSBX2),U,8)
+94 ;*106
if 'PSBHAZDS
SET PSBHAZDS=$PIECE(PSBSOLA(PSBX2),U,9)
+95 ;*only executes for TEST accounts
DO ZSOL(2)
End DoDot:2
End DoDot:1
+96 ; "SOL" ^solution IEN PS(52.7) ^solution name ^volume ^ ^ ^high risk ^haz handle ^haz dispose
+97 ;
+98 KILL ^TMP("PSB",$JOB,"PSBORDA"),PSBX1,PSBX2
+99 QUIT
+100 ;
PSJ1(PSBPAR1,PSBPAR2,PSBIGS2B,PSBEXIST) ; set the variables for an individual order
+1 SET ^TMP("TK PSJ1",PSBPAR1,PSBPAR2)=""
+2 ; PSBPAR1 = DFN
+3 ; PSBPAR2 = ORDER NUMBER
+4 ; PSBPAR3 = IGNORE "SEND TO BCMA" CLINIC PARAMETER (Label Invalidation)
+5 SET PSBSCRT="^TMP(""PSB"",$J,""PSBORDA"")"
+6 KILL @PSBSCRT
+7 NEW PSBX
+8 KILL ^TMP("PSJ1",$JOB)
DO EN^PSJBCMA1(PSBPAR1,PSBPAR2,1,$GET(PSBIGS2B),.PSBEXIST)
+9 MERGE @PSBSCRT=^TMP("PSJ1",$JOB)
KILL ^TMP("PSJ1",$JOB)
+10 ;
+11 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",0))
+12 SET PSBDFN=PSBPAR1
+13 ; ord num w/o type
SET PSBON=+$PIECE(PSBSCRT,U,3)
+14 ; ord num w/ type "U" or "V"
SET PSBONX=$PIECE(PSBSCRT,U,3)
+15 SET PSBOTYP=$EXTRACT(PSBONX,$LENGTH(PSBONX))
+16 ; prev ord num
SET PSBPONX=$PIECE(PSBSCRT,U,4)
+17 ; foll ord num
SET PSBFON=$PIECE(PSBSCRT,U,5)
+18 ; IV type
SET PSBIVT=$PIECE(PSBSCRT,U,6)
+19 ; intermit syrg
SET PSBISYR=$PIECE(PSBSCRT,U,7)
+20 ; chemo type
SET PSBCHEMT=$PIECE(PSBSCRT,U,8)
+21 ; ord file entry (CPRS order #)
SET PSBCPRS=$PIECE(PSBSCRT,U,9)
+22 ; clinic order Name (is a CO) *70
SET PSBCLORD=$PIECE(PSBSCRT,U,11)
+23 ; send clinic file #44 ien ptr *70
+24 ;*70
SET PSBCLIEN=$SELECT(PSBCLORD]"":$PIECE(PSBSCRT,U,12),1:"")
+25 if PSBSCRT=-1
QUIT
+26 ;
+27 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",1))
+28 ; prov IEN -> ^VA(200)
SET PSBMD=$PIECE(PSBSCRT,U,1)
+29 ; prov name
SET PSBMDX=$PIECE(PSBSCRT,U,2)
+30 ; med rt IEN -> ^PS(51.2)
SET PSBMR=$PIECE(PSBSCRT,U,3)
+31 ; med rt
IF $GET(PSBMR)'=""
SET PSBMR=$PIECE(PSBSCRT,U,13)
+32 ;med rt abbr
SET PSBMRAB=$PIECE(PSBSCRT,U,4)
+33 ; med rt ien added in PSB*3*74 ;[*70-1489]
SET PSBMRIEN=+$PIECE($GET(^TMP("PSB",$JOB,"PSBORDA",1,0)),U,4)
+34 ; Inj site
SET PSBNJECT=+$GET(^TMP("PSB",$JOB,"PSBORDA",1,0))
+35 ; IV PUSH
SET PSBIVPSH=+$PIECE($GET(^TMP("PSB",$JOB,"PSBORDA",1,0)),U,2)
+36 ; self med
SET PSBSM=$PIECE(PSBSCRT,U,5)
+37 ; expnd to YES/NO
SET PSBSMX=$PIECE(PSBSCRT,U,6)
+38 ; hospital supplied self med
SET PSBHSM=$PIECE(PSBSCRT,U,7)
+39 ; expnd to YES/NO
SET PSBHSMX=$PIECE(PSBSCRT,U,8)
+40 ; not to be given flag
SET PSBNGF=$PIECE(PSBSCRT,U,9)
+41 ; ord status
SET PSBOSTS=$PIECE(PSBSCRT,U,10)
+42 ; ord status expans
SET PSBOSTSX=$PIECE(PSBSCRT,U,11)
+43 ;
+44 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",2))
+45 ; orderable item IEN -> ^ORD(101.43) ORDERABLE ITEM
SET PSBOIT=$PIECE(PSBSCRT,U,1)
+46 ; orderable item (expaned)_" "_ dosage form
SET PSBOITX=$PIECE(PSBSCRT,U,2)
+47 IF PSBOITX=""
SET PSBOITX="ZZZZ NO ORDERABLE ITEM"
+48 ; dosage ordered
SET PSBDOSE=$PIECE(PSBSCRT,U,3)
+49 ; infusion rate
SET PSBIFR=$PIECE(PSBSCRT,U,4)
+50 ; sched
SET PSBSCH=$PIECE(PSBSCRT,U,5)
+51 ; dosage form
SET PSBDOSEF=$PIECE(PSBSCRT,U,6)
+52 ;
+53 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",3))
+54 ; UD specl inst or IV oth print info
SET PSBOTXT=$PIECE(PSBSCRT,U,1)
+55 ;
+56 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",4))
+57 ; sched type conversion
SET PSBSCHT=$PIECE(PSBSCRT,U,1)
+58 ; sched type expansion
SET PSBSCHTX=$PIECE(PSBSCRT,U,2)
+59 ; log-in date FM
SET PSBLDT=$PIECE(PSBSCRT,U,3)
+60 ; exp MM/DD/YYYY HH:MM
SET PSBLDTX=$PIECE(PSBSCRT,U,4)
+61 ; start date FM
SET PSBOST=$PIECE(PSBSCRT,U,5)
+62 ; exp MM/DD/YYYY HH:MM
SET PSBOSTX=$PIECE(PSBSCRT,U,6)
+63 ; stop date FM
SET PSBOSP=$PIECE(PSBSCRT,U,7)
+64 ; exp MM/DD/YYYY HH:MM
SET PSBOSPX=$PIECE(PSBSCRT,U,8)
+65 ; admin times string in NNNN- format
SET PSBADST=$PIECE(PSBSCRT,U,9)
+66 ; original schedule type
SET PSBOSCHT=$PIECE(PSBSCRT,U,10)
+67 ; frequency
SET PSBFREQ=$PIECE(PSBSCRT,U,11)
+68 ;define 4 new MRR type fields *83
+69 ; duration of administration
SET PSBDOA=$PIECE(PSBSCRT,U,12)
+70 ; removal times str in NNNN- format
SET PSBRMST=$PIECE(PSBSCRT,U,13)
+71 ; MRR flag (prompt removal bcma)
SET PSBMRRFL=$PIECE(PSBSCRT,U,14)
+72 ; Order previous Stop date/time
SET PSBOPRSP=$PIECE(PSBSCRT,U,15)
+73 ;
+74 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",5))
+75 ; verify nurse IEN -> ^VA(200)
SET PSBVN=$PIECE(PSBSCRT,U,1)
+76 ; nurse name
SET PSBVNX=$PIECE(PSBSCRT,U,2)
+77 ; nurse initials
SET PSBVNI=$PIECE(PSBSCRT,U,3)
+78 ; verify pharm IEN -> ^VA(200)
SET PSBVPH=$PIECE(PSBSCRT,U,4)
+79 ; pharm name
SET PSBVPHX=$PIECE(PSBSCRT,U,5)
+80 ; pharm initials
SET PSBVPHI=$PIECE(PSBSCRT,U,6)
+81 ;
+82 SET PSBSCRT=$GET(^TMP("PSB",$JOB,"PSBORDA",6))
+83 SET PSBRMRK=$GET(PSBSCRT)
+84 ;If DayOFWeek set frequen to NULL
+85 IF $$PSBDCHK1^PSBVT1(PSBSCH)
SET PSBFREQ=""
+86 ;
+87 ; if any order's medication components involved are flagged 1 for Hazardous, then the whole order is flagged with that hazardous condition. *106
+88 ; so init Haz flags to 0 now, then only reset flags if '1 per each medical component tested later. *106
+89 SET (PSBHAZHN,PSBHAZDS)=0
+90 ;
+91 ;get dispensed drug
+92 ; # of DDrug
IF $GET(^TMP("PSB",$JOB,"PSBORDA",700,0))
FOR PSBX=1:1:^TMP("PSB",$JOB,"PSBORDA",700,0)
Begin DoDot:1
+93 MERGE PSBDDA(PSBX)=^TMP("PSB",$JOB,"PSBORDA",700,PSBX,0)
+94 SET PSBDDA(PSBX)="DD^"_PSBDDA(PSBX)
+95 ;*106
if 'PSBHAZHN
SET PSBHAZHN=$PIECE(PSBDDA(PSBX),U,9)
+96 ;*106
if 'PSBHAZDS
SET PSBHAZDS=$PIECE(PSBDDA(PSBX),U,10)
End DoDot:1
+97 ; "DD" ^drug file(#50) IEN ^drug name ^units per dose ^inactive date ^ ^ ^high risk med ^remove med ^haz handle ^haz dispose
+98 ; build unique id list
+99 ; add additives
+100 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
+101 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
+102 ; add solutions
+103 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
+104 IF '$DATA(PSBUIDA(PSBX2))
SET PSBUIDA(PSBX2)="ID^"_PSBX2
+105 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
+106 ; "ID" ^ (piece 2,3),... = type;IEN of each add/sol for this ID ex. "SOL;4"
+107 ; get additives
+108 IF $GET(^TMP("PSB",$JOB,"PSBORDA",850,0))
FOR PSBX=1:1:^TMP("PSB",$JOB,"PSBORDA",850,0)
Begin DoDot:1
+109 ; num of addits
MERGE PSBADA(PSBX)=^TMP("PSB",$JOB,"PSBORDA",850,PSBX,0)
+110 SET PSBADA(PSBX)="ADD^"_PSBADA(PSBX)
+111 SET PSBBAGS=$PIECE(PSBADA(PSBX),U,5)
IF PSBBAGS'=""
SET PSBBAG=" IN BAG "_$PIECE(PSBBAGS,",",1)
Begin DoDot:2
+112 FOR I=2:1
SET X=$PIECE(PSBBAGS,",",I)
if X=""
QUIT
SET PSBBAG=PSBBAG_" AND "_X
End DoDot:2
+113 if PSBBAGS'=""
SET $PIECE(PSBADA(PSBX),U,5)=PSBBAG
+114 ;*106
if 'PSBHAZHN
SET PSBHAZHN=$PIECE(PSBADA(PSBX),U,8)
+115 ;*106
if 'PSBHAZDS
SET PSBHAZDS=$PIECE(PSBADA(PSBX),U,9)
+116 ;*only executes for TEST accounts on piece 12
DO ZADD(1)
End DoDot:1
+117 ; "ADD" ^additive IEN PS(52.6) ^additive name ^strength ^bottle ^ ^high risk ^haz handle ^haz dispose
+118 ;
+119 ; get solutions
+120 IF $GET(^TMP("PSB",$JOB,"PSBORDA",950,0))
Begin DoDot:1
+121 FOR PSBX=1:1:^TMP("PSB",$JOB,"PSBORDA",950,0)
Begin DoDot:2
+122 MERGE PSBSOLA(PSBX)=^TMP("PSB",$JOB,"PSBORDA",950,PSBX,0)
+123 ; # of SOLs
SET PSBSOLA(PSBX)="SOL^"_PSBSOLA(PSBX)
+124 ;*106
if 'PSBHAZHN
SET PSBHAZHN=$PIECE(PSBSOLA(PSBX),U,8)
+125 ;*106
if 'PSBHAZDS
SET PSBHAZDS=$PIECE(PSBSOLA(PSBX),U,9)
+126 ;*only executes for TEST accounts on piece 12
DO ZSOL(1)
End DoDot:2
End DoDot:1
+127 ; "SOL" ^solution IEN PS(52.7) ^solution name ^volume ^ ^ ^high risk ^haz handle ^haz dispose
+128 ;
+129 ; get label
+130 IF $DATA(^TMP("PSB",$JOB,"PSBORDA",1000))
MERGE PSBLBLA=^TMP("PSB",$JOB,"PSBORDA",1000)
+131 KILL ^TMP("PSB",$JOB,"PSBORDA")
+132 QUIT
+133 ;
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 ;*70
KILL PSBCLIEN,PSBCLORD
+7 ;*68
KILL PSBMRIEN
+8 ;*83
KILL PSBDOA,PSBRMST,PSBMRRFL,PSBOPRSP
+9 ;*106
KILL PSBHAZHN,PSBHAZDS
+10 QUIT
+11 ;
ZADD(XX) ;appends pointer to Drug file #50 for additives - Results(12) *106 piece 9 & 10 now have valid HAZ info
+1 ;*test mode only, drug ien stuffed in
+2 ;quit if a production account
if $$PROD^XUPROD
QUIT
+3 if XX=1
SET $PIECE(PSBADA(PSBX),U,12)=$PIECE($GET(^PS(52.6,$PIECE(PSBADA(PSBX),U,2),0)),U,2)
+4 if XX=2
SET $PIECE(PSBADA(PSBX2),U,12)=$PIECE($GET(^PS(52.6,$PIECE(PSBADA(PSBX2),U,2),0)),U,2)
+5 QUIT
+6 ;
ZSOL(XX) ;appends pointer to Drug file #50 for solutions - Results(12) *106 piece 8 & 9 now have valid HAZ info
+1 ;*test mode only, drug ien stuffed in
+2 ;quit if a production account
if $$PROD^XUPROD
QUIT
+3 if XX=1
SET $PIECE(PSBSOLA(PSBX),U,12)=$PIECE($GET(^PS(52.7,$PIECE(PSBSOLA(PSBX),U,2),0)),U,2)
+4 if XX=2
SET $PIECE(PSBSOLA(PSBX2),U,12)=$PIECE($GET(^PS(52.7,$PIECE(PSBSOLA(PSBX2),U,2),0)),U,2)
+5 QUIT
