source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGMIV.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1PSGMIV ;BIR/MV-IV ORDER FOR THE 24 HOUR MAR. ;25 Nov 98 / 9:07 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**4,20,21,28,58,111,131,145**;16 DEC 97;Build 17
3 ;
4 ; Reference to ^PS(55 supported by DBIA #2191.
5 ; Reference to ^PS(52.7 supported by DBIA #2173.
6 ;
7START ;*** Read IV orders
8 S ON=""
9 F PSGMARED=PSGPLS-.0001:0 S PSGMARED=$O(^PS(55,PSGP,"IV","AIT",PST,PSGMARED)) Q:'PSGMARED F S ON=$O(^PS(55,PSGP,"IV","AIT",PST,PSGMARED,ON)) Q:ON="" D IV
10 Q
11IV ;*** Sort IV orders for 24 Hrs MAR.
12 K DRG,P N X,ON55,PSJLABEL S DFN=PSGP,PSJLABEL=1 D GT55^PSIVORFB
13 Q:P(2)>PSGPLF
14 S X=$P(P("MR"),U,2) Q:XTYPE=2&(X["IV") Q:XTYPE=3&(PST="S")&'($S(X="IV":1,X="IVPB":1,1:0))
15 S QST=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3))
16 S QST=$S(P(9)["PRN":"OVP",QST="O":"OVO",1:"CV")_XTYPE
17 N PSGMARWC ;DEM (05/30/2006) - PSGMARWC is used to preserve original value of PSGMARWN (patient location) in case location is changed by an order with a clinic location.
18 S PSGMARWC=PSGMARWN
19 I $G(DRG) S X=$S($G(DRG("AD",1)):DRG("AD",1),1:$G(DRG("SOL",1))),X=$E($P(X,U,2),1,20)_U_ON_"V" D
20 . N A
21 . S A=$G(^PS(55,PSGP,"IV",+ON,"DSS")) I $P(A,"^")]"" S PSGMARWN="C!"_$P(A,"^") I $G(SUB1)]"",$G(SUB2)]"",'$D(^TMP($J,TM,PSGMARWN,SUB1,SUB2)) D
22 . . N X,X1,Y
23 . . D SPN^PSGMAR0
24 . . Q
25 . . ;
26 . I PSGSS="P" S ^TMP($J,PPN,PSGMARWN,$S(+PSGMSORT:$E(QST,1),1:QST),X)="" Q ;DAM 5-01-07 Print by PATIENT
27 . I PSGSS="L" Q:((PSGINWDG="")&(PSGMARWN'["C!")) S ^TMP($J,PPN,PSGMARWN,$S(+PSGMSORT:$E(QST,1),1:QST),X)="" Q ;DAM 5-01-07 Print by clinic group
28 . I PSGSS="C" Q:((PSGINWD="")&(PSGMARWN'["C!")) I ((PSGMARWN[PSGCLNC)!(PSGMARWN'["C!")) S ^TMP($J,PPN,PSGMARWN,$S(+PSGMSORT:$E(QST,1),1:QST),X)="" Q ;DAM 5-01-07 Print by Clinic
29 . ;
30 . ;DAM 5-01-07 Set up XTMP global where location and patient names are switched
31 . I '$G(PSGREP) N PSGDEM1 S PSGDEM1=X D ;transfer contents of patient drug information contained in "X" above to a new variable temporarily
32 . . S PSGREP="PSGM_"_$J
33 . . S X1=DT,X2=1 D C^%DTC K %,%H,%T
34 . . S ^XTMP(PSGREP,0)=X_U_DT
35 . I PSGRBPPN="P",PSGSS="W" Q:((PSGINCL="")&(PSGMARWN["C!")) D ;Construct XTMP global for printing by WARD and sort by PATIENT
36 . . S ^XTMP(PSGREP,TM,PPN,PSGMARWN,PSJPRB,$S(+PSGMSORT:$E(QST,1),1:QST),PSGDEM1)=""
37 . . D SPN^PSGMAR0
38 . I PSGRBPPN="P",PSGSS="G" Q:((PSGINCLG="")&(PSGMARWN["C!")) D ;Construct XTMP global for printing by WARD GROUP and sort by PATIENT
39 . . S ^XTMP(PSGREP,TM,PPN,PSGMARWN,PSJPRB,$S(+PSGMSORT:$E(QST,1),1:QST),PSGDEM1)=""
40 . . D SPN^PSGMAR0
41 . S X=$G(PSGDEM1)
42 . ;END DAM
43 . ;
44 . I PSGRBPPN="R",PSGSS="W" Q:((PSGINCL="")&(PSGMARWN["C!")) D ;Construct TMP global for printing by WARD and sort by ROOM/BED
45 . . S ^TMP($J,TM,PSGMARWN,PSJPRB,PPN,$S(+PSGMSORT:$E(QST,1),1:QST),X)=""
46 . I PSGRBPPN="R",PSGSS="G" Q:((PSGINCLG="")&(PSGMARWN["C!")) D ;Construct TMP global for printing by WARD GROUP and sort by ROOM/BED
47 . . S ^TMP($J,TM,PSGMARWN,PSJPRB,PPN,$S(+PSGMSORT:$E(QST,1),1:QST),X)=""
48 . ;
49 S:PSGMARWN'=PSGMARWC PSGMARWN=PSGMARWC
50 ;
51 Q
52PRT ;*** Print IV orders.
53 K TS,P,DRG NEW ON55,LN,PSJLABEL S PSJLABEL=1
54 S ON=$P(DAO,U,2),DFN=$P(PN,U,2) D:ON["V" GT55^PSIVORFB
55 D:ON["P" GT531^PSIVORFA(DFN,ON)
56 S TS=1,TMSTR="" I P(9)]"" D ORSET,TS^PSGMAR3(P(11))
57 F X="LOG",2,3 S:P(X) P(X)=$$ENDTC1^PSGMI(P(X))
58 S PSGST=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I PSGST'="O" S PSGST=$S(P(9)["PRN":"P",1:"C")
59 S PSGLFFD=PSGPLF
60 D INITOPI^PSGMMIVC
61 NEW NAMENEED,NEED,X S NAMENEED=0
62 D LNNEED,PRTIV
63 Q
64LNNEED ;*** Find lines needed per label.
65 ;*** If OPI<29 char, it is ok to put INITs in the same line.
66 ;*** Add number of lines needed for additives and solutions and 1 line
67 ;*** for infusion rate and x line for OPI. Divide by 5 to determine
68 ;*** of label(s) needed for this order.
69 F X="AD","SOL" D NAMENEED^PSJMUTL(X,47,.NEED) S NAMENEED=NAMENEED+NEED
70 S X=($L($P(P("OPI"),"^"))\47)+(($L($P(P("OPI"),"^"))#47)>28)+1+($P(P("OPI"),"^")]""&(P(4)="C"))
71 S X=(NAMENEED+X+2) S X=$S(X<6:1,1:((X-6)\5)+2)
72 S LN=$S(TS/6>X:TS/6,1:X)
73 Q
74 ;
75OS ; order record set
76 Q
77 ;
78PRTIV ;*** Print IV order on MAR
79 D ONHOLD^PSGMMAR2
80 I PSGMAROC,(PSGMAROC+LN)>6 D BOT^PSGMAR3,HEADER^PSGMAR3
81 NEW PSGL S PSGL="|"
82 S PSGMAROC=PSGMAROC+1 W !?6,"|",?19,"|",?48,PSGL,$G(TS(1)),?55,"|"
83 W !,$E(P("LOG"),1,5)," |"
84 I ON["V" D
85 . I $G(ONHOLD) W "O N H O L D" Q
86 . W $E(P(2),1,5)_$E(P(2),9,14)," |",P(3)
87 . Q
88 W:ON["P" "P E N D I N G"
89 W ?39,"(",$E(PSGP(0))_$E(PSSN,8,12)_")"
90 W ?48,PSGL,$G(TS(2)),?55,"|" S L=3
91 NEW NAME,PSIVX
92 F PSIVX=0:0 S PSIVX=$O(DRG("AD",PSIVX)) Q:'PSIVX D NAME^PSIVUTL(DRG("AD",PSIVX),47,.NAME,1) F Y=0:0 S Y=$O(NAME(Y)) Q:'Y W !,NAME(Y) W:L=3 ?47,PSGST W ?48,PSGL,$G(TS(L)),?55,"|" D:(PSIVX=1&((PSGST="O")!(PSGST="C"))) TMSTR^PSGMAR3 D L(1)
93 W:$G(DRG("SOL",0)) !,"in "
94 NEW PSJPRT2
95 F PSIVX=0:0 S PSIVX=$O(DRG("SOL",PSIVX)) Q:'PSIVX D NAME^PSIVUTL(DRG("SOL",PSIVX),47,.NAME,1) F Y=0:0 S Y=$O(NAME(Y)) Q:'Y D
96 . W:(Y>1!(PSIVX>1)) ! W ?4,NAME(Y) W:L=3 ?47,PSGST W ?48,PSGL,$G(TS(L)),?55,"|" D:L=3 TMSTR^PSGMAR3 D L(1)
97 . S PSJPRT2=$P(^PS(52.7,+DRG("SOL",PSIVX),0),U,4) I PSJPRT2]"" W !?7,PSJPRT2 W:L=3 ?47,PSGST W ?48,PSGL,$G(TS(L)),?55,"|" D:L=3 TMSTR^PSGMAR3 D L(1)
98 W !,$P(P("MR"),U,2)," ",P(9)," ",P(8) W ?48,PSGL,$G(TS(L)),?55,"|" I L>5,(L#5) W !
99 I '$O(DRG("AD",0))!('$O(DRG("SOL",0))) W !?48,PSGL,$G(TS(L)),?55,"|" S L=5
100 I P(4)="C",'(L#5),P("OPI")="" W !,"*CAUTION-CHEMOTHERAPY*" S L=L+1 Q
101 I P(4)="C" D L(1) W !,"*CAUTION-CHEMOTHERAPY*",?48,PSGL,$G(TS(L)),?55,"|"
102 I (L#5)=0,($L($P(P("OPI"),"^"))<29),(TS<7) S L=L+1
103 E D L(1)
104 W:P("OPI")=""&(TS>6) !
105 I P("OPI")'="" D
106 . W:(L#6)=0 !
107 . F Y=1:1:$L($P(P("OPI"),"^")," ") S Y1=$P($P(P("OPI"),"^")," ",Y) D W Y1," "
108 . I ($X+$L(Y1))>47 W ?48,PSGL,$G(TS(L)),?55,"|" D L(1) W !
109 I L>TS,(L#6) W ?48,PSGL,$G(TS(L)),?55,"|" S L=L+1 W:L#6=0 !
110 I (TS-1)>L W ?48,PSGL,$G(TS(L)),?55,"|" D
111 . F L=L+1:1:TS-1 D L(0) W !?48,PSGL,$G(TS(L)),?55,"|"
112 . S L=L+1
113 F Q:'(L#6) W !?48,PSGL,$G(TS(L)),?55,"|" S L=L+1
114 I '(L#6),(P("OPI")="") W !
115 I P("OPI")]"",(L>6) W !
116 W ?29,"RPH: ",PSGLRPH,?38,"RN: ",PSGLRN,?48,PSGL,$G(TS(L)),?55,"|" W:PSGMAROC<6 !?7,LN2
117 Q
118 ;
119L(X) ;***Check to see if a new block is needed.
120 S L=L+X
121 I L#6=0,PSGMAROC<6 W !,"See next label for continuation",?48,PSGL,$G(TS(L)),?55,"|" W:PSGMAROC<6 !?7,LN2 S PSGMAROC=PSGMAROC+1,L=L+1 D
122 .I LN>6,(PSGMAROC>5) S MSG1="*** CONTINUE ON NEXT PAGE ***" D BOT^PSGMAR3,HEADER^PSGMAR3 S PSGMAROC=1
123 Q
124ORSET ; order record set
125 Q:PST["P"!P(9)=""
126 S PSGMFOR="",(SD,X)=$P(P(2),".") Q:X>PSGPLF S FD=$P(P(3),"."),PSGOES="",X=P(9) D EN^PSGS0 S T=PSGS0XT
127 S X="" I "OB"]PST,$P(P(9),"^")'["@",P(2)'>PSGPLS,P(3)'<PSGPLF,P(11),T<1441,T'="D" S X=P(11),PSGPLC=1
128 E I "OB"]PST!(PST["OV") K PSGMAR D SETL0 S (Q,X)="" F QX=0:0 S Q=$O(PSGMAR(Q)) Q:Q="" S X=X_$E("0",2-$L(Q))_Q_"-"
129 S TMSTR=X
130 K HCD,HM,I,J,PSGD,PLSD,CD,M,MID,MN,ND,ND1,OD,ST,QD1,QD2,QQ,TS,UD,WDT,WS,WS1,X,X1,X2 Q
131 Q
132SETL0 ;*** Set variable to use in ^PSGPL0 to calculate admin time.
133 K PSGMAR S PSGPLC=0
134 S ND1=P(4),ST=P(2),PLSD=P(3),TS=P(11),MN=T,ND=P(9) I $S(ST'?7N1"."1N.E:1,1:PLSD'?7N1"."1N.E) S PSGPLC="OI" Q
135 D ENIV^PSGPL0
136 Q
137 ;
138RPHINIT(RPH) ; Find initial for the person who completed the IV order.
139 S RPH=$P($G(^PS(55,PSGP,"IV",+ON,4)),U,4)
140 S:+RPH RPH=$$DEFINIT(+RPH)
141 I RPH="" S RPH="_____"
142 Q
143DEFINIT(X) ;
144 S X=$G(^VA(200,X,0)),RPH=$P(X,U,2) Q:RPH]"" RPH
145 S X=$P(X,U),RPH=$E(X,$F(X,","))_$E(X) Q RPH
Note: See TracBrowser for help on using the repository browser.