- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVUTL1.m
r613 r623 1 PSIVUTL1 ;BIR/MLM-IV UTILITIES ;21 MAY 96 / 10:37 AM 2 ;;5.0; INPATIENT MEDICATIONS ;**58,81,111,134**;16 DEC 97;Build 124 3 ; 4 ; Reference to ^PS(50.7 is supported by DBIA 2180 5 ; Reference to ^PS(51.2 is supported by DBIA 2178 6 ; Reference to ^PS(52.6 is supported by DBIA 1231 7 ; Reference to ^PS(52.7 is supported by DBIA 2173. 8 ; Reference to ^PS(55 is supported by DBIA 2191 9 ; 10 DRGSC(Y,PSJSCT) ; Called to set DIC("S") when selecting orderable item. 11 N OK,ND,NDU,NDI S OK=0 ;* I '$D(^PSDRUG("AP",+Y)) K PSJSCT Q 0 12 S ND=$G(^PS(50.7,+Y,0)) 13 I $P(ND,U,3) S OK=$S('$P(ND,U,4):1,$P(ND,U,4)>DT:1,1:0) 14 Q OK 15 ; 16 IVDRGSC(Y) ; Set DIC("S") for IV additive/solution selection. 17 ; Naked reference below refers to full reference in Y, which is either ^PS(52.6, or ^PS(52.7 18 N Y S Y="S X(1)=$G(^(0)),X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0),$D(^PSDRUG(+$P(X(1),U,2),0)) S X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0)" 19 Q Y 20 ; 21 ENU(Y) ;Get IV additive strength. 22 N X S X=$P(^PS(52.6,+Y,0),U,3),Y=$$CODES^PSIVUTL(X,52.6,2) 23 Q Y 24 ; 25 CODES(X,Y) ; Get name from code. 26 S Y=$P($P(";"_$P(Y,U,3),";"_X_":",2),";") 27 Q Y 28 ; 29 GTPCI(Y) ; Set up "work" area for provider comments. 30 N DIC,DINUM,DLAYGO,X S DIC="^PS(53.45,",DIC(0)="LNZ",DLAYGO=53.45,(DINUM,X)=+DUZ D ^DIC 31 Q Y 32 ; 33 WDTE(Y) ; Format and print date. 34 I 'Y S Y="******" 35 E X ^DD("DD") S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2) 36 Q Y 37 GTOT(DFN,ON) ; Get order type for display. 38 N DRGT,DRGI,Y 39 S X=$P($G(^PS(55,DFN,"IV",ON,0)),U,4) 40 S Y=$S(X="A":"F",X="H":"H",1:"I") 41 I Y="F" F DRGT="AD","SOL" F DRGI=0:0 S DRGI=$O(^PS(55,DFN,"IV",+ON,DRGT,DRGI)) Q:'DRGI I '$P($G(^PS(55,DFN,"IV",+ON,DRGT,DRGI)),U,5) S Y="I" Q 42 Q Y 43 ; 44 PIV(ON) ; Display IV orders. 45 N DRG,ON55,P,PSJORIFN,TYP,X,Y S TYP="?" I ON["V" D 46 .S Y=$G(^PS(55,DFN,"IV",+ON,0)) F X=2,3,4,5,8,9,17,23 S P(X)=$P(Y,U,X) 47 .S TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I TYP'="O" S TYP="C" 48 .S ON55=ON,P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I") D GTDRG^PSIVORFB,GTOT^PSIVUTL(P(4)) 49 I ON'["V" S (P(2),P(3))="",P(17)=$P($G(^PS(53.1,+ON,0)),U,9),Y=$G(^(8)),P(4)=$P(Y,U),P(8)=$P(Y,U,5),P(9)=$P($G(^(2)),U) D GTDRG^PSIVORFA,GTOT^PSIVUTL(P(4)) I $E(P("OT"))="I" D Q 50 .S P("PD")=$P($$DRUGNAME^PSJLMUTL(PSGP,ON),"^"),P("DO")=$S($P(DN,"^",2)=.2:$P($G(^PS(55,PSGP,5,+PSJO,.2)),"^",2),1:$G(^PS(55,PSGP,5,+PSJO,.3))),P("DO")=$P(P("DO"),"^") 51 .S Y=$G(^PS(53.1,+ON,.2)),P("MR")=$P($G(^PS(53.1,+ON,0)),U,3)_U_$P($G(^PS(51.2,+$P($G(^PS(53.1,+ON,0)),U,3),0)),U,3) 52 .W ?9,P("PD") D PIV1 W !?11,"Give: ",P("DO")," ",$P(P("MR"),U,2)," ",$S(P(9)]"":P(9),1:P(8)) 53 S DRG=0 F S DRG=$O(DRG("AD",DRG)) Q:'DRG D PIVAD 54 SOL ; 55 NEW NAME 56 S DRG=0 F S DRG=$O(DRG("SOL",DRG)) Q:'DRG D 57 . D NAME(DRG("SOL",DRG),39,.NAME,0) 58 . W ! W:DRG=1 ?9,"in " 59 . F X=0:0 S X=$O(NAME(X)) Q:'X W ?12 W NAME(X) I X=1,DRG=1,'$D(DRG("AD",1)) D PIV1 60 Q 61 PIVAD ; Print IV Additives. 62 NEW NAME 63 D NAME(DRG("AD",DRG),39,.NAME,1) 64 F X=0:0 S X=$O(NAME(X)) Q:'X W:DRG'=1 ! W ?9,NAME(X) I X=1,DRG=1 D PIV1 65 Q 66 ; 67 PIV1 ; Print Sched type, start/stop dates, and status. 68 F X=2,3 S P(X)=$E($$ENDTC^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:5)) 69 I '$D(PSJEXTP) W ?50,TYP,?53,P(2),?60,P(3),?67,P(17) Q 70 W ?50,TYP,?53,P(2),?63,P(3),?73,P(17) 71 Q 72 59 ; Validate the Infusion rate entered using IV Quick order code. 73 N I F I=2,3,5,7,8,9,11,15,23 S P(I)="" 74 S P(4)="A",P(8)=$P($G(^PS(57.1,PSJQO,1)),U,5) 75 I $G(^PS(57.1,PSJQO,4,1,0)) S DRG("SOL",1)=^(0),DRG("SOL",0)=1 76 I X["?" S F1=53.1,F2=59 D ENHLP^PSIVORC1 G 59 77 I X]"" D ENI^PSIVSP S:$D(X) P(8)=X 78 Q 79 WRTDRG(X,L) ; Format and print drug name, strength and bottle no. 80 N Y S Y=" "_$P(X,U,3) S:$P(X,U,4) Y=Y_" ("_$P(X,U,4)_")" 81 Q $E($P(X,U,2),1,(L-$L(Y)))_Y 82 NAME(X,L,NAME,AD) ; Format Additive display. 83 ;INPUT : X=DRG("AD",DRG) L=Display length AD=for Addtive(1/0) 84 ;OUTPUT: AD(X) if X=2 that means there is a second line to display 85 K NAME 86 NEW Y S Y=$P(X,U,3) S:(AD&$P(X,U,4)) Y=Y_" ("_$P(X,U,4)_")" 87 S:'AD Y=Y_" "_$S(P(4)="P"!($G(P(23))="P")!$G(P(5)):P(9),1:$P(P(8),"@")) 88 I ($L($P(X,U,2))+$L(Y)+1)>L S NAME(1)=$P(X,U,2),NAME(2)=" "_Y Q 89 S NAME(1)=$P(X,U,2)_" "_Y 90 Q 91 ; 92 CNVTOM(RATE,TVOL) ; Convert volume to minutes 93 ; Input: 94 ; RATE - Infusion Rate 95 ; TVOL - Volume being infused, EX: m100 (100 Milliliters) or l5 (5 Liters) 96 ; Output: 97 ; MINS - Minutes required to infuse volume 98 N DAYS,ML,MLSHR 99 ; Get rate in terms of mils per hour 100 I 'RATE Q 0 101 I RATE<1 S RATE=1 102 S TVOL=$S($E(TVOL)="m":$E(TVOL,2,9),$E(TVOL)="l":$E(TVOL,2,9)*1000,1:0) Q:'TVOL 0 103 ; Find IV duration in minutes 104 S MINS=(TVOL/RATE)*60 105 Q MINS 106 ; 107 GETMIN(LIM,DFN,PSJORD,DAYS) ; 108 N F,DDLX 109 I LIM!(LIM=0) Q LIM 110 S F=$S(PSJORD["P":"^PS(53.1,+PSJORD,",PSJORD["V":"^PS(55,DFN,""IV"",+PSJORD,",1:"") 111 N RATE S RATE=$S(PSJORD["P":+$P($G(@(F_"8)")),"^",5),PSJORD["V":+$P($G(@(F_"0)")),"^",8),1:0) 112 I (",l,m,")[(","_$E(LIM)_",") D 113 .I RATE D 114 ..I RATE<1 S RATE=1 115 ..S MIN=$$CNVTOM(RATE,LIM) I MIN S LIM=MIN 116 .I 'RATE N SOL,SOLVOL,DOSVOL,DUR,STOP,OIX,X S (SOLVOL,DOSVOL)="" D 117 ..S SOL=0 F S SOL=$O(@(F_"""SOL"",SOL)")) Q:'SOL D 118 ...S SOLVOL=$P(@(F_"""SOL"",SOL,0)"),"^",2) I SOLVOL S DOSVOL=DOSVOL+SOLVOL 119 ..S DDLX=$S($E(LIM)["l":(($E(LIM,2,99)*1000)/DOSVOL),1:($E(LIM,2,99)/DOSVOL))_"L" 120 I (",a,")[(","_$E(LIM)_",") S DDLX=$E(LIM,2,99)_"L" 121 I $G(DDLX)>0 D 122 .N STOP,LASTD S DAYS="",STOP="" 123 .S OIX=$P($G(@(F_".2)")),"^") S:(DDLX<1) DDLX="1L" S LASTD=$$DOSES^PSIVCAL(DDLX,.P) 124 .I LASTD,$G(P(2)) S DAYS=$$FMDIFF^XLFDT(LASTD,P(2),2) I DAYS>0 S DAYS=DAYS/86400 125 .I DAYS>0 S LIM=DAYS*1440 126 I (",h,d,")[(","_$E(LIM)_",") S LIM=$S($E(LIM)="d":(1440*$E(LIM,2,99)),1:(60*$E(LIM,2,99))) Q 127 Q LIM 1 PSIVUTL1 ;BIR/MLM-IV UTILITIES ;21 MAY 96 / 10:37 AM 2 ;;5.0; INPATIENT MEDICATIONS ;**58,81,111**;16 DEC 97 3 ; 4 ; Reference to ^PS(50.7 is supported by DBIA 2180 5 ; Reference to ^PS(51.2 is supported by DBIA 2178 6 ; Reference to ^PS(52.6 is supported by DBIA 1231 7 ; Reference to ^PS(55 is supported by DBIA 2191 8 ; 9 DRGSC(Y,PSJSCT) ; Called to set DIC("S") when selecting orderable item. 10 N OK,ND,NDU,NDI S OK=0 ;* I '$D(^PSDRUG("AP",+Y)) K PSJSCT Q 0 11 S ND=$G(^PS(50.7,+Y,0)) 12 I $P(ND,U,3) S OK=$S('$P(ND,U,4):1,$P(ND,U,4)>DT:1,1:0) 13 Q OK 14 ; 15 IVDRGSC(Y) ; Set DIC("S") for IV additive/solution selection. 16 N Y S Y="S X(1)=$G(^(0)),X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0),$D(^PSDRUG(+$P(X(1),U,2),0)) S X(2)=$G(^(""I"")) I $S('X(2):1,X(2)>DT:1,1:0)" 17 Q Y 18 ; 19 ENU(Y) ;Get IV additive strength. 20 N X S X=$P(^PS(52.6,+Y,0),U,3),Y=$$CODES^PSIVUTL(X,52.6,2) 21 Q Y 22 ; 23 CODES(X,Y) ; Get name from code. 24 S Y=$P($P(";"_$P(Y,U,3),";"_X_":",2),";") 25 Q Y 26 ; 27 GTPCI(Y) ; Set up "work" area for provider comments. 28 N DIC,DINUM,DLAYGO,X S DIC="^PS(53.45,",DIC(0)="LNZ",DLAYGO=53.45,(DINUM,X)=+DUZ D ^DIC 29 Q Y 30 ; 31 WDTE(Y) ; Format and print date. 32 I 'Y S Y="******" 33 E X ^DD("DD") S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2) 34 Q Y 35 GTOT(DFN,ON) ; Get order type for display. 36 N DRGT,DRGI,Y 37 S X=$P($G(^PS(55,DFN,"IV",ON,0)),U,4) 38 S Y=$S(X="A":"F",X="H":"H",1:"I") 39 I Y="F" F DRGT="AD","SOL" F DRGI=0:0 S DRGI=$O(^PS(55,DFN,"IV",+ON,DRGT,DRGI)) Q:'DRGI I '$P($G(^PS(55,DFN,"IV",+ON,DRGT,DRGI)),U,5) S Y="I" Q 40 Q Y 41 ; 42 PIV(ON) ; Display IV orders. 43 N DRG,ON55,P,PSJORIFN,TYP,X,Y S TYP="?" I ON["V" D 44 .S Y=$G(^PS(55,DFN,"IV",+ON,0)) F X=2,3,4,5,8,9,17,23 S P(X)=$P(Y,U,X) 45 .S TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I TYP'="O" S TYP="C" 46 .S ON55=ON,P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I") D GTDRG^PSIVORFB,GTOT^PSIVUTL(P(4)) 47 I ON'["V" S (P(2),P(3))="",P(17)=$P($G(^PS(53.1,+ON,0)),U,9),Y=$G(^(8)),P(4)=$P(Y,U),P(8)=$P(Y,U,5),P(9)=$P($G(^(2)),U) D GTDRG^PSIVORFA,GTOT^PSIVUTL(P(4)) I $E(P("OT"))="I" D Q 48 .S P("PD")=$P($$DRUGNAME^PSJLMUTL(PSGP,ON),"^"),P("DO")=$S($P(DN,"^",2)=.2:$P($G(^PS(55,PSGP,5,+PSJO,.2)),"^",2),1:$G(^PS(55,PSGP,5,+PSJO,.3))),P("DO")=$P(P("DO"),"^") 49 .S Y=$G(^PS(53.1,+ON,.2)),P("MR")=$P($G(^PS(53.1,+ON,0)),U,3)_U_$P($G(^PS(51.2,+$P($G(^PS(53.1,+ON,0)),U,3),0)),U,3) 50 .W ?9,P("PD") D PIV1 W !?11,"Give: ",P("DO")," ",$P(P("MR"),U,2)," ",$S(P(9)]"":P(9),1:P(8)) 51 S DRG=0 F S DRG=$O(DRG("AD",DRG)) Q:'DRG D PIVAD 52 SOL ; 53 NEW NAME 54 S DRG=0 F S DRG=$O(DRG("SOL",DRG)) Q:'DRG D 55 . D NAME(DRG("SOL",DRG),39,.NAME,0) 56 . W ! W:DRG=1 ?9,"in " 57 . F X=0:0 S X=$O(NAME(X)) Q:'X W ?12 W NAME(X) I X=1,DRG=1,'$D(DRG("AD",1)) D PIV1 58 Q 59 PIVAD ; Print IV Additives. 60 NEW NAME 61 D NAME(DRG("AD",DRG),39,.NAME,1) 62 F X=0:0 S X=$O(NAME(X)) Q:'X W:DRG'=1 ! W ?9,NAME(X) I X=1,DRG=1 D PIV1 63 Q 64 ; 65 PIV1 ; Print Sched type, start/stop dates, and status. 66 F X=2,3 S P(X)=$E($$ENDTC^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:5)) 67 I '$D(PSJEXTP) W ?50,TYP,?53,P(2),?60,P(3),?67,P(17) Q 68 W ?50,TYP,?53,P(2),?63,P(3),?73,P(17) 69 Q 70 59 ; Validate the Infusion rate entered using IV Quick order code. 71 N I F I=2,3,5,7,8,9,11,15,23 S P(I)="" 72 S P(4)="A",P(8)=$P($G(^PS(57.1,PSJQO,1)),U,5) 73 I $G(^PS(57.1,PSJQO,4,1,0)) S DRG("SOL",1)=^(0),DRG("SOL",0)=1 74 I X["?" S F1=53.1,F2=59 D ENHLP^PSIVORC1 G 59 75 I X]"" D ENI^PSIVSP S:$D(X) P(8)=X 76 Q 77 WRTDRG(X,L) ; Format and print drug name, strength and bottle no. 78 N Y S Y=" "_$P(X,U,3) S:$P(X,U,4) Y=Y_" ("_$P(X,U,4)_")" 79 Q $E($P(X,U,2),1,(L-$L(Y)))_Y 80 ;Q $E($$ENPDN^PSGMI($P(X,U,6)),1,(L-$L(Y)))_Y 81 NAME(X,L,NAME,AD) ; Format Additive display. 82 ;INPUT : X=DRG("AD",DRG) L=Display length AD=for Addtive(1/0) 83 ;OUTPUT: AD(X) if X=2 that means there is a second line to display 84 K NAME 85 NEW Y S Y=$P(X,U,3) S:(AD&$P(X,U,4)) Y=Y_" ("_$P(X,U,4)_")" 86 S:'AD Y=Y_" "_$S(P(4)="P"!($G(P(23))="P")!$G(P(5)):P(9),1:$P(P(8),"@")) 87 I ($L($P(X,U,2))+$L(Y)+1)>L S NAME(1)=$P(X,U,2),NAME(2)=" "_Y Q 88 S NAME(1)=$P(X,U,2)_" "_Y 89 Q 90 ; 91 CNVTOM(RATE,TVOL) ; Convert volume to minutes 92 N DAYS,ML,MLSHR 93 ; Get rate in terms of mils per hour 94 I 'RATE Q 0 95 S TVOL=$S($E(TVOL)="m":$E(TVOL,2,9),$E(TVOL)="l":$E(TVOL,2,9)*1000,1:0) Q:'TVOL 0 96 ; Find IV duration in minutes 97 S MINS=(TVOL/RATE)*60 S MINS=MINS+1 98 Q MINS
Note:
See TracChangeset
for help on using the changeset viewer.
