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 ; 8/4/05 8:05am
  1.  ;;3.0;BAR CODE MED ADMIN;**6,3,38**;Mar 2004;Build 8
  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. 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.  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))
  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.  Q:PSBSCRT=-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 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 strin 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.  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.  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 (expanded)_" "_dosage form
  1.  I PSBOITX="" S PSBOITX="ZZZZ NO ORDERABLE ITEM"
  1.  S PSBDOSEF=$P(PSBSCRT,U,3)  ; dosage form
  1.  S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",4))
  1.  S PSBOTXT=PSBSCRT  ; special inst/other print info
  1.  ; get disp drug
  1.  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
  1.  ;     "DD"^dispensed drug IEN -> ^PSDRUG() DRUG^dispensed drug name^units per dose^inactive date
  1.  ; build unique id list
  1.  ; add addits
  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 addits
  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 od 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.  ;     "ADD"^additive IEN -> ^PS(52.6) IV ADDITIVES^additive name^strength ^bottle
  1.  ; get soluts
  1.  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
  1.  ;   "SOL"^solution IEN -> ^PS(52.7) IV SOLUTIONS^solution name^volume
  1.  K ^TMP("PSB",$J,"PSBORDA"),PSBX1,PSBX2
  1.  Q
  1.  ;
  1. PSJ1(PSBPAR1,PSBPAR2) ; set the variables for an individual order
  1.  S ^TMP("TK PSJ1",PSBPAR1,PSBPAR2)=""
  1.  ;     PSBPAR1 = DFN
  1.  ;     PSBPAR2 = ORDNER NUMBER 
  1.  S PSBSCRT="^TMP(""PSB"",$J,""PSBORDA"")"
  1.  K @PSBSCRT
  1.  N PSBX
  1.  K ^TMP("PSJ1",$J) D EN^PSJBCMA1(PSBPAR1,PSBPAR2,1)
  1.  M @PSBSCRT=^TMP("PSJ1",$J) K ^TMP("PSJ1",$J)
  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,0)  ; ord file entry (CPRS order #)
  1.  Q:PSBSCRT=-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 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.  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.  S PSBSCRT=$G(^TMP("PSB",$J,"PSBORDA",3))
  1.  S PSBOTXT=$P(PSBSCRT,U,1)  ; UD special inst or IV other print info
  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.  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.  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.  ; get dispensed drug
  1.  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
  1.  ;     "DD"^dispensed drug IEN -> ^PSDRUG() DRUG^dispensed drug name^units per dose^inactive date
  1.  ; build unique id list
  1.  ; add addits
  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 soluts
  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 addits
  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.  ;     "ADD"^additive IEN -> ^PS(52.6) IV ADDITIVES^additive name^strength^bottle
  1.  ; get soluts
  1.  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
  1.  ;   "SOL"   ^   solution IEN -> ^PS(52.7) IV SOLUTIONS^solution name^volume
  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.  Q