- 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 Jan 18, 2025@02:42:41 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