1 | WVPURP ;HIOFO/FT,JR-NOTIFICATION TABLES MAINTENANC; ;8/28/03 16:38
|
---|
2 | ;;1.0;WOMEN'S HEALTH;**4,9,16**;Sep 30, 1998
|
---|
3 | ;; Original routine created by IHS/ANMC/MWR
|
---|
4 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
---|
5 | ;; ADD/EDIT/PRINT NOTIFICATION PURPOSE FILE ENTRIES, EDIT PCD DAYS,
|
---|
6 | ;; EDIT NOTIFICATION TYPE SYNONYMS, ADD/EDIT NOTIFICATION OUTCOMES.
|
---|
7 | ;
|
---|
8 | ; This routine uses the following IAs:
|
---|
9 | ; #10089 - ^%ZISC call (supported)
|
---|
10 | ; #10103 - ^XLFDT calls (supported)
|
---|
11 | ; #10104 - ^XLFSTR calls (supported)
|
---|
12 | ;
|
---|
13 | PRINTPUR ; Called by option "WV PRINT NOTIF PURPOSE&LETTER"
|
---|
14 | D SETVARS^WVUTL5
|
---|
15 | D DEVICE
|
---|
16 | I WVPOP D KILL Q
|
---|
17 | PRINT ; Print purpose and letter entries
|
---|
18 | U IO
|
---|
19 | S WVNAME="",(WVPAGE,WVPOP)=0
|
---|
20 | S WVDATE=$$FMTE^XLFDT($$NOW^XLFDT(),"1P") ;current date/time
|
---|
21 | S WVDASH=$$REPEAT^XLFSTR("-",79) ;line of dashes
|
---|
22 | ; loop thru File 790.404 (B x-ref)
|
---|
23 | F S WVNAME=$O(^WV(790.404,"B",WVNAME)) Q:WVNAME=""!(WVPOP) S WVIEN=0 F S WVIEN=$O(^WV(790.404,"B",WVNAME,WVIEN)) Q:'WVIEN!(WVPOP) D
|
---|
24 | .S WVNODE=$G(^WV(790.404,WVIEN,0)) Q:WVNODE=""
|
---|
25 | .D HEADER
|
---|
26 | .D RESOLVE
|
---|
27 | .W !!?3,"PURPOSE: "_$P(WVNODE,U,1),?55,"SYNONYM: "_$P(WVNODE,U,3)
|
---|
28 | .W !?2,"PRIORITY: "_$G(WVARRAY(790.404,WVIEN_",",.02,"E")),?56,"ACTIVE: "_$G(WVARRAY(790.404,WVIEN_",",.04,"E"))
|
---|
29 | .W !?2,"BR or CX: "_$G(WVARRAY(790.404,WVIEN_",",.05,"E"))
|
---|
30 | .W !?4,"LETTER: "_$G(WVARRAY(790.404,WVIEN_",",.06,"E"))
|
---|
31 | .W !,"BR TX NEED: "_$G(WVARRAY(790.404,WVIEN_",",.07,"E"))
|
---|
32 | .S WVDUE=$$DMY($G(WVARRAY(790.404,WVIEN_",",.08,"E")))
|
---|
33 | .W ?48,"BR TX DUE DATE: "_WVDUE
|
---|
34 | .W !,"CX TX NEED: "_$G(WVARRAY(790.404,WVIEN_",",.09,"E"))
|
---|
35 | .S WVDUE=$$DMY($G(WVARRAY(790.404,WVIEN_",",.1,"E")))
|
---|
36 | .W ?48,"CX TX DUE DATE: "_WVDUE,!!
|
---|
37 | .S WVLINE=0
|
---|
38 | .F S WVLINE=$O(^WV(790.404,WVIEN,1,WVLINE)) Q:'WVLINE!(WVPOP) D
|
---|
39 | ..I ($Y+4)>IOSL D:$E(IOST)="C" DIRZ^WVUTL3 Q:WVPOP D HEADER
|
---|
40 | ..W !,$G(^WV(790.404,WVIEN,1,WVLINE,0))
|
---|
41 | ..Q
|
---|
42 | .Q:WVPOP
|
---|
43 | .I $E(IOST)="C" D DIRZ^WVUTL3
|
---|
44 | .Q
|
---|
45 | I $D(ZTQUEUED) S ZTREQ="@"
|
---|
46 | KILL ; Kill variables
|
---|
47 | K WVARRAY,WVDASH,WVDATE,WVDUE,WVIEN,WVLINE
|
---|
48 | K WVNAME,WVNODE,WVPAGE,WVPOP,X,Y
|
---|
49 | D ^%ZISC
|
---|
50 | Q
|
---|
51 | HEADER ; Report header
|
---|
52 | W:$Y>0 @IOF
|
---|
53 | S WVPAGE=WVPAGE+1
|
---|
54 | W "NOTIFICATION PURPOSE & LETTER LIST",?45,WVDATE,?70,"PAGE: "_WVPAGE
|
---|
55 | W !,WVDASH
|
---|
56 | Q
|
---|
57 | RESOLVE ; Resolve data to external values
|
---|
58 | K WVARRAY
|
---|
59 | D CLEAN^DILF
|
---|
60 | D GETS^DIQ(790.404,WVIEN_",",".02;.04:.1","E","WVARRAY")
|
---|
61 | Q
|
---|
62 | DEVICE ; Get device and possibly queue to taskman
|
---|
63 | N ZTRTN
|
---|
64 | S ZTRTN="DEQUEUE^WVPURP"
|
---|
65 | D ZIS^WVUTL2(.WVPOP,1,"HOME")
|
---|
66 | Q
|
---|
67 | DEQUEUE ; Taskman queue of printout
|
---|
68 | D PRINT
|
---|
69 | Q
|
---|
70 | ;
|
---|
71 | EDITPUR ;EP
|
---|
72 | ;---> CALLED BY OPTION "WV EDIT NOTIF PURPOSE&LETTER".
|
---|
73 | D SETVARS^WVUTL5
|
---|
74 | ;---> DISPLAY MENU TITLE FROM WV MENU OPTIONS.
|
---|
75 | F D Q:$G(Y)<0
|
---|
76 | .D TITLE^WVUTL5("EDIT NOTIFICATION PURPOSE & LETTER FILE")
|
---|
77 | .D DIC^WVFMAN(790.404,"QEMAL",.Y)
|
---|
78 | .Q:Y<0
|
---|
79 | .S DA=+Y
|
---|
80 | .D:$P(Y,U,3) ADDLET
|
---|
81 | .D:'$P(Y,U,3) REPLACE
|
---|
82 | .Q:WVPOP
|
---|
83 | .;---> EDIT WITH SCREENMAN.
|
---|
84 | .S DR="[WV NOTIFPURPOSE-FORM-1]"
|
---|
85 | .D DDS^WVFMAN(790.404,DR,DA,"","",.WVPOP)
|
---|
86 | D KILLALL^WVUTL8
|
---|
87 | Q
|
---|
88 | ;
|
---|
89 | ;
|
---|
90 | ADDLET ;EP
|
---|
91 | ;---> CALLED BY OPTION "WV ADD NOTIF PURPOSE&LETTER".
|
---|
92 | K ^WV(790.404,DA,1)
|
---|
93 | N N S N=0
|
---|
94 | F S N=$O(^WV(790.6,1,1,N)) Q:'N D
|
---|
95 | .S ^WV(790.404,DA,1,N,0)=^WV(790.6,1,1,N,0)
|
---|
96 | S ^WV(790.404,DA,1,0)=^WV(790.6,1,1,0)
|
---|
97 | Q
|
---|
98 | ;
|
---|
99 | REPLACE ;EP
|
---|
100 | ;---> REPLACE OLD LETTER FOR THIS NOTIF PURPOSE WITH GENERIC SAMPLE.
|
---|
101 | N DIR,DIRUT,Y
|
---|
102 | W !!?3,"Do you wish to delete the old letter for this Purpose of "
|
---|
103 | W "Notification",!?3,"and replace it with the generic sample letter?"
|
---|
104 | S DIR(0)="YA",DIR("B")="NO"
|
---|
105 | S DIR("A")=" Enter Yes or No: " D HELP1
|
---|
106 | D ^DIR W !
|
---|
107 | S:$D(DIRUT) WVPOP=1
|
---|
108 | I Y D ADDLET
|
---|
109 | Q
|
---|
110 | ;
|
---|
111 | HELP1 ;EP
|
---|
112 | ;;Enter YES to delete the old letter for this Purpose of Notification
|
---|
113 | ;;and to begin with a fresh copy of the generic sample letter.
|
---|
114 | S WVTAB=5,WVLINL="HELP1" D HELPTX
|
---|
115 | Q
|
---|
116 | ;
|
---|
117 | HELPTX ;EP
|
---|
118 | N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
|
---|
119 | F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" S DIR("?",I)=T_$P(X,";;",2)
|
---|
120 | S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
|
---|
121 | Q
|
---|
122 | ;
|
---|
123 | TYPE ;EP
|
---|
124 | ;---> EDIT SYNONYMS FOR NOTIFICATION TYPES.
|
---|
125 | D SETVARS^WVUTL5
|
---|
126 | F D Q:$G(Y)<0
|
---|
127 | .D TITLE^WVUTL5("EDIT SYNONYMS FOR NOTIFICATION TYPES") D TEXT1
|
---|
128 | .N A S A=" Select NOTIFICATION TYPE: "
|
---|
129 | .D DIC^WVFMAN(790.403,"QEMA",.Y,A)
|
---|
130 | .Q:Y<0
|
---|
131 | .D DIE^WVFMAN(790.403,.03,+Y,.WVPOP)
|
---|
132 | W @IOF
|
---|
133 | D KILLALL^WVUTL8
|
---|
134 | Q
|
---|
135 | ;
|
---|
136 | OUTCOME ;EP
|
---|
137 | ;---> ADD/EDIT NOTIFICATION OUTCOME FILE.
|
---|
138 | D SETVARS^WVUTL5
|
---|
139 | F D Q:$G(Y)<0
|
---|
140 | .D TITLE^WVUTL5("ADD/EDIT NOTIFICATION OUTCOME FILE")
|
---|
141 | .D DIC^WVFMAN(790.405,"QEMAL",.Y," Select OUTCOME: ")
|
---|
142 | .Q:Y<0
|
---|
143 | .D DIE^WVFMAN(790.405,.02,+Y,.WVPOP)
|
---|
144 | W @IOF
|
---|
145 | D KILLALL^WVUTL8
|
---|
146 | Q
|
---|
147 | ;
|
---|
148 | TEXT1 ;EP
|
---|
149 | ;;You may enter a synonym for each Notification Type. The synonym will
|
---|
150 | ;;allow the Notification Type to be called up by typing only a few
|
---|
151 | ;;characters. Synonyms should be unique and less than 4 characters.
|
---|
152 | ;;
|
---|
153 | ;;For example, "L1" might be used for LETTER,FIRST; "L2" for
|
---|
154 | ;;LETTER,SECOND; "L3" for LETTER,THIRD, and so on.
|
---|
155 | ;;
|
---|
156 | ;;
|
---|
157 | S WVTAB=5,WVLINL="TEXT1" D PRINTX
|
---|
158 | Q
|
---|
159 | ;
|
---|
160 | PRINTX ;EP
|
---|
161 | N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
|
---|
162 | F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
|
---|
163 | Q
|
---|
164 | ;
|
---|
165 | GENSTUFF ;EP
|
---|
166 | ;---> STUFF THE GENERIC SAMPLE LETTER INTO ALL PURPOSES OF NOTIF.
|
---|
167 | N DA
|
---|
168 | S DA=0
|
---|
169 | F S DA=$O(^WV(790.404,DA)) Q:'DA W !,DA D ADDLET^WVPURP
|
---|
170 | Q
|
---|
171 | DMY(WVDUE) ; Spell out Days, Months or Years
|
---|
172 | N WVDUE1,WVDUE2
|
---|
173 | I WVDUE="" Q ""
|
---|
174 | I '$S(WVDUE["D":1,WVDUE["M":1,WVDUE["Y":1,1:0) Q WVDUE
|
---|
175 | S WVDUE1=+WVDUE
|
---|
176 | S WVDUE2=$S(WVDUE["D":"Day",WVDUE["M":"Month",WVDUE["Y":"Year",1:"")
|
---|
177 | S:WVDUE1>1 WVDUE2=WVDUE2_"s"
|
---|
178 | S:WVDUE2="s" WVDUE2=""
|
---|
179 | S WVDUE=WVDUE1_" "_WVDUE2
|
---|
180 | Q WVDUE
|
---|
181 | ;
|
---|
182 | DMYCHECK ; Called from ^DD(790.404,.8,0) - BR TX DUE DATE
|
---|
183 | ; and ^DD(790.404,.1,0) - CX TX DUE DATE
|
---|
184 | ; Check X to see if it is a date offset (e.g., 365D, 12M or 1Y).
|
---|
185 | ; Returns -1 if not an exceptable value
|
---|
186 | Q:'$D(X)
|
---|
187 | I $L(X)>4!($L(X)<2) S X=-1 Q
|
---|
188 | S X=$$UP^XLFSTR(X)
|
---|
189 | I X'?1.3N1"D",X'?1.3N1"M",X'?1.3N1"Y" S X=-1
|
---|
190 | Q
|
---|