Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSBVT

PSBVT.m

Go to the documentation of this file.
  1. 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
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; Reference/IA
  1. ; EN^PSJBCMA1/2829
  1. ; ^TMP("PSJ",$J/2828
  1. ;
  1. ;*68 Define New Variable (IEN from Med Route file) in Tag PSJ which
  1. ; uses the TMP global built by a previous call to PSJBCMA Api.
  1. ;*70 - define new variable, 1/0 flag for is a Clinic order
  1. ; - 1489: Blended PSB*3*74 with PSB*3*70
  1. ;*83 - create remove string var from new rmst passed PSJBCMA1
  1. ;*106- add Hazardous Handle & Dispose flags
  1. ;
  1. PSJ(PSBX1) ;
  1. S ^TMP("TK PSJ",PSBX1)=""
  1. S PSBSCRT="^TMP(""PSB"",$J,""PSBORDA"")"
  1. K @PSBSCRT M @PSBSCRT=^TMP("PSJ",$J,PSBX1)
  1. S PSBDFN=DFN
  1. ;
  1. S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",0))
  1. S PSBON=+$P(PSBSCRT,U,3) ; ord num w/o type
  1. S PSBONX=$P(PSBSCRT,U,3) ; ord num w/ type "U" or "V"
  1. S PSBOTYP=$E(PSBONX,$L(PSBONX)) ; "U" or "V"
  1. S PSBPONX=$P(PSBSCRT,U,4) ; prev ord num
  1. S PSBFON=$P(PSBSCRT,U,5) ; foll ord num
  1. S PSBIVT=$P(PSBSCRT,U,6) ; IV type
  1. S PSBISYR=$P(PSBSCRT,U,7) ; intermit syrg
  1. S PSBCHEMT=$P(PSBSCRT,U,8) ; chemo type
  1. S PSBCPRS=$P(PSBSCRT,U,9) ; ords file entry (CPRS order #)
  1. S PSBFOR=$P(PSBSCRT,U,10) ; reason for foll order
  1. S PSBCLORD=$P(PSBSCRT,U,11) ; clinic order Name (is a CO) *70
  1. ; send clinic file #44 ien ptr *70
  1. S PSBCLIEN=$P(PSBSCRT,U,12) ;*70
  1. Q:PSBSCRT=-1
  1. ;
  1. S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",1))
  1. S PSBMR=$P($G(^TMP("PSB",$J,"PSBORDA",1,0)),U,2) ; med rt
  1. S PSBMRAB=$P(PSBSCRT,U,1) ; med rt abbr
  1. S PSBMRIEN=+$P($G(^TMP("PSB",$J,"PSBORDA",1,0)),U,4) ; med rt ien *68
  1. S PSBNJECT=+$G(^TMP("PSB",$J,"PSBORDA",1,0)) ; Inj site
  1. S PSBIVPSH=+$P($G(^TMP("PSB",$J,"PSBORDA",1,0)),U,3) ; IV PUSH
  1. S PSBSCHT=$P(PSBSCRT,U,2) ; sched type conversion
  1. S PSBSCH=$P(PSBSCRT,U,3) ; sched
  1. S PSBOST=$P(PSBSCRT,U,4) ; strt dte FM
  1. S PSBOSP=$P(PSBSCRT,U,5) ; stp dte FM
  1. S PSBADST=$P(PSBSCRT,U,6) ; admin times str in NNNN- format
  1. S PSBOSTS=$P(PSBSCRT,U,7) ; status
  1. S PSBNGF=$P(PSBSCRT,U,8) ; not to be given flag
  1. S PSBOSCHT=$P(PSBSCRT,U,9) ; origin sched type
  1. ;define 4 new MRR type fields *83
  1. S PSBDOA=$P(PSBSCRT,U,12) ; duration of administration
  1. S PSBRMST=$P(PSBSCRT,U,13) ; removal times str in NNNN- format
  1. S PSBMRRFL=$P(PSBSCRT,U,14) ; MRR flag (prompt removal bcma)
  1. S PSBOPRSP=$P(PSBSCRT,U,15) ; Order previous Stop date/time
  1. ;
  1. S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",2))
  1. S PSBDOSE=$P(PSBSCRT,U,1) ; dosage ordered
  1. S PSBIFR=$P(PSBSCRT,U,2) ; infusn rate
  1. S PSBSM=$P(PSBSCRT,U,3) ; self med
  1. S PSBHSM=$P(PSBSCRT,U,4) ; hospital supplied self med
  1. ;
  1. S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",3))
  1. S PSBOIT=$P(PSBSCRT,U,1) ; order item IEN - > ^ORD(101.43)
  1. S PSBOITX=$P(PSBSCRT,U,2) ; order item (expand)_" "_dosage form
  1. I PSBOITX="" S PSBOITX="ZZZZ NO ORDERABLE ITEM"
  1. S PSBDOSEF=$P(PSBSCRT,U,3) ; dosage form
  1. ;
  1. S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",4))
  1. S PSBOTXT=PSBSCRT ; special inst/other print info
  1. ;
  1. ; if any order's medication components involved are flagged 1 for Hazardous, then the whole order is flagged with that hazardous condition. *106
  1. ; so init Haz flags to 0 now, then only reset flags if '1 per each medical component tested later. *106
  1. S (PSBHAZHN,PSBHAZDS)=0
  1. ;
  1. ;get disp drug
  1. I $G(^TMP("PSB",$J,"PSBORDA",700,0)) F PSBX2=1:1:^TMP("PSB",$J,"PSBORDA",700,0) D
  1. . M PSBDDA(PSBX2)=^TMP("PSB",$J,"PSBORDA",700,PSBX2,0)
  1. . S PSBDDA(PSBX2)="DD^"_PSBDDA(PSBX2) ; # of DDrug
  1. . S:'PSBHAZHN PSBHAZHN=$P(PSBDDA(PSBX2),U,9) ;*106
  1. . S:'PSBHAZDS PSBHAZDS=$P(PSBDDA(PSBX2),U,10) ;*106
  1. ; "DD" ^drug file(#50) IEN ^drug name ^units per dose ^inactive date ^ ^ ^high risk med ^remove med ^haz handle ^haz dispose
  1. ; build unique id list
  1. ; add additives
  1. I $D(^TMP("PSB",$J,"PSBORDA",800)) S PSBX2="" F S PSBX2=$O(^TMP("PSB",$J,"PSBORDA",800,PSBX2)) Q:PSBX2=""!(PSBX2="ERROR") D
  1. .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)
  1. ; add solutions
  1. I $D(^TMP("PSB",$J,"PSBORDA",900)) S PSBX2="" F S PSBX2=$O(^TMP("PSB",$J,"PSBORDA",900,PSBX2)) Q:PSBX2=""!(PSBX2="ERROR") D
  1. .I '$D(PSBUIDA(PSBX2)) S PSBUIDA(PSBX2)="ID^"_PSBX2
  1. .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)
  1. ; "ID" ^ (piece 2,3,)... = type;IEN of each add/sol for this ID ex. "SOL;4"
  1. ; get additives
  1. I $G(^TMP("PSB",$J,"PSBORDA",850,0)) F PSBX2=1:1:^TMP("PSB",$J,"PSBORDA",850,0) D
  1. .M PSBADA(PSBX2)=^TMP("PSB",$J,"PSBORDA",850,PSBX2,0) ; number of additives (exists only for IV)
  1. .S PSBADA(PSBX2)="ADD^"_PSBADA(PSBX2)
  1. .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
  1. .S:PSBBAGS'="" $P(PSBADA(PSBX2),U,5)=PSBBAG,$P(PSBADA(PSBX2),U,6)=PSBBAGS
  1. .S:'PSBHAZHN PSBHAZHN=$P(PSBADA(PSBX2),U,8) ;*106
  1. .S:'PSBHAZDS PSBHAZDS=$P(PSBADA(PSBX2),U,9) ;*106
  1. .D ZADD(2) ;*only executes for TEST accounts
  1. ; "ADD" ^additive IEN PS(52.6) ^additive name ^strength ^bottle ^ ^high risk ^haz handle ^haz dispose
  1. ;
  1. ; get solutions
  1. I $G(^TMP("PSB",$J,"PSBORDA",950,0)) D
  1. .F PSBX2=1:1:^TMP("PSB",$J,"PSBORDA",950,0) D
  1. ..M PSBSOLA(PSBX2)=^TMP("PSB",$J,"PSBORDA",950,PSBX2,0)
  1. ..S PSBSOLA(PSBX2)="SOL^"_PSBSOLA(PSBX2) ;# of SOL
  1. ..S:'PSBHAZHN PSBHAZHN=$P(PSBSOLA(PSBX2),U,8) ;*106
  1. ..S:'PSBHAZDS PSBHAZDS=$P(PSBSOLA(PSBX2),U,9) ;*106
  1. ..D ZSOL(2) ;*only executes for TEST accounts
  1. ; "SOL" ^solution IEN PS(52.7) ^solution name ^volume ^ ^ ^high risk ^haz handle ^haz dispose
  1. ;
  1. K ^TMP("PSB",$J,"PSBORDA"),PSBX1,PSBX2
  1. Q
  1. ;
  1. PSJ1(PSBPAR1,PSBPAR2,PSBIGS2B,PSBEXIST) ; set the variables for an individual order
  1. S ^TMP("TK PSJ1",PSBPAR1,PSBPAR2)=""
  1. ; PSBPAR1 = DFN
  1. ; PSBPAR2 = ORDER NUMBER
  1. ; PSBPAR3 = IGNORE "SEND TO BCMA" CLINIC PARAMETER (Label Invalidation)
  1. S PSBSCRT="^TMP(""PSB"",$J,""PSBORDA"")"
  1. K @PSBSCRT
  1. N PSBX
  1. K ^TMP("PSJ1",$J) D EN^PSJBCMA1(PSBPAR1,PSBPAR2,1,$G(PSBIGS2B),.PSBEXIST)
  1. M @PSBSCRT=^TMP("PSJ1",$J) K ^TMP("PSJ1",$J)
  1. ;
  1. S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",0))
  1. S PSBDFN=PSBPAR1
  1. S PSBON=+$P(PSBSCRT,U,3) ; ord num w/o type
  1. S PSBONX=$P(PSBSCRT,U,3) ; ord num w/ type "U" or "V"
  1. S PSBOTYP=$E(PSBONX,$L(PSBONX))
  1. S PSBPONX=$P(PSBSCRT,U,4) ; prev ord num
  1. S PSBFON=$P(PSBSCRT,U,5) ; foll ord num
  1. S PSBIVT=$P(PSBSCRT,U,6) ; IV type
  1. S PSBISYR=$P(PSBSCRT,U,7) ; intermit syrg
  1. S PSBCHEMT=$P(PSBSCRT,U,8) ; chemo type
  1. S PSBCPRS=$P(PSBSCRT,U,9) ; ord file entry (CPRS order #)
  1. S PSBCLORD=$P(PSBSCRT,U,11) ; clinic order Name (is a CO) *70
  1. ; send clinic file #44 ien ptr *70
  1. S PSBCLIEN=$S(PSBCLORD]"":$P(PSBSCRT,U,12),1:"") ;*70
  1. Q:PSBSCRT=-1
  1. ;
  1. S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",1))
  1. S PSBMD=$P(PSBSCRT,U,1) ; prov IEN -> ^VA(200)
  1. S PSBMDX=$P(PSBSCRT,U,2) ; prov name
  1. S PSBMR=$P(PSBSCRT,U,3) ; med rt IEN -> ^PS(51.2)
  1. I $G(PSBMR)'="" S PSBMR=$P(PSBSCRT,U,13) ; med rt
  1. S PSBMRAB=$P(PSBSCRT,U,4) ;med rt abbr
  1. S PSBMRIEN=+$P($G(^TMP("PSB",$J,"PSBORDA",1,0)),U,4) ; med rt ien added in PSB*3*74 ;[*70-1489]
  1. S PSBNJECT=+$G(^TMP("PSB",$J,"PSBORDA",1,0)) ; Inj site
  1. S PSBIVPSH=+$P($G(^TMP("PSB",$J,"PSBORDA",1,0)),U,2) ; IV PUSH
  1. S PSBSM=$P(PSBSCRT,U,5) ; self med
  1. S PSBSMX=$P(PSBSCRT,U,6) ; expnd to YES/NO
  1. S PSBHSM=$P(PSBSCRT,U,7) ; hospital supplied self med
  1. S PSBHSMX=$P(PSBSCRT,U,8) ; expnd to YES/NO
  1. S PSBNGF=$P(PSBSCRT,U,9) ; not to be given flag
  1. S PSBOSTS=$P(PSBSCRT,U,10) ; ord status
  1. S PSBOSTSX=$P(PSBSCRT,U,11) ; ord status expans
  1. ;
  1. S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",2))
  1. S PSBOIT=$P(PSBSCRT,U,1) ; orderable item IEN -> ^ORD(101.43) ORDERABLE ITEM
  1. S PSBOITX=$P(PSBSCRT,U,2) ; orderable item (expaned)_" "_ dosage form
  1. I PSBOITX="" S PSBOITX="ZZZZ NO ORDERABLE ITEM"
  1. S PSBDOSE=$P(PSBSCRT,U,3) ; dosage ordered
  1. S PSBIFR=$P(PSBSCRT,U,4) ; infusion rate
  1. S PSBSCH=$P(PSBSCRT,U,5) ; sched
  1. S PSBDOSEF=$P(PSBSCRT,U,6) ; dosage form
  1. ;
  1. S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",3))
  1. S PSBOTXT=$P(PSBSCRT,U,1) ; UD specl inst or IV oth print info
  1. ;
  1. S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",4))
  1. S PSBSCHT=$P(PSBSCRT,U,1) ; sched type conversion
  1. S PSBSCHTX=$P(PSBSCRT,U,2) ; sched type expansion
  1. S PSBLDT=$P(PSBSCRT,U,3) ; log-in date FM
  1. S PSBLDTX=$P(PSBSCRT,U,4) ; exp MM/DD/YYYY HH:MM
  1. S PSBOST=$P(PSBSCRT,U,5) ; start date FM
  1. S PSBOSTX=$P(PSBSCRT,U,6) ; exp MM/DD/YYYY HH:MM
  1. S PSBOSP=$P(PSBSCRT,U,7) ; stop date FM
  1. S PSBOSPX=$P(PSBSCRT,U,8) ; exp MM/DD/YYYY HH:MM
  1. S PSBADST=$P(PSBSCRT,U,9) ; admin times string in NNNN- format
  1. S PSBOSCHT=$P(PSBSCRT,U,10) ; original schedule type
  1. S PSBFREQ=$P(PSBSCRT,U,11) ; frequency
  1. ;define 4 new MRR type fields *83
  1. S PSBDOA=$P(PSBSCRT,U,12) ; duration of administration
  1. S PSBRMST=$P(PSBSCRT,U,13) ; removal times str in NNNN- format
  1. S PSBMRRFL=$P(PSBSCRT,U,14) ; MRR flag (prompt removal bcma)
  1. S PSBOPRSP=$P(PSBSCRT,U,15) ; Order previous Stop date/time
  1. ;
  1. S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",5))
  1. S PSBVN=$P(PSBSCRT,U,1) ; verify nurse IEN -> ^VA(200)
  1. S PSBVNX=$P(PSBSCRT,U,2) ; nurse name
  1. S PSBVNI=$P(PSBSCRT,U,3) ; nurse initials
  1. S PSBVPH=$P(PSBSCRT,U,4) ; verify pharm IEN -> ^VA(200)
  1. S PSBVPHX=$P(PSBSCRT,U,5) ; pharm name
  1. S PSBVPHI=$P(PSBSCRT,U,6) ; pharm initials
  1. ;
  1. S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",6))
  1. S PSBRMRK=$G(PSBSCRT)
  1. ;If DayOFWeek set frequen to NULL
  1. I $$PSBDCHK1^PSBVT1(PSBSCH) S PSBFREQ=""
  1. ;
  1. ; if any order's medication components involved are flagged 1 for Hazardous, then the whole order is flagged with that hazardous condition. *106
  1. ; so init Haz flags to 0 now, then only reset flags if '1 per each medical component tested later. *106
  1. S (PSBHAZHN,PSBHAZDS)=0
  1. ;
  1. ;get dispensed drug
  1. I $G(^TMP("PSB",$J,"PSBORDA",700,0)) F PSBX=1:1:^TMP("PSB",$J,"PSBORDA",700,0) D ; # of DDrug
  1. . M PSBDDA(PSBX)=^TMP("PSB",$J,"PSBORDA",700,PSBX,0)
  1. . S PSBDDA(PSBX)="DD^"_PSBDDA(PSBX)
  1. . S:'PSBHAZHN PSBHAZHN=$P(PSBDDA(PSBX),U,9) ;*106
  1. . S:'PSBHAZDS PSBHAZDS=$P(PSBDDA(PSBX),U,10) ;*106
  1. ; "DD" ^drug file(#50) IEN ^drug name ^units per dose ^inactive date ^ ^ ^high risk med ^remove med ^haz handle ^haz dispose
  1. ; build unique id list
  1. ; add additives
  1. I $D(^TMP("PSB",$J,"PSBORDA",800)) S PSBX2="" F S PSBX2=$O(^TMP("PSB",$J,"PSBORDA",800,PSBX2)) Q:PSBX2=""!(PSBX2="ERROR") D
  1. .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)
  1. ; add solutions
  1. I $D(^TMP("PSB",$J,"PSBORDA",900)) S PSBX2="" F S PSBX2=$O(^TMP("PSB",$J,"PSBORDA",900,PSBX2)) Q:PSBX2=""!(PSBX2="ERROR") D
  1. .I '$D(PSBUIDA(PSBX2)) S PSBUIDA(PSBX2)="ID^"_PSBX2
  1. .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)
  1. ; "ID" ^ (piece 2,3),... = type;IEN of each add/sol for this ID ex. "SOL;4"
  1. ; get additives
  1. I $G(^TMP("PSB",$J,"PSBORDA",850,0)) F PSBX=1:1:^TMP("PSB",$J,"PSBORDA",850,0) D
  1. .M PSBADA(PSBX)=^TMP("PSB",$J,"PSBORDA",850,PSBX,0) ; num of addits
  1. .S PSBADA(PSBX)="ADD^"_PSBADA(PSBX)
  1. .S PSBBAGS=$P(PSBADA(PSBX),U,5) I PSBBAGS'="" S PSBBAG=" IN BAG "_$P(PSBBAGS,",",1) D
  1. ..F I=2:1 S X=$P(PSBBAGS,",",I) Q:X="" S PSBBAG=PSBBAG_" AND "_X
  1. .S:PSBBAGS'="" $P(PSBADA(PSBX),U,5)=PSBBAG
  1. .S:'PSBHAZHN PSBHAZHN=$P(PSBADA(PSBX),U,8) ;*106
  1. .S:'PSBHAZDS PSBHAZDS=$P(PSBADA(PSBX),U,9) ;*106
  1. .D ZADD(1) ;*only executes for TEST accounts on piece 12
  1. ; "ADD" ^additive IEN PS(52.6) ^additive name ^strength ^bottle ^ ^high risk ^haz handle ^haz dispose
  1. ;
  1. ; get solutions
  1. I $G(^TMP("PSB",$J,"PSBORDA",950,0)) D
  1. .F PSBX=1:1:^TMP("PSB",$J,"PSBORDA",950,0) D
  1. ..M PSBSOLA(PSBX)=^TMP("PSB",$J,"PSBORDA",950,PSBX,0)
  1. ..S PSBSOLA(PSBX)="SOL^"_PSBSOLA(PSBX) ; # of SOLs
  1. ..S:'PSBHAZHN PSBHAZHN=$P(PSBSOLA(PSBX),U,8) ;*106
  1. ..S:'PSBHAZDS PSBHAZDS=$P(PSBSOLA(PSBX),U,9) ;*106
  1. ..D ZSOL(1) ;*only executes for TEST accounts on piece 12
  1. ; "SOL" ^solution IEN PS(52.7) ^solution name ^volume ^ ^ ^high risk ^haz handle ^haz dispose
  1. ;
  1. ; get label
  1. I $D(^TMP("PSB",$J,"PSBORDA",1000)) M PSBLBLA=^TMP("PSB",$J,"PSBORDA",1000)
  1. K ^TMP("PSB",$J,"PSBORDA")
  1. Q
  1. ;
  1. LACTION ; get last action info
  1. S (PSBLADT,PSBLAIEN,PSBLASTS)=""
  1. I '$D(^PSB(53.79,"AORDX",PSBDFN,PSBONX)) Q
  1. S PSBLADT=$O(^PSB(53.79,"AORDX",PSBDFN,PSBONX,""),-1)
  1. S PSBLAIEN=$O(^PSB(53.79,"AORDX",PSBDFN,PSBONX,PSBLADT,""))
  1. S PSBLASTS=$P(^PSB(53.79,PSBLAIEN,0),U,9)
  1. Q
  1. ;
  1. CLEAN ;
  1. K PSBONX,PSBPONX,PSBFON,PSBOTYP,PSBIVT,PSBISYR,PSBCHEMT,PSBMD,PSBMDX,PSBMR,PSBMRAB,PSBSM,PSBSMX,PSBHSM,PSBHSMX
  1. K PSBDFN,PSBNGF,PSBOSTS,PSBOSTSX,PSBOIT,PSBOITX,PSBDOSE,PSBIFR,PSBSCH,PSBDOSEF,PSBOTXT,PSBSCHT,PSBSCHTX
  1. K PSBLDT,PSBLDTX,PSBOST,PSBOSTX,PSBOSP,PSBOSPX,PSBADST,PSBOSCHT,PSBFREQ,PSBVN,PSBVNX,PSBVNI
  1. K PSBVPH,PSBVPHX,PSBVPHI,PSBDDA,PSBADA,PSBSOLA,PSBUIDA,PSBCPRS,PSBON,PSBRMRK,PSBNJECT,PSBIVPSH
  1. K PSBLADT,PSBLAIEN,PSBLASTS,PSBBAG,PSBBAGS,PSBLBLA,PSBFOR,PSBSCRT
  1. K PSBCLIEN,PSBCLORD ;*70
  1. K PSBMRIEN ;*68
  1. K PSBDOA,PSBRMST,PSBMRRFL,PSBOPRSP ;*83
  1. K PSBHAZHN,PSBHAZDS ;*106
  1. Q
  1. ;
  1. 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
  1. Q:$$PROD^XUPROD ;quit if a production account
  1. S:XX=1 $P(PSBADA(PSBX),U,12)=$P($G(^PS(52.6,$P(PSBADA(PSBX),U,2),0)),U,2)
  1. S:XX=2 $P(PSBADA(PSBX2),U,12)=$P($G(^PS(52.6,$P(PSBADA(PSBX2),U,2),0)),U,2)
  1. Q
  1. ;
  1. 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
  1. Q:$$PROD^XUPROD ;quit if a production account
  1. S:XX=1 $P(PSBSOLA(PSBX),U,12)=$P($G(^PS(52.7,$P(PSBSOLA(PSBX),U,2),0)),U,2)
  1. S:XX=2 $P(PSBSOLA(PSBX2),U,12)=$P($G(^PS(52.7,$P(PSBSOLA(PSBX2),U,2),0)),U,2)
  1. Q