source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSIVUTL.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.7 KB
Line 
1PSIVUTL ;BIR/MLM-IV UTILITIES ;07 SEP 97 / 2:17 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**69,58,81,85,110,133**;16 DEC 97
3 ;
4 ; Reference to ^DD("DD" is supported by DBIA 10017.
5 ; Reference to ^PS(50.7 is supported by DBIA 2180.
6 ; Reference to ^PS(52.6 is supported y DBIA 1231.
7 ; Reference to ^PS(55 is supported by DBIA 2191.
8 ; Reference to ^PS(52.7 is supported by DBIA 2173.
9 ; Reference to ^DIC is supported by DBIA 10006.
10 ; Reference to ^PS(51.1 is supported by DBIA 2177.
11 ;
12DRGSC(Y,PSJSCT) ; Called to set DIC("S") when selecting Orderable Items.
13 N OK,ND,NDU,NDI S OK=0
14 S ND=$G(^PS(50.7,+Y,0))
15 ;I $P(ND,U,3) S OK=$S('$P(ND,U,4):1,$P(ND,U,4)>DT:1,1:0)
16 S OK=$S('$P(ND,U,4):1,$P(ND,U,4)>DT:1,1:0)
17 Q OK
18 ;
19IVDRGSC(Y) ; Set DIC("S") for IV additive/solution selection.
20 ; Naked reference below refers to full reference in Y, which is either ^PS(52.6, or ^PS(52.7
21 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('+$P(X(1),U,11):0,'X(2):1,X(2)>DT:1,1:0)"
22 Q Y
23 ;
24ENU(Y) ;Get IV additive strength.
25 N X S X=$P(^PS(52.6,+Y,0),U,3),Y=$$CODES^PSIVUTL(X,52.6,2)
26 Q Y
27 ;
28CODES(PSJCD,PSJF,PSJFLD) ; Get name from code.
29 ; PSJF = one of following files: ^PS(55, ^PS(53.1, ^PS(52.6
30 D FIELD^DID(PSJF,PSJFLD,"","POINTER","PSJDD")
31 S Y=$G(PSJDD("POINTER")) K PSJDD
32 S Y=$P($P(";"_Y,";"_PSJCD_":",2),";")
33 Q Y
34 ;
35CODES1(PSJCD,PSJF,PSJFLD) ;Check to see if code is valid.
36 ; PSJF = one of following files: ^PS(55, ^PS(53.1, ^PS(52.6
37 D FIELD^DID(PSJF,PSJFLD,"","POINTER","PSJDD")
38 I PSJDD("POINTER")'[PSJCD_":" K PSJDD Q 0
39 K PSJDD Q 1
40 ;
41CODES2(PSJF,PSJFLD) ;Get field name
42 ; PSJF = one of following files: ^PS(55, ^PS(53.1, ^PS(52.6
43 D FIELD^DID(PSJF,PSJFLD,"","LABEL","PSJDD")
44 Q PSJDD("LABEL")
45 ;
46GTPCI(Y) ; Set up "work" area for provider comments.
47 N DIC,DINUM,DLAYGO,X S DIC="^PS(53.45,",DIC(0)="LNZ",DLAYGO=53.45,(DINUM,X)=+DUZ D ^DIC
48 Q Y
49 ;
50WDTE(Y) ; Format and print date.
51 I 'Y S Y="******"
52 E X ^DD("DD") S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)
53 Q Y
54GTOT(Y) ; Get order type & protocol
55 S P("OT")=$S(Y="A":"F",Y="H":"H",1:"I")
56 I P("OT")="F" F DRGT="AD","SOL" F DRGI=0:0 S DRGI=$O(DRG(DRGT,DRGI)) Q:'DRGI I '$P(DRG(DRGT,DRGI),U,5) S P("OT")="I" Q
57 Q
58 ;
59PIV(ON) ; Display IV orders.
60 N DRG,ON55,P,PSJORIFN,TYP,X,Y S TYP="?" I ON["V" D
61 .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)
62 .S TYP=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I TYP'="O" S TYP="C"
63 .S ON55=ON,P("OT")=$S(P(4)="A":"F",P(4)="H":"H",1:"I") D GTDRG^PSIVORFB,GTOT^PSIVUTL(P(4))
64 .W $S($P($G(^PS(55,DFN,"IV",+ON,.2)),U,4)="D":" d",1:" ")
65 .S X=$G(^PS(55,DFN,"IV",+ON,4)) I +PSJSYSU,'+$P(X,U,$S(+PSJSYSU=3:4,1:++PSJSYSU)) W "->"
66 I ON=+ON N O S O="" F S O=$O(^PS(53.1,"ACX",ON,O)) Q:O="" D
67 . S (P(2),P(3))="",P(17)=$P($G(^PS(53.1,+O,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)) D PIV(O_"P") W !
68 I ON["P" 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
69 . NEW MARX,PSIVX D DRGDISP^PSJLMUT1(PSGP,+ON_"P",40,54,.MARX,0)
70 . F PSIVX=0:0 S PSIVX=$O(MARX(PSIVX)) Q:'PSIVX W @($S(PSIVX=1:"?9",1:"!?11")),MARX(PSIVX) D:PSIVX=1 PIV1
71 NEW DRGX S DRGX=0 F S DRGX=$O(DRG("AD",DRGX)) Q:'DRGX D PIVAD
72SOL ;
73 NEW NAME
74 S DRGX=0 F S DRGX=$O(DRG("SOL",DRGX)) Q:'DRGX D
75 . D NAME(DRG("SOL",DRGX),39,.NAME,0)
76 . W:($D(DRG("AD",1))!(DRGX>1)) ! W:DRGX=1 ?9,"in "
77 . F X=0:0 S X=$O(NAME(X)) Q:'X W ?12 W NAME(X) I X=1,DRGX=1,'$D(DRG("AD",1)) D PIV1
78 Q
79PIVAD ; Print IV Additives.
80 NEW NAME,PSGX
81 D NAME(DRG("AD",DRGX),39,.NAME,1)
82 F PSGX=0:0 S PSGX=$O(NAME(PSGX)) Q:'PSGX W:(DRGX'=1!(PSGX'=1)) ! W ?9,NAME(PSGX) I PSGX=1,DRGX=1 D PIV1
83 Q
84 ;
85PIV1 ; Print Sched type, start/stop dates, and status.
86 F X=2,3 S P(X)=$E($$ENDTC^PSGMI(P(X)),1,$S($D(PSJEXTP):8,1:5))
87 I '$D(PSJEXTP) W ?50,TYP,?53,P(2),?60,P(3),?67,P(17) Q
88 W ?50,TYP,?53,P(2),?63,P(3),?73,P(17)
89 Q
9059 ; Validate the Infusion rate entered using IV Quick order code.
91 N I F I=2,3,5,7,8,9,11,15,23 S P(I)=""
92 S P(4)="A",P(8)=$P($G(^PS(57.1,PSJQO,1)),U,5)
93 I $G(^PS(57.1,PSJQO,4,1,0)) S DRG("SOL",1)=^(0),DRG("SOL",0)=1
94 I X["?" S F1=53.1,F2=59 D ENHLP^PSIVORC1 G 59
95 I X]"" D ENI^PSIVSP S:$D(X) P(8)=X
96 Q
97WRTDRG(X,L) ; Format and print drug name, strength and bottle no.
98 N Y S Y=" "_$P(X,U,3) S:$P(X,U,4) Y=Y_" ("_$P(X,U,4)_")"
99 Q $E($P(X,U,2),1,(L-$L(Y)))_Y
100 ;
101NAME(X,L,MARX,AD) ; Format Additive display.
102 ;INPUT : X=DRG("AD",DRG) L=Display length AD=for Additive(1/0)
103 ;OUTPUT: AD(X) if X=2 that means there is a second line to display
104 N Y K MARX S Y=$P(X,U,3) S:(AD&$P(X,U,4)) Y=Y_" ("_$P(X,U,4)_")"
105 ;* S:'AD Y=Y_" "_$S(P(4)="P"!($G(P(23))="P")!$G(P(5)):P(9),1:$P(P(8),"@"))
106 I 'AD!('$O(DRG("SOL",0))) D
107 .I $G(PSJL)[" in" S Y=Y_" "_$S(P(4)="P"!($G(P(23))="P")!$G(P(5)):P(9),1:$P(P(8),"@")) Q
108 .I $G(DRGX)]"",DRGX'>1 S Y=Y_" "_$S(P(4)="P"!($G(P(23))="P")!$G(P(5)):P(9),1:$P(P(8),"@")) Q
109 ;I ($L($P(X,U,2))+$L(Y)+1)>L S NAME(1)=$P(X,U,2),NAME(2)=" "_Y Q
110 I ($L($P(X,U,2))+$L(Y)+1)>L D TXT^PSGMUTL($P(X,U,2)_" "_Y,L) S:AD MARX(2)=" "_MARX(2) Q
111 S MARX(1)=$P(X,U,2)_" "_Y
112 Q
113 ;
114INTERVAL(IVAR) ;
115 N P,X,PSGOES M P=IVAR S X=$G(P(9)),PSGOES=1
116 D EN^PSIVSP S IVAR(15)=$S($G(P(15)):P(15),1:1440)
117 Q IVAR(15)
118 ;
119DOW(SCHED) ;
120 Q:SCHED="" 0
121 N P9,PSIVX,X S PSIVX=0 S P9=SCHED
122 ; Use schedule validator
123 S X=SCHED D DW^PSGS0 I $G(X)="" Q 0
124 I +$O(^PS(51.1,"APPSJ",SCHED,0)) S PSIVX=1 S P9=$P(SCHED,"@") F X=1:1:$L(P9,"-") D Q:'$G(PSIVX)
125 . I '("MON,TUE,WED,THU,FRI,SAT,SUN"[$P(P9,"-",X)) S PSIVX=0 Q
126 Q:PSIVX +PSIVX
127 I '$D(^PS(51.1,"APPSJ",SCHED)) S PSIVX=1,P9=$P(SCHED,"@") F X=1:1:$L(P9,"-") D Q:'$G(PSIVX)
128 . I '(",MO,TU,WE,TH,FR,SA,SU,"[(","_$P(P9,"-",X)_",")) S PSIVX=0 Q
129 Q +PSIVX
Note: See TracBrowser for help on using the repository browser.