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

PSIVHYPR.m

Go to the documentation of this file. 
  1. PSIVHYPR ;BIR/PR-REPRINT LABELS ;29-May-2012 14:33;PLS
  1.  ;;5.0; INPATIENT MEDICATIONS ;**58,88,96,178,184,1015**;16 DEC 97;Build 62
  1.  ;
  1.  ; Reference to ^%ZIS(2 is supported by DBIA 3435.
  1.  ; Reference to ^PS(50.4 is supported by DBIA 2175.
  1.  ; Reference to ^PS(52.6 is supported by DBIA 1231.
  1.  ; Reference to ^PS(52.7 is supported by DBIA 2173.
  1.  ; Reference to ^PS(55 is supported by DBIA 2191.
  1.  ; Reference to ^PS(51.2 is supported by DBIA 2178.
  1.  ;
  1.  ; Modified - IHS/CIA/PLS - 03/31/04
  1.  ;NEEDS DFN, ON AND PSIVNOL (Total number of labels to print) and
  1.  ;PSIVCT - $D(PSIVCT) NO COUNT LABEL
  1. SSWARD ;Get patient SS# and ward location
  1.  N X0,PSJIO,I
  1.  S I=0 F  S I=$O(^%ZIS(2,IOST(0),55,I)) Q:'I  S X0=^(I,0),PSJIO($P(X0,"^"))=^(1)
  1.  S PSJIO=$S('$D(PSJIO):0,1:1)
  1.  ; IHS/CIA/PLS - 03/31/04 - Change from SSN to HRN
  1.  ;D ENIV^PSJAC S VADM(2)=$E(VADM(2),6,9),PSIVWD=$S(+VAIN(4):$P(VAIN(4),U,2),1:"Opt. IV")
  1.  D ENIV^PSJAC S VADM(2)=$G(VA("BID")),PSIVWD=$S(+VAIN(4):$P(VAIN(4),U,2),1:"Opt. IV")
  1.  ;;NEW PSIVNOL,PSIV1 S (PSIVNOL,PSIV1)=1
  1.  NEW PSIV1 S PSIV1=1
  1.  G:PSIVNOL<1 Q D SETP,PSIVHYP S PSIVRM=$P(PSIVSITE,U,13),P16=$P($G(^PS(55,DFN,"IV",+ON,9)),U,3) S:PSIVRM<1 PSIVRM=30 I $D(PSIVCT),PSIVCT'=1 K PSIVCT
  1.  I PSJIO,$G(PSJIO("FI"))]"" X PSJIO("FI")
  1.  ;PSJRPHD is defined in REPRT^PSIVLBRP
  1.  I $P(PSIVSITE,U,7),'$D(PSJRPHD) D
  1.  . S PSIVFLAG=1,(LINE,PSIV1)=0,PSIV2=PSIVNOL,PSIVNOL=0 D RE
  1.  . S PSIVRP="",PSIVRT=""
  1.  . I $D(^PS(55,DFN,"IV",+ON,.2)) S PSIVRP=$P(^PS(55,DFN,"IV",+ON,.2),U,3) D
  1.  .. I PSIV1'>0!'$P(PSIVSITE,U,3)!($P(PSIVSITE,U,3)=1&(P(4)'="P"))!($P(PSIVSITE,U,3)=2&("AH"'[P(4))) Q   ;QUIT IF "DOSE DUE AT" IS SET TO NOT PRINT
  1.  .. S PSIVRT=$P(^PS(51.2,PSIVRP,0),U,1)
  1.  .. S X="ROUTE: "_PSIVRT D:X]"" PMR
  1.  . S X="Solution: _______________" D PRNTL S X="Additive: _______________" D PRNTL
  1.  . S PSIVNOL=PSIV2
  1.  . I 'PSJIO F LINE=LINE+1:1:(PSIVSITE+$P(PSIVSITE,U,16)) W !
  1.  . I PSJIO F I="EL","FE" I $G(PSJIO(I))]"" X PSJIO(I)
  1.  I '$D(PSIVCT) D NOW^%DTC S Y=%,$P(^PS(55,DFN,"IV",+ON,9),U,1,2)=Y_"^"_PSIVNOL,$P(^(9),U,3)=$P(^(9),U,3)+1
  1.  K PSIVFLAG,PSIVSH
  1. START S PSIV1=1,LINE=0 D RE D
  1.  . Q:$D(PSIVFLAG)
  1.  . I 'PSJIO F LINE=LINE+1:1:(PSIVSITE+$P(PSIVSITE,U,16)) W !
  1.  . I PSJIO,$G(PSJIO("EL"))]"" X PSJIO("EL")
  1.  I PSJIO,$G(PSJIO("FE"))]"" X PSJIO("FE")
  1.  ;;D:'$D(PSIVCT) ^PSIVSTAT
  1.  I '$D(PSIVCT) D ^PSIVSTAT S P(16)=P(16)+PSIVNOL
  1. Q K HYPL,LINE,MESS,P16,PDATE,PDOSE,PSIV,PSIVA,PSIV1,PSIV2,PSIVCT,PSIVDOSE,PSIVFLAG,PSIVRM,PSIVWD,TVOL,PSIMESS Q
  1. RE ;I PSIV1 S:P(15)>2880!('P(15)) P(15)=2880 S P(16)=P16+PSIV1#(1440/P(15)+.5\1) S:'P(16) P(16)=1440/P(15)+.5\1
  1.  I PSJIO,$G(PSJIO("SL"))]"" X PSJIO("SL")
  1.  I PSIV1 D BARCODE
  1.  S X="["_$P(^PS(55,DFN,"IV",+ON,0),U)_"]"_" "_VADM(2)_"  "_PSIVWD_"  "_$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3) D PRNTL
  1.  S X=VADM(1) S:$P(PSIVSITE,U,9) X=X_"  "_$S(VAIN(5)]"":VAIN(5),1:"NF") D PRNTL S X=" " D PRNTL
  1.  D:$P(PSIVSITE,U,12) TVOL
  1.  S X="",$P(X,"=",PSIVRM-1)="" D PRNTL
  1.  I $D(PSIVFLAG) F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",+ON,"AD",PSIV)) Q:'PSIV  S Y=^(PSIV,0),X=$S($D(^PS(52.6,+Y,0)):$P(^(0),U),1:"*********")_" "_$P(Y,U,2)_" " S:$P(Y,U,3)]"" X=X_" ("_$P(Y,U,3)_")" D
  1.  . D PRNTL,MESS
  1.  I $D(PSIVFLAG) F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IV",+ON,"SOL",PSIV)) Q:'PSIV  S PSIV=PSIV_"^"_+^(PSIV,0),YY=^(0) D
  1.  . D SOL1,PRNTL
  1.  . S X=$P(^PS(52.7,$P(PSIV,U,2),0),U,4) I X]"" S X="   "_X D PRNTL
  1.  G:$D(PSIVFLAG) SOL
  1.  F PSIV=0:0 S PSIV=$O(^PS(55,DFN,"IVBCMA",PSJIDNO,"SOL",PSIV)) Q:'PSIV  S PSIV=PSIV_"^"_+^(PSIV,0),YY=^(0) D
  1.  . D SOL1,PRNTL
  1.  . S X=$P(^PS(52.7,$P(PSIV,U,2),0),U,4) I X]"" S X="   "_X D PRNTL
  1.  F I=0:0 S I=$O(HYPL(I)) Q:'I  S PSIV="" F I=I:0 S PSIV=$O(HYPL(I,PSIV)) Q:PSIV=""  D
  1.  . F Z="" S Z=$O(HYPL(I,PSIV,Z)) Q:Z=""  S PSIVA=$S(I=50.4:PSIV,I=52.7:+^PS(55,DFN,"IVBCMA",PSJIDNO,"SOL",+$P(HYPL(I,PSIV,Z),U,2),0),1:+^PS(55,DFN,"IVBCMA",PSJIDNO,"AD",+$P(HYPL(I,PSIV,Z),U,2),0)) D HYP
  1. SOL S X="",$P(X,"=",PSIVRM-1)="" D PRNTL
  1.  S X=" " D PRNTL I PSIV1'>0!'$P(PSIVSITE,U,3)!($P(PSIVSITE,U,3)=1&(P(4)'="P"))!($P(PSIVSITE,U,3)=2&("AH"'[P(4))) G MEDRT
  1.  S:'$D(PSIVDOSE) PSIVDOSE="" S X=$P(PSIVDOSE," ",PSIV1) D:$E(X)="." CONVER^PSIVLABL S X="Dose due at: "_$S(X="":"________",1:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)_" "_$E(X#1_"000",2,5)) D PRNTL
  1.  ;
  1. MEDRT ;Find Medication Route
  1.  S PSIVRP="",PSIVRT=""
  1.  I $D(^PS(55,DFN,"IV",+ON,.2)) S PSIVRP=$P(^PS(55,DFN,"IV",+ON,.2),U,3) D
  1.  .S PSIVRT=$P(^PS(51.2,PSIVRP,0),U,1)
  1.  .S X="ROUTE: "_PSIVRT D:X]"" PMR
  1.  ;
  1. INF S X=$P(P(8),"@") D:X]"" PRNTL
  1.  I $D(^PS(55,DFN,"IV",+ON,3)) S X=$P(^(3),U) D:X]"" PRNTL
  1.  S X=P(9) D:X]"" PRNTL
  1.  S X=P(11) D:X]"" PRNTL
  1.  ;PSJ*5*184 - Display all messages if more than one additive has a message.
  1.  I $D(MESS) S PSIMESS="" F  S PSIMESS=$O(MESS(PSIMESS)) Q:PSIMESS=""  S X=PSIMESS D PRNTL
  1.  I $D(^PS(59.5,PSIVSN,4)) S Y=^(4) F PSIV=1:1 S X=$P(Y,U,PSIV) Q:X=""  D PRNTL
  1.  S X=$S('+$G(PSIV1):"0[0]",1:PSIVBAG) D PRNTL
  1.  Q
  1. PRNTL N I F LINE=LINE+1:1 D  Q:$L(X)<1
  1.  . I LINE>PSIVSITE D
  1.  .. S LINE=1
  1.  .. I 'PSJIO D  Q
  1.  ... F ZZ=1:1 Q:ZZ>$P(PSIVSITE,"^",16)  W !
  1.  .. F I="EL","SL" I $G(PSJIO(I))]"" X PSJIO(I)
  1.  . K ZZ
  1.  . F I="ST","STF" I $G(PSJIO(I))]"" X PSJIO(I)
  1.  . W $E(X,1,PSIVRM)
  1.  . F I="ETF","ET" I $G(PSJIO(I))]"" X PSJIO(I)
  1.  . I 'PSJIO W !
  1.  . S X=$E(X,PSIVRM+1,999)
  1.  Q
  1. PMR ; Print Med Route on label
  1.  F LINE=LINE+1:1 D  Q:$L(X)<1
  1.  . I LINE>PSIVSITE D
  1.  .. S LINE=1
  1.  .. I 'PSJIO D  Q
  1.  ... F ZZ=1:1 Q:ZZ>$P(PSIVSITE,"^",16)  W !
  1.  .. F I="EL","SL" I $G(PSJIO(I))]"" X PSJIO(I)
  1.  . K ZZ
  1.  . ;
  1.  . F I="ST","STF","SM","SMF" I $G(PSJIO(I))]"" X PSJIO(I)
  1.  . W $E(X,1,PSIVRM)
  1.  . F I="ETF","ET","EMF","EM" I $G(PSJIO(I))]"" X PSJIO(I)
  1.  . I 'PSJIO W !
  1.  . S X=$E(X,PSIVRM+1,999)
  1.  Q
  1.  ;
  1. TVOL ;
  1.  S PSIV=TVOL F X=0:0 S X=$O(^PS(55,DFN,"IVBCMA",PSJIDNO,"AD",X)) Q:'X  S X=X_"^"_^(X,0) S:$P(X,U,4)[P(16)!($P(X,U,4)="")!'PSIV1 PSIV=PSIV+$S($P(^PS(52.6,$P(X,U,2),0),U,10):$P(X,U,3)/$P(^(0),U,10),1:0)
  1.  S X="Total Volume: "_(PSIV+.5\1) D PRNTL
  1.  Q
  1. SOL1 S X=$S($D(^PS(52.7,$P(PSIV,U,2),0)):$P(^(0),U)_" "_$P(^PS(55,DFN,"IVBCMA",PSJIDNO,"SOL",+PSIV,0),U,2),1:"**********") Q
  1. HYP ;
  1.  I PSIV="*" S X="*** Error in "_$S(I=50.4:"electrolyte",I=52.7:"solution",1:"additive") D PRNTL Q
  1.  S X=+HYPL(I,PSIV,Z)
  1.  S X=$S($D(^PS(I,PSIVA,0)):$P(^(0),U),1:"Undefined "_$S(I=50.4:"electrolyte",I=52.7:"solution",1:"additive"))_" "_(X+.005\.01/100)_" "_$P($P(HYPL(I,PSIV,Z),U)," ",2)
  1.  D PRNTL
  1.  Q
  1. SETP S Y=^PS(55,DFN,"IV",+ON,0) F X=1:1:23 S P(X)=$P(Y,U,X)
  1.  Q
  1. MESS ;PSJ*5*184 -make MESS a local array so all messages display for all additives.
  1.  I $P(^PS(52.6,+Y,0),U,9)]"" S MESS($P(^PS(52.6,+Y,0),U,9))=""
  1.  Q
  1. BARCODE D PSET^%ZISP
  1.  I 'PSJIO D
  1.  . I IOBARON]"" W @IOBARON
  1.  . W PSJBCID
  1.  . I IOBAROFF]"" W @IOBAROFF
  1.  . W !
  1.  I PSJIO D
  1.  . F I="SB","SBF" I $G(PSJIO(I))]"" X PSJIO(I)
  1.  . W PSJBCID
  1.  . F I="EBF","EB" I $G(PSJIO(I))]"" X PSJIO(I)
  1.  Q
  1. PSIVHYP ;
  1.  K HYPL S TVOL=0 F Z=52.6,52.7 F DRG=0:0 S DRG=$O(^PS(55,DFN,"IVBCMA",PSJIDNO,$S(Z=52.6:"AD",1:"SOL"),DRG)) Q:'DRG  S DRG=DRG_"^"_^(DRG,0) S $P(DRG,"^",4)="ALL" D DRG^PSIVHYP
  1.  S TVOL=TVOL+.5\1 K EL,DRG,NAD,Z
  1.  Q