source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVUTL3.m

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

initial load of WorldVistAEHR

File size: 6.2 KB
Line 
1WVUTL3 ;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 ;
8OUT ;EP
9 ;---> CALLED AFTER ERROR MESSAGES ARE DISPLAYED.
10 S WVPOP=1 D DIRZ
11 Q
12 ;
13ASKDATES(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 ;
44LOCKED ;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 ;
50LOCKEDE ;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 ;
57LOCKEDP ;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 ;
65DIRZ ;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 ;
76DIRPRMT ;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 ;
92STOREDC ;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 ;
119DELETEDC ;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 ;
127STORPAP ;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 ;
152PCDVARS(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 ;
181PATVARS(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
Note: See TracBrowser for help on using the repository browser.