source: WorldVistAEHR/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGMMIVC.m@ 1776

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

initial load of WorldVistAEHR

File size: 5.1 KB
Line 
1PSGMMIVC ;BIR/MV-PRT MULT DAYS MAR C ORDERS(IV) ;16 Mar 99 / 2:10 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**20,21,28,31,35,67,58,110**;16 DEC 97
3 ;
4 ; Reference to ^PS(52.7 supported by DBIA #2173.
5 ; Reference to ^PS(55 supported by DBIA #2191.
6 ;
7PRT ;*** Print IV orders.
8 K P,DRG,PSGLRN,PSGMARTS,PSGMARGD,PSGLFFD,TS N ON55,PSJLABEL S TS=1,PSGMARGD="",PSJLABEL=1
9 S ON=$P(DAO,U,2),DFN=$P(PN,U,2) D:$P(DAO,U,2)["V" GT55^PSIVORFB D:$P(DAO,U,2)["P" GT531^PSIVORFA(DFN,ON) D:P(9)]"" OS S PSGLSSD=P(2),PSGLFFD=P(3)
10 I $G(P("DTYP"))'=1 K P(11)
11 F X="LOG",2,3 S:P(X) P(X)=$$ENDTC1^PSGMI(P(X))
12 D INITOPI
13 S PSGST=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3)) I PSGST'="O" S PSGST=$S(P(9)["PRN":"P",1:"C")
14 I PSGST="O",(P(2)="") S PSGST=""
15 NEW NAMENEED,NEED,X S NAMENEED=0
16 D LNNEED^PSGMIV,PRTIV
17 Q
18 ;
19OS ; order record set
20 S FD=P(3),PSGOES="",X=P(9),SD=P(2) D EN^PSGS0 S T=PSGS0XT
21 S QQ="" I PST["C" D DTS^PSGMMAR0(P(9)) S SD=$P(SD,"."),QQ="" F X=0:0 S X=$O(PSGD(X)) Q:'X S QQ=QQ_$S(X<SD:"",X>FD:"",'S:$P(PSGD(X),U),$D(S(X)):$P(PSGD(X),U),1:"")
22 I T="D",P(11)="" S P(11)=$E($P(P(2),".",2)_"0000",1,4)
23 S PSGMARTS=P(11),PSGMARGD=QQ
24 K TS D TS^PSGMAR3(P(11))
25 Q
26 ;
27PRTIV ;*** Print IV order on MAR
28 I PSGMAROC,(PSGMAROC+LN)>6 D BOT^PSGMMAR2,HEADER^PSGMMAR2
29 S PSGMAROC=PSGMAROC+1 W !?6,"|",?19,"|",?48,"|",$G(TS(1)) D CELL(1,0)
30 W !,$E(P("LOG"),1,5)," |"
31 W:ON["V" $E(P(2),1,5)_$E(P(2),9,14)," |",P(3)
32 W:ON["P" "P E N D I N G"
33 W ?39,"("_$E(PSGP(0))_$E(PSSN,8,12)_")"
34 W ?48,"|",$G(TS(2)) D CELL(2,0) S L=3
35 NEW NAME
36 F X=0:0 S X=$O(DRG("AD",X)) Q:'X D NAME^PSIVUTL(DRG("AD",X),47,.NAME,1) F Y=0:0 S Y=$O(NAME(Y)) Q:'Y W !,NAME(Y) W:L=3 ?47,PSGST W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D L(1)
37 I '$G(DRG("AD",0)) D
38 .W !
39 .W:L=3 ?47,PSGST W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D L(1)
40 W:$G(DRG("SOL",0)) !,"in "
41 NEW PSJPRT2
42 F X=0:0 S X=$O(DRG("SOL",X)) Q:'X D NAME^PSIVUTL(DRG("SOL",X),47,.NAME,1) F Y=0:0 S Y=$O(NAME(Y)) Q:'Y D
43 . W:(Y>1!(X>1)) ! W ?4,NAME(Y) W:L=3 ?47,PSGST W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D L(1)
44 . S PSJPRT2=$P(^PS(52.7,+DRG("SOL",X),0),U,4) I PSJPRT2]"" W !?7,PSJPRT2 W:L=3 ?47,PSGST W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D L(1)
45 W !,$P(P("MR"),U,2)," ",P(9)," ",P(8) W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) I L>5 S PSJTMPL=L\6,PSJDIV=PSJTMPL+4 I L>PSJDIV,(L#PSJDIV>1) W ! ;I L>5,(L#5>1) W !
46 I '$G(DRG("SOL",0)) S L=L+1 W !,?48,"|",$G(TS(L)) D CELL(L,'(L#6))
47 ;I P(4)="C",'(L#5),P("OPI")="" D L(1) W !,"*CAUTION-CHEMOTHERAPY*",?48,"|",$G(TS(L)) D CELL(L,'(L#6)) W ! ;S L=L+1
48 I P(4)="C",'(L#5),P("OPI")="" D
49 . D L(1)
50 . W !,"*CAUTION-CHEMOTHERAPY*",?48,"|",$G(TS(L))
51 . D CELL(L,'(L#6)) W ! ;S L=L+1
52 ;E I P(4)="C" D L(1) W "*CAUTION-CHEMOTHERAPY*",?48,"|",$G(TS(L)) D CELL(L,'(L#6)) I (L+1)#6'=0 W !
53 E I P(4)="C" D
54 . D L(1)
55 . W:L#7=0 !
56 . W "*CAUTION-CHEMOTHERAPY*",?48,"|",$G(TS(L))
57 . D CELL(L,'(L#6))
58 . I (L+1)#6'=0 W !
59 I (L#5)=0,($L($P(P("OPI"),"^"))<29),(TS<7) S L=L+1
60 E D L(1)
61 W:P("OPI")=""&(TS>6) !
62 I P("OPI")'="" D
63 . I L#7=0 W !
64 . I L#5=1 W !
65 . N PSJTMPX S PSJTMPX=0
66 . F Y=1:1:$L($P(P("OPI"),"^")," ") S Y1=$P($P(P("OPI"),"^")," ",Y) D
67 .. I $L(Y1)>47 W $E(Y1,1,47)
68 .. I (PSJTMPX+$L(Y1))>47 W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)),L(1) S PSJTMPX=0 W !
69 .. I $L(Y1)>47 W $E(Y1,48,$L(Y1)) S PSJTMPX=$L($E(Y1,48,$L(Y1)))
70 .. E W Y1," " S PSJTMPX=PSJTMPX+$L(Y1)+1
71 N PSGIVFL I '$O(DRG("AD",0))!'$O(DRG("SOL",0)) S PSGIVFL=1
72 I L>TS,(L#6) W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) S L=L+1
73 I (TS-1)>L W ?48,"|",$G(TS(L)) D CELL(L,'(L#6)) D
74 . F L=L+1:1:TS-1 D L(0) W !?48,"|",$G(TS(L)) D CELL(L,'(L#6))
75 . S L=L+1
76 F Q:'(L#6) W !?48,"|",$G(TS(L)) D CELL(L,'(L#6)) S L=L+1
77 I '(L#6),(P("OPI")="") W !
78 I P("OPI")]"",(L>6) W !
79 W ?29,"RPH: ",PSGLRPH,?38,"RN: ",PSGLRN,?48,"|",$G(TS(L)) D CELL(L,'(L#6)) W:PSGMAROC<6 !?7,LN2
80 Q
81 ;
82L(X) ;***Check to see if a new block if needed.
83 S L=L+X
84 I L#6=0,PSGMAROC<6 D
85 . W !,"See next label for continuation",?48,"|",$G(TS(L)) D CELL(L,'(L#6))
86 . W:PSGMAROC<6 !?7,LN2,$C(13) S $X=0 S PSGMAROC=PSGMAROC+1,L=L+1 D
87 . . I LN>6,(PSGMAROC>5) S MSG1="*** CONTINUE ON NEXT PAGE ***" D BOT^PSGMMAR2,HEADER^PSGMMAR2 S PSGMAROC=1
88 Q
89LN(L) ;*** Print lines within block.
90 N X S X=$S(L#6:LN4,1:LN7)
91 Q X
92CELL(X,X1) ;
93 I ON["P",(X=6) NEW PSGLFFD,PSGMARGD S P(9)="",PSGLFFD="9999999",PSGMARGD="" W ?55 D ASTERS^PSGMMAR2 Q
94 I TS=1,'$G(P(11)),(X=6) W ?55 D ASTERS^PSGMMAR2 Q
95 I TS=1,'$G(P(11)) W ?55,$$LN(X) Q
96 D CELL^PSGMMAR2(X,X1)
97 Q
98INITOPI ;* Set nurse's initial and the other print info.
99 D RPHINIT^PSGMIV(.PSGLRPH)
100 S PSGLRN="_____"
101 I ON["V" N ND4 S ND4=$G(^PS(55,DFN,"IV",+ON,4))
102 I $G(ND4) D
103 .I $G(DFN),$G(ON) N PSGLREN S PSGLREN=+$$LASTREN^PSJLMPRI(DFN,ON) D
104 ..N PSGLRNDT S PSGLRNDT=$P(ND4,"^",2),ND4=+ND4 I PSGLRNDT,$G(PSGLREN) I $G(PSGLREN)>PSGLRNDT S ND4=0
105 .I ND4 D NAME(+ND4,"",.PSGLRN)
106 I ON["P" D
107 . I P("OPI")="",$O(^PS(53.1,ON,12,0)) S X=0 F S X=$O(^PS(53.1,ON,12,X)) Q:'X S Z=$G(^(X,0)),Y=$L(P("OPI")) S:Y+$L(Z)'>179 P("OPI")=P("OPI")_Z_" " I Y+$L(Z)>179 S P("OPI")="SEE PROVIDER COMMENTS"
108 . S PSGST=""
109 . D NAME(+$G(^PS(53.1,+ON,4)),"",.PSGLRN)
110 Q
111NAME(X,NAME,INIT) ;Lookup in ^VA(200.
112 ;X = IEN in ^VA(200
113 ;NAME = Return the name in 200
114 ;INIT = Return the initial
115 NEW DIC,Y
116 S DIC="^VA(200,",DIC(0)="NZ" D ^DIC
117 S NAME=$G(Y(0,0))
118 S INIT=$P($G(Y(0)),U,2)
119 Q
Note: See TracBrowser for help on using the repository browser.