1 | WVUTL3 ;HCIOFO/FT,JR IHS/ANMC/MWR - UTIL: DATE, LOCK, DIR, PATVARS; ;8/11/98 09:23
|
---|
2 | ;;1.0;WOMEN'S HEALTH;;Sep 30, 1998
|
---|
3 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
---|
4 | ;; UTILITY: ASK DATE RANGE, LOCKS, DIR PROMPTS, STORE/DEL EDC,
|
---|
5 | ;; STORE PAP REGIMEN, PCDVARS & PATVARS.
|
---|
6 | ;
|
---|
7 | ;
|
---|
8 | OUT ;EP
|
---|
9 | ;---> CALLED AFTER ERROR MESSAGES ARE DISPLAYED.
|
---|
10 | S WVPOP=1 D DIRZ
|
---|
11 | Q
|
---|
12 | ;
|
---|
13 | ASKDATES(WVB,WVE,WVPOP,WVBDF,WVEDF,WVSAME,WVTIME) ;EP
|
---|
14 | ;---> ASK DATE RANGE.
|
---|
15 | ;---> PARAMETERS:
|
---|
16 | ; 1 - WVB (RETURNED) BEGIN DATE, FILEMAN FORMAT
|
---|
17 | ; 2 - WVE (RETURNED) END DATE, FILEMAN FORMAT
|
---|
18 | ; 3 - WVPOP (RETURNED) WVPOP=1 IF QUIT,FAIL,DTOUT,DUOUT
|
---|
19 | ; 4 - WVBDF (OPTIONAL) BEGIN DATE DEFAULT, FILEMAN FORMAT
|
---|
20 | ; 5 - WVEDF (OPTIONAL) END DATE DEFAULT, FILEMAN FORMAT
|
---|
21 | ; 6 - WVSAME (OPTIONAL) FORCE END DATE DEFAULT=BEGIN DATE
|
---|
22 | ; 7 - WVTIME (OPTIONAL) ASK TIMES
|
---|
23 | ;
|
---|
24 | ;---> EXAMPLE:
|
---|
25 | ; D ASKDATES^WVUTL3(.WVBEGDT,.WVENDDT,.WVPOP,"T-365","T")
|
---|
26 | ;
|
---|
27 | S WVPOP=0 N %DT,Y
|
---|
28 | W !!," *** Date Range Selection ***"
|
---|
29 | S %DT="APEX"_$S($D(WVTIME):"T",1:"")
|
---|
30 | S %DT("A")=" Begin with DATE: "
|
---|
31 | I $G(WVBDF)]"" S Y=WVBDF D DD^%DT S %DT("B")=Y
|
---|
32 | D ^%DT K %DT
|
---|
33 | I Y<0 S WVPOP=1 Q
|
---|
34 | S (%DT(0),WVB)=Y K %DT("B")
|
---|
35 | S %DT="APEX"_$S($D(WVTIME):"T",1:"")
|
---|
36 | S %DT("A")=" End with DATE: "
|
---|
37 | I $G(WVEDF)]"" S Y=WVEDF D DD^%DT S %DT("B")=Y
|
---|
38 | I $D(WVSAME) S Y=WVB D DD^%DT S %DT("B")=Y
|
---|
39 | D ^%DT K %DT
|
---|
40 | I Y<0 S WVPOP=1 Q
|
---|
41 | S WVE=Y
|
---|
42 | Q
|
---|
43 | ;
|
---|
44 | LOCKED ;EP
|
---|
45 | Q:$D(ZTQUEUED) ;quit if called from a background (tasked) job.
|
---|
46 | W !?5,"Another user is editing this entry. Please, try again later."
|
---|
47 | D DIRZ
|
---|
48 | Q
|
---|
49 | ;
|
---|
50 | LOCKEDE ;EP
|
---|
51 | ;---> LOCKED PREGNANCY LOG ENTRY.
|
---|
52 | W !?5,"Another user is editing the Pregnancy Log for this patient"
|
---|
53 | W !?5,"for this day. Please, try again later."
|
---|
54 | D DIRZ
|
---|
55 | Q
|
---|
56 | ;
|
---|
57 | LOCKEDP ;EP
|
---|
58 | ;---> LOCKED PAP Regimen Log ENTRY.
|
---|
59 | W !?5,"Another user is editing the PAP Regimen Log for this patient"
|
---|
60 | W !?5,"for this day. Please, try again later."
|
---|
61 | D DIRZ
|
---|
62 | Q
|
---|
63 | ;
|
---|
64 | ;
|
---|
65 | DIRZ ;EP
|
---|
66 | ;---> PRESS RETURN TO CONTINUE.
|
---|
67 | N DIR,DIRUT,X,Y
|
---|
68 | I $D(WVPRMT) S DIR("A")=WVPRMT
|
---|
69 | I $D(WVPRMT1) S DIR("A",1)=WVPRMT1
|
---|
70 | I $D(WVPRMT2) S DIR("A",2)=WVPRMT2
|
---|
71 | I $D(WVPRMTQ) S DIR("?")=WVPRMTQ
|
---|
72 | S DIR(0)="E" W ! D ^DIR W !
|
---|
73 | S WVPOP=$S($D(DIRUT):1,Y<1:1,1:0)
|
---|
74 | Q
|
---|
75 | ;
|
---|
76 | DIRPRMT ;EP
|
---|
77 | ;---> REQUIRED VARIABLE: WVPROMPT,M (M=LAST SELECTION# DISPLAYED)
|
---|
78 | ;---> OPTIONAL VARIABLE: WVCODE (EXECUTABLE CODE ACTING ON INPUT X)
|
---|
79 | ;---> WVD=1 IF RANGE OF SELECTION NUMBERS SHOULD BE DISPLAYED.
|
---|
80 | N DIR,DIRUT,Y
|
---|
81 | W ! S:'$D(WVD) WVD=0
|
---|
82 | S DIR(0)="LO^"_$S(WVD:":"_M,1:"1:"_M)
|
---|
83 | I $D(WVPRMT) S DIR("A")=WVPRMT
|
---|
84 | I $D(WVPRMT1) S DIR("A",1)=WVPRMT1
|
---|
85 | I $D(WVPRMT2) S DIR("A",2)=WVPRMT2
|
---|
86 | I $D(WVPRMTQ) S DIR("?")=WVPRMTQ
|
---|
87 | I $D(WVCODE) S DIR(0)=DIR(0)_U_WVCODE
|
---|
88 | D ^DIR
|
---|
89 | S:$D(DTOUT)!($D(DUOUT)) WVPOP=1
|
---|
90 | Q
|
---|
91 | ;
|
---|
92 | STOREDC ;EP
|
---|
93 | ;---> STORE PREGNANCY AND EDC, CALLED BY MUMPS XREF ON FIELDS #.13
|
---|
94 | ;---> AND #.14 IN WV PATIENT FILE. NOTE: WHEN AN EDIT IS DONE,
|
---|
95 | ;---> FIRST KILL AND THEN SET LOGIC OF THE MUMPS XREF IS EXECUTED;
|
---|
96 | ;---> BUT FOR A DELETE (@), ONLY THE KILL LOGIC IS EXECUTED.
|
---|
97 | ;---> REQUIRED VARIABLES: WVDFN, WVPREG=PREGNANT(1=YES,0=NO), WVEDC=EDC
|
---|
98 | Q:'$D(WVEDC)!('$D(WVPREG))!('$D(WVDFN))
|
---|
99 | Q:'WVDFN
|
---|
100 | N DA,DIC,DIE,DG,DLAYGO,DR,N,WVQUIT,X
|
---|
101 | D SETVARS^WVUTL5
|
---|
102 | S WVQUIT=0,DLAYGO=790
|
---|
103 | I WVPREG="" D DELETEDC Q
|
---|
104 | S:WVPREG=0 WVEDC=0
|
---|
105 | S DIE="^WV(790.05,",DR=".03////"_WVPREG_";.04////"_+WVEDC
|
---|
106 | S N=0
|
---|
107 | F S N=$O(^WV(790.05,"C",WVDFN,N)) Q:'N D
|
---|
108 | .I $D(^WV(790.05,"B",DT,N)) S DA=N D
|
---|
109 | ..L +^WV(790.05,DA):0 I '$T D LOCKEDE S WVQUIT=1 Q
|
---|
110 | ..D DIE^WVFMAN(790.05,DR,DA) L -^WV(790.05,DA) S WVQUIT=1
|
---|
111 | Q:WVQUIT
|
---|
112 | ;
|
---|
113 | K DD,DO
|
---|
114 | S DIC="^WV(790.05,",DIC(0)="L",X=DT,DLAYGO=790
|
---|
115 | S DIC("DR")=".02////"_WVDFN_";.03////"_WVPREG_";.04////"_+WVEDC
|
---|
116 | D FILE^DICN
|
---|
117 | Q
|
---|
118 | ;
|
---|
119 | DELETEDC ;EP
|
---|
120 | ;---> DELETE PREGANCY LOG ENTRY FOR THIS DAY (DT).
|
---|
121 | S DIK="^WV(790.05,"
|
---|
122 | S N=0
|
---|
123 | F S N=$O(^WV(790.05,"C",WVDFN,N)) Q:'N D
|
---|
124 | .I $D(^WV(790.05,"B",DT,N)) S DA=N D ^DIK
|
---|
125 | Q
|
---|
126 | ;
|
---|
127 | STORPAP ;EP
|
---|
128 | ;---> STORE PAP REGIMEN, START DATE AND DATE ENTERED; CALLED BY
|
---|
129 | ;---> MUMPS XREF ON FIELDS #.16 AND #.17 IN WV PATIENT FILE.
|
---|
130 | ;---> REQUIRED VARIABLES: WVLDAT=BEGIN DATE, WVLPRG=PAP REGIMEN, WVDFN.
|
---|
131 | Q:'$D(WVLDAT)!('$D(WVLPRG))!('$D(WVDFN))
|
---|
132 | Q:'WVLDAT!('WVLPRG)!('WVDFN)
|
---|
133 | N DA,DIC,DIE,DLAYGO,DR,N,WVQUIT,X,DG
|
---|
134 | D SETVARS^WVUTL5
|
---|
135 | S WVQUIT=0,DLAYGO=790
|
---|
136 | S DIE="^WV(790.04,"
|
---|
137 | S DR=".01////"_WVLDAT_";.03////"_WVLPRG
|
---|
138 | S N=0
|
---|
139 | F S N=$O(^WV(790.04,"C",WVDFN,N)) Q:'N!(WVQUIT) D
|
---|
140 | .I $D(^WV(790.04,"B",WVLDAT,N)) S DA=N D
|
---|
141 | ..L +^WV(790.04,DA):0 I '$T D LOCKEDP S WVQUIT=1 Q
|
---|
142 | ..D DIE^WVFMAN(790.04,DR,DA,.WVPOP) L -^WV(790.04,DA) S WVQUIT=1
|
---|
143 | Q:WVQUIT
|
---|
144 | ;
|
---|
145 | K DD,DO
|
---|
146 | S DIC="^WV(790.04,",DIC(0)="L",X=WVLDAT,DLAYGO=790
|
---|
147 | S DIC("DR")=".02////"_WVDFN_";.03////"_WVLPRG
|
---|
148 | D FILE^DICN
|
---|
149 | Q
|
---|
150 | ;
|
---|
151 | ;
|
---|
152 | PCDVARS(DA,TEXTDATE,COLP) ;EP
|
---|
153 | ;---> SET VARIABLES FOR PROCEDURE DATA FOR HEADERS.
|
---|
154 | ;---> REQUIRED VARIABLES: DA=IEN OF PROCEDURE IN PROC FILE 790.1.
|
---|
155 | ;---> TEXTDATE=1 PROVIDE DATE IN TEXT FORMAT,
|
---|
156 | ;---> OTHERWISE IN NUMERIC FORMAT (1/1/95)
|
---|
157 | ;---> COLP=1 TO SET WVC0=ASSOC'D COLP IF THIS IS
|
---|
158 | ;---> A PAP.
|
---|
159 | ;---> Y=ZERO NODE OF PROCEDURE, WVACCN=ACCESSION#,
|
---|
160 | ;---> WVPCDN=IEN OF PROCEDURE TYPE,
|
---|
161 | ;---> WVRESN=IEN OF RESULT/DIAG,WVRES=TEXT OF RESULT/DIAG
|
---|
162 | ;---> WVPN=PROCEDURE TYPE, WVDFN=DFN OF PATIENT.
|
---|
163 | ;---> WV0=ZERO NODE OF THIS PROCEDURE, WV2=TWO NODE.
|
---|
164 | ;---> WVPAP=1=PCD IS A PAP, WVMAM=1=PCD IS A SCREENING MAM.
|
---|
165 | ;---> WVC0=ZERO NODE OF ASSOCIATED COLP (IF THIS IS A PAP).
|
---|
166 | ;
|
---|
167 | N X,Y S (WV0,Y)=^WV(790.1,DA,0),WVC0=""
|
---|
168 | S WV2=$S($D(^WV(790.1,DA,2)):^(2),1:"")
|
---|
169 | S COLP=$G(COLP) S:COLP WVC0=$$COLP0^WVUTL4(DA)
|
---|
170 | S TEXTDATE=$G(TEXTDATE)
|
---|
171 | S WVACCN=$$ACC^WVUTL1(DA)
|
---|
172 | S WVPCDN=$P(Y,U,4)
|
---|
173 | S X=DA,WVPN=$$PROC^WVUTL1A
|
---|
174 | S WVRESN=$P(Y,U,5),WVRES=$$DIAG^WVUTL4(WVRESN)
|
---|
175 | S X=$P(Y,U,7),WVPROV=$$PROV^WVUTL6
|
---|
176 | S WVDFN=$P(Y,U,2) D PATVARS(WVDFN,TEXTDATE)
|
---|
177 | S (WVMAM,WVPAP)=0
|
---|
178 | S:WVPCDN=28 WVMAM=1 S:WVPCDN=1 WVPAP=1
|
---|
179 | Q
|
---|
180 | ;
|
---|
181 | PATVARS(DFN,TEXTDATE) ;EP
|
---|
182 | ;---> SET VARIABLES FO PATIENT DATA FOR HEADERS.
|
---|
183 | ;---> REQUIRED VARIABLES: WVDFN=IEN OF PATIENT
|
---|
184 | ;---> YIELDS: WVNAME=PATIENT NAME, WVCHRT=SSN#
|
---|
185 | ;---> WVCMGR=CASE MANAGER, WVCNEED=CX TX NEED,
|
---|
186 | ;---> WVPAPRG=PAP REGIMEN, WVBNEED=BR TX NEED, WVEDC=EDC.
|
---|
187 | S TEXTDATE=$G(TEXTDATE)
|
---|
188 | S WVNAME=$$NAME^WVUTL1(DFN)
|
---|
189 | S WVNAMAGE=$$NAMAGE^WVUTL1(DFN)
|
---|
190 | S WVCHRT=$$SSN^WVUTL1(DFN)
|
---|
191 | S WVCMGR=$$CMGR^WVUTL1(DFN)
|
---|
192 | S WVCNEED=$$CNEED^WVUTL1(DFN,TEXTDATE)
|
---|
193 | S WVPAPRG=$$PAPRG^WVUTL1(DFN,TEXTDATE)
|
---|
194 | S WVBNEED=$$BNEED^WVUTL1(DFN,TEXTDATE)
|
---|
195 | S WVEDC=$$EDC^WVUTL1(DFN)
|
---|
196 | Q
|
---|