source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJLIUTL.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: 7.1 KB
Line 
1PSJLIUTL ;BIR/MV-IV LM utilities modules ;25 APR 00 / 4:28 PM
2 ;;5.0; INPATIENT MEDICATIONS ;**39,50,58,81,85,110,180**;16 DEC 97;Build 5
3 ;
4 ; Reference to ^ORD(101 is supported by DBIA #872.
5 ; Reference to ^PS(55 is supported by DBIA #2191.
6 ; Reference to ES^ORX8 is supported by DBIA #3632.
7 ; Reference to ^PS(52.7 is supported by DBIA 2173.
8 ; Reference to ^PS(52.6 is supported by DBIA 1231.
9 ;
10 ; NFI changes for FR#2@wrtdrg(drgt)
11FLDNO(X,COL) ; Display the number next to the field name.
12 ;
13 ; X=Text; COL=Column to start from
14 ;
15 S:'$D(PSJSTAR) PSJSTAR=""
16 NEW PSJOLDOT S PSJOLDOT=P("OT") D GTOT^PSIVUTL(P(4))
17 S X=$S((X="(3)"&(P("OT")="I")):" ",PSJSTAR[X:"*",1:" ")_X
18 S PSJL=$$SETSTR^VALM1($S(($G(PSJHIS)&(ON'=PSJORD)):"",1:X),PSJL,COL,5)
19 Q
20 ;
21LONG(Y,COL,LEN) ; Display long fields.
22 ;
23 ; Y=Text string; COL=Start prt at this col; LEN=Total lenght per line.
24 ;
25 N STRLEN,STR S STR="",STRLEN=1
26 ; If string has no blank space.
27 I $L(Y," ")=1,$L(Y)>LEN D Q
28 . S LINE=$L(Y)\LEN+$S($L(Y)#LEN:1,1:0)
29 . F X=1:1:LINE-1 D
30 . . S PSJL=$$SETSTR^VALM1($E(Y,STRLEN,LEN*X),PSJL,COL,LEN)
31 . . D SETTMP^PSJLMPRU("PSJI",PSJL) S PSJL="",STRLEN=LEN*X+1
32 . S PSJL=$$SETSTR^VALM1($E(Y,STRLEN,LEN*LINE),PSJL,COL,LEN)
33 ;
34 F X=1:1:$L(Y," ") D
35 . I $L(STR)+$L($P(Y," ",X))>LEN D
36 . . S PSJL=$$SETSTR^VALM1(STR,PSJL,COL,LEN)
37 . . D SETTMP^PSJLMPRU("PSJI",PSJL) S (STR,PSJL)=""
38 . S STR=STR_$P(Y," ",X)_" "
39 S PSJL=$$SETSTR^VALM1(STR,PSJL,COL,LEN)
40 Q
41 ;
42WRTDRG(DRGT) ; Print AD/SOL drugs for "backdoor" view.
43 NEW DRGX,PSJIVIEN,PSJX
44 F DRGX=0:0 S DRGX=$O(DRG(DRGT,DRGX)) Q:'DRGX D
45 . S (PSJIVIEN,X)=$G(DRG(DRGT,DRGX)) I DRGT="SOL",$P($G(^PS(52.7,+X,0)),U,4)]"" S $P(X,U,2)=$P(X,U,2)_" "_$P(^(0),U,4)
46 . S PSJL="",PSJX=$S($P(X,U,2)]"":$P(X,U,2)_" "_$P(X,U,3)_" "_$P(X,U,4),1:"*** Undefined ***")
47 . NEW PSJNF D NFIV^PSJDIN($S(DRGT="AD":52.6,1:52.7),+PSJIVIEN,.PSJNF)
48 . S PSJX=PSJX_PSJNF("NF")
49 . S PSJL=$$SETSTR^VALM1(PSJX,PSJL,8,72)
50 . D SETTMP^PSJLMPRU("PSJI",PSJL)
51 . ;PSJLMX is newed in AD^PSJLIVMD & AD^PSJLIVFD. This var count # of ad/sol so we knows
52 . ;which line to blink the Requested start/stop dates.
53 . S PSJLMX=$G(PSJLMX)+1
54 Q
55 ;
56WTPC ; Write provider comments.
57 ;F PSIVX=0:0 S PSIVX=$O(^PS(53.45,PSIVUP,4,PSIVX)) Q:'PSIVX!$D(DUOUT)!$D(DTOUT) S Y=$G(^PS(53.45,PSIVUP,4,PSIVX,0)) D LONG(Y,22,58) D SETTMP^PSJLMPRU("PSJI",PSJL) S PSJL=""
58 Q:$G(PSIVCHG)=1
59 I $G(PSJORD),PSJORD["P" F PSIVX=0:0 S PSIVX=$O(^PS(53.1,+PSJORD,12,PSIVX)) Q:'PSIVX!$D(DUOUT)!$D(DTOUT) S Y=$G(^PS(53.1,+PSJORD,12,PSIVX,0)) D LONG(Y,22,58) D SETTMP^PSJLMPRU("PSJI",PSJL) S PSJL=""
60 I $G(PSJORD),PSJORD'["P" F PSIVX=0:0 S PSIVX=$O(^PS(55,DFN,"IV",+PSJORD,5,PSIVX)) Q:'PSIVX!$D(DUOUT)!$D(DTOUT) S Y=$G(^PS(55,DFN,"IV",+PSJORD,5,PSIVX,0)) D LONG(Y,22,58) D SETTMP^PSJLMPRU("PSJI",PSJL) S PSJL=""
61 Q
62 ;
63TYPE() ; IV Type
64 S X=$$CODES^PSIVUTL(P(4),53.1,53) S X=$S($E(X)="C":"CHEMO",1:X)_$S(P(23)'="":" ("_P(23)_")",1:"")_$S(P(5)=1:" (I)",P(5)=0:"(C)",1:"")
65 Q X
66 ;
67STARTDT() ; Start Date
68 S X="" I $D(PSIVNUM) S:P("DTYP") X=$S(P(17)="P"!(PSIVAC="PN"):" ",1:"*")_$S(P("DTYP")=1:"(12)",$E(P("OT"))="I":"(10)",1:"(8)")
69 Q $$ENDTC^PSGMI(P(2))
70 ;
71STOPDT() ; Stop Date
72 S X="" I $D(PSIVNUM) S:P("DTYP") X=$S(P(17)="P"!(PSIVAC="PN"):" ",1:"*")_$S(P("DTYP")=1:"(13)",$E(P("OT"))="I":"(11)",1:"(9)")
73 Q $$ENDTC^PSGMI(P(3))
74 ;
75PROVIDER() ; Provider
76 S X="" I $D(PSIVNUM),P("DTYP") S X=$S(PSIVAC="PN":" ",1:"*")_$S(P("DTYP")=1:"(14)",$E(P("OT"))="I":"(12)",1:"(10)") ;I P(17)="P",(+P("CLRK")=+P(6)) S X=""
77 I $G(P(21))]"",$L($T(ES^ORX8)) N ESIG,ESIG1 S ESIG=P("NAT"),ESIG1=$$ES^ORX8(+P(21)_";1") S:ESIG1=1 ESIG="ES"
78 S X=$S($P(P(6),U,2)]"":$E($P(P(6),U,2),1,23),1:"*** Undefined") S:$G(ESIG)]"" X=X_" ["_$$LOW^XLFSTR(ESIG)_"]"
79 Q X
80WDTE(Y) ; Format and print date.
81 I 'Y S Y=""
82 E X ^DD("DD") S Y=$P(Y,"@")_" "_$P($P(Y,"@",2),":",1,2)
83 Q Y
84 ;
85ACTIONS() ;
86 N DIC,X,Y
87 S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
88 I Y="PSJI LM DISCONTINUE" Q $S(PSGACT["D":1,1:0)
89 I Y="PSJI LM EDIT" Q $S(PSGACT["E":1,1:0)
90 I Y="PSJI PC RENEWAL" Q $S(PSGACT["R":1,1:0)
91 I Y="PSJI PC HOLD" Q $S(PSGACT["H":1,1:0)
92 I Y="PSJI PC ONCALL" Q $S(PSGACT["O":1,1:0)
93 I Y="PSJI LM VERIFY" Q $S(PSGACT["V":1,1:0)
94 I Y="PSJ LM FLAG" Q $S(PSGACT["G":1,1:0)
95 ;PSJ*5*180
96 I $G(PSJBADD)=1,PSGACT["F" S PSGACT=$TR(PSGACT,"F")
97 I Y="PSJI LM FINISH" Q $S(PSGACT["F":1,1:0)
98 I Y="PSJ LM IV PENDING" Q $S(PSGACT["F":1,1:0)
99 Q 1
100 ;
101ACT() ;
102 NEW Y
103 S Y=$P($G(^ORD(101,+$G(^ORD(101,DA(1),10,DA,0)),0)),U) I Y="" Q 0
104 I $G(PSJHIDFG),(Y="PSJ LM NEW ORDER") Q 0
105 I Y="PSJ LM NEW ORDER FROM PROFILE" Q $S($G(PSIVBR)="D ^PSIVOPT":1,1:0)
106 Q 1
107 ;
108REQDT(ORDER) ;
109 Q:$G(ORDER)'["P" N ND0,PARENT I '$D(PSGRDTX(+ORDER)) K PSGRDTX
110 S PSGRDTX=$G(^PS(53.1,+ORDER,2.5)),ND0=$G(^PS(53.1,+ORDER,0)),PARENT=$P($G(^PS(53.1,+ORDER,.2)),"^",8),(PSGRSD,PSGRSDN,PSGRFD,PSGRFDN)=""
111 Q:'$G(PSGRDTX) I '$P(PSGRDTX,"^",3)&'PARENT Q ; Complex orders (duration OR parent) only?
112 I $P(ND0,U,9)'["P"!($P(ND0,U,24)="R") K PSGRDTX,PSGRFD,PSGRFDN Q
113 S $P(PSGRDTX,U,4)=ORDER
114 S PSGSD=$S($G(P(2)):P(2),1:$G(PSGSD)) I $L(PSGSD)>6 S PSGSD=$$DATE2^PSJUTL2(PSGSD)
115 S PSGFD=$S($G(P(3)):P(3),1:$G(PSGFD)) I $L(PSGFD)>6 S PSGFD=$$DATE2^PSJUTL2(PSGFD)
116 I $G(PSGSD),$G(PSGRDTX(+ORDER,"PSGSD")) I (","_PSGRDTX(+ORDER,"PSGSD")_","_PSGRDTX(+ORDER,"PSGRSD")_",")'[(","_PSGSD_",") D
117 . S PSGRDTX(+ORDER,"PSGSD")=PSGSD
118 I $G(PSGFD),$G(PSGRDTX(+ORDER,"PSGFD")) I (","_PSGRDTX(+ORDER,"PSGFD")_","_PSGRDTX(+ORDER,"PSGRFD")_",")'[(","_PSGFD_",") D
119 . S PSGRDTX(+ORDER,"PSGFD")=PSGFD
120 I $G(PSGSD),'$G(PSGRDTX(+ORDER,"PSGSD")) D
121 . S PSGRSD=$S($G(PSGRDTX(+ORDER,"PSGRSD")):PSGRDTX(+ORDER,"PSGRSD"),1:$P(PSGRDTX,U)) Q:'PSGRSD
122 . S A=PSGRSD,PSGRSD=PSGSD,PSGSD=A
123 . S PSGRDTX(+ORDER,"PSGRSD")=PSGRSD,PSGRDTX(+ORDER,"PSGSD")=PSGSD I $G(P(4))]"",PSGSD]"" S P(2)=PSGSD
124 . I PARENT,($P($G(PSGSRDTX),"^",3)="") S PSGNESD=PSGSD
125 I $G(PSGFD),'$G(PSGRDTX(+ORDER,"PSGFD")) D
126 . S PSGRFD=$S($D(PSGRDTX(+ORDER,"PSGRFD")):PSGRDTX(+ORDER,"PSGRFD"),1:$P(PSGRDTX,U,3)) Q:'PSGRFD
127 . S A=PSGRFD,PSGRFD=$S($G(PSGFD):PSGFD,1:$G(PSGNEFD)),PSGFD=A
128 . S PSGRDTX(+ORDER,"PSGRFD")=PSGRFD,(PSGNEFD,PSGRDTX(+ORDER,"PSGFD"))=PSGFD I $G(P(4))]"",PSGFD]"" S P(3)=PSGFD
129 S PSGSD=$S($G(PSGRDTX(+ORDER,"PSGSD")):PSGRDTX(+ORDER,"PSGSD"),1:$G(PSGSD)) I $G(P(4))]"",$L(PSGSD)>6 S P(2)=$$DATE2^PSJUTL2(PSGSD)
130 I $G(PSGSD) S PSGSDN=$$ENDD^PSGMI(PSGSD)_U_$$ENDTC^PSGMI(PSGSD)
131 S PSGRSD=$S($G(PSGRDTX(+ORDER,"PSGRSD")):PSGRDTX(+ORDER,"PSGRSD"),1:$G(PSGRSD))
132 I $G(PSGRSD) S PSGRSDN=$$ENDTC^PSGMI(PSGRSD)
133 I $G(PSGRDTX(+ORDER,"PSGFD")),$G(PSGSD) I PSGSD>PSGRDTX(+ORDER,"PSGFD") N DUR S DUR=$P($G(PSGRDTX),U,2) D
134 . N DURMIN S DURMIN=$$DURMIN^PSJLIVMD(DUR) S (PSGFD,PSGRDTX(+ORDER,"PSGFD"))=$$FMADD^XLFDT(PSGSD,,,$S(DURMIN:DURMIN,1:1440))
135 S PSGFD=$S($G(PSGRDTX(+ORDER,"PSGFD")):PSGRDTX(+ORDER,"PSGFD"),1:$G(PSGFD)) D
136 . I PSGFD<PSGSD,$G(PSGFD),ORDER'["V" N PSGST I $G(DFN) S PSGST=$S(PSGORD["P":$P(^PS(53.1,+PSGORD,0),"^",7),1:$P(^PS(55,DFN,5,+PSGORD,0),"^",7)) D
137 .. D ENFD^PSGNE3(PSGSD) I PSGNEFD>PSGSD S PSGFD=PSGNEFD
138 . I PSGFD<PSGSD,$G(PSGFD),ORDER["V" D ENSTOP^PSIVCAL I P(3)>P(2) S PSGFD=P(3)
139 . I $G(P(4))]"",$L(PSGFD)>6 S P(3)=$$DATE2^PSJUTL2(PSGFD)
140 I $G(PSGFD) S PSGFDN=$$ENDD^PSGMI(PSGFD)_U_$$ENDTC^PSGMI(PSGFD)
141 S PSGRFD=$S($G(PSGRDTX(+ORDER,"PSGRFD")):PSGRDTX(+ORDER,"PSGRFD"),1:$G(PSGRFD))
142 I $G(PSGRFD) S PSGRFDN=$$ENDTC^PSGMI(PSGRFD)
143 Q
Note: See TracBrowser for help on using the repository browser.