source: WorldVistAEHR/trunk/r/WOMENS_HEALTH-WV/WVLETPR.m@ 1042

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

initial load of WorldVistAEHR

File size: 6.1 KB
Line 
1WVLETPR ;HCIOFO/FT,JR-WV PRINT LETTERS. ;1/10/00 16:45
2 ;;1.0;WOMEN'S HEALTH;**7,9**;Sep 30, 1998
3 ;; Original routine created by IHS/ANMC/MWR
4 ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
5 ;; CALLED BY OPTION: "WV PRINT INDIVIDUAL LETTERS" TO PRINT A
6 ;; LETTER FOR A SINGLE INDIVIDUAL (AS OPPOSED TO ALL THOSE QUEUED).
7 ;
8 D SETVARS^WVUTL5 S (WVPOP1,WVPOP)=0
9 N WVDA,WVTITLE
10 F S WVPOP=0 D Q:WVPOP1
11 .D SELECT Q:WVPOP
12 .D DEVICE Q:WVPOP
13 .S WVCRT=$S($E(IOST)="C":1,1:0)
14 .D PRINT
15 D ^%ZISC
16 ;
17EXIT ;EP
18 D KILLALL^WVUTL8
19 Q
20 ;
21SELECT ;EP
22 ;---> SELECT PATIENT, THEN SELECT NOTIFICATION.
23 N DIC,X,Y
24 D TITLE^WVUTL5("PRINT INDIVIDUAL PATIENT LETTERS")
25 D PATLKUP^WVUTL8(.Y)
26 I Y<0 S (WVPOP,WVPOP1)=1 Q
27 S WVDFN=+Y,X=$$NAME^WVUTL1(WVDFN)
28 D DIC^WVFMAN(790.4,"EM",.Y,"","","",X,.WVPOP)
29 I $D(DUOUT)!($D(DTOUT)) S WVPOP=1 Q
30 I Y<0 D NONE S WVPOP=1 Q
31 S WVDA=+Y
32 ;
33 ;---> IF FACILITIES OF LETTER AND USER DON'T MATCH, QUIT.
34 N WVFACIL S WVFACIL=$P(^WV(790.4,WVDA,0),U,7)
35 I ((WVFACIL'=DUZ(2))&(WVFACIL)) D TEXT1,DIRZ^WVUTL3 S WVPOP=1 Q
36 ;
37 S WVPURP=$P(^WV(790.4,WVDA,0),U,4)
38 S WVTYPE=$P(^WV(790.4,WVDA,0),U,3)
39 ;
40 ;---> CHECK IF PURPOSE HAS BEEN ENTERED.
41 I 'WVPURP D Q
42 .W !!?5,"No Purpose has been entered for this Notification."
43 .D DIRZ^WVUTL3 S WVPOP=1 Q
44 ;
45 ;---> CHECK IF THIS PURPOSE OF NOTIFICATION HAS A LETTER.
46 I '$D(^WV(790.404,WVPURP,1,0)) D Q
47 .W !!!?5,"No letter has been entered for this Purpose of Notification."
48 .W !?5,"Programmer information: Notification=^WV(790.4,"_WVDA_",0)."
49 .W !?5," Purpose IEN=",WVPURP
50 .W !?5," Patient IEN=",WVDFN
51 .D DIRZ^WVUTL3 S WVPOP=1 Q
52 ;
53 ;---> CHECK IF TYPE OF NOTIFICATION FOR THIS NOTIFICATION IS PRINTABLE.
54 I 'WVTYPE D CANTPRT Q
55 I '$P(^WV(790.403,WVTYPE,0),U,2) D CANTPRT Q
56 Q
57 ;
58CANTPRT ;EP
59 ;---> CAN'T PRINT THIS NOTIFICATION.
60 W !!?5,"This Type of Notification"
61 W:WVTYPE ", ",$P(^WV(790.403,WVTYPE,0),U),"," W " is not printable."
62 D DIRZ^WVUTL3 S WVPOP=1
63 Q
64 ;
65DEVICE ;EP
66 ;---> GET DEVICE AND POSSIBLY QUEUE TO TASKMAN.
67 K %ZIS,IOP
68 S ZTRTN="PRINT^WVLETPR",ZTSAVE("WVDA")=""
69 D ZIS^WVUTL2(.WVPOP,1)
70 Q
71 ;
72PRINT ;EP
73 ;---> REQUIRED VARIABLE: WVDA=IEN IN ^WV(790.4, ION=DEVICE
74 ;---> NEXT LINE: IOP WILL INHIBIT ^DIWF FROM PROMPTING FOR DEVICE.
75 D SETVARS^WVUTL5
76 N WVDFN,WVPURP,IOP
77 S IOP=ION
78 ;---> IF FACILITIES OF LETTER AND USER DON'T MATCH, QUIT (IF NULL, OK).
79 N WVFACIL S WVFACIL=$P(^WV(790.4,WVDA,0),U,7)
80 I ((WVFACIL'=DUZ(2))&(WVFACIL)) D TEXT1 H 5 S WVPOP=1 Q
81 ;
82 S WVDFN=$P(^WV(790.4,WVDA,0),U)
83 S WVPURP=$P(^WV(790.4,WVDA,0),U,4)
84 ;---> WVN=DATE OF "PRINT DATE", USE TO KILL "APRT" XREF BELOW.
85 S:'$D(WVKDT) WVKDT=$P(^WV(790.4,WVDA,0),U,11)
86 ;---> IF NO PURPOSE (DELETED), KILL "APRT" XREF AND QUIT.
87 I 'WVPURP D Q
88 .W !!?5,"No Purpose of Notification has been chosen; therefore, this"
89 .W !?5,"notification cannot be printed."
90 .D KILLXREF(WVDA,WVKDT)
91 ;---> IF QUEUED AND WVCRT IS NOT SET, THEN SET IT.
92 S:'$D(WVCRT) WVCRT=$S($E(IOST)="C":1,1:0)
93 S DIWF="^WV(790.404,WVPURP,1,"
94 S DIWF(1)=790
95 S BY="INTERNAL(#.01)="_WVDFN
96 ;---> IF LOCKED, PROMPT DEVICE, QUIT AND LEAVE IN THE QUEUE.
97 L +^WV(790.4,WVDA):0 I '$T U IO D D PROMPT Q
98 .W !!?5,"The selected Notification is being edited by another user."
99 .W !?5,"Programmer information: Notification=^WV(790.4,"_WVDA_",0)."
100 .W:'WVCRT @IOF
101 ;
102 ;---> IF PATIENT IS DECEASED, DON'T PRINT LETTER; PRINT EXPLANATION,
103 ;---> CHANGE THE STATUS OF THE NOTIFICATION TO "CLOSED", AND GIVE
104 ;---> THE OUTCOME OF "PATIENT DECEASED".
105 I $$DECEASED^WVUTL1(WVDFN) D DECEASED Q
106 ;---> Compute future appointments
107 D KAPPT^WVUTL9(WVDFN) ;kill off old computed appts.
108 D GAPPT^WVUTL9(WVDFN) ;get future appts
109 D SAPPT^WVUTL9(WVDFN) ;set appts in File 790
110 D KILLUG^WVUTL9 ;kill off Utility global off future appts
111 D KADD^WVUTL9(WVDFN) ;kill off old computed address
112 D GADD^WVUTL9(WVDFN) ;get current complete address
113 D SADD^WVUTL9(WVDFN) ;set complete address in File 790
114 D KVAR^WVUTL9 ;clean-up VADPT variables used
115 ;---> PRINT IT TO IOP, PRESERVE WVPOP.
116 D EN2^DIWF
117 D PROMPT
118 ;---> DON'T STUFF "DATE PRINTED" IF IT ALREADY HAS A "DATE PRINTED".
119 I $P(^WV(790.4,WVDA,0),U,10)]"" D KILLXREF(WVDA,WVKDT) L -^WV(790.4,WVDA) Q
120 ;
121 ;---> DON'T STUFF "DATE PRINTED" IF IT'S JUST TO THE SCREEN.
122 I WVCRT D Q
123 .W !!?3,"NOTE: Because this letter was only displayed on a screen and"
124 .W !?9,"not printed on a printer, it will NOT yet be logged by the"
125 .W !?9,"program as having been ""PRINTED"".",!
126 .L -^WV(790.4,WVDA) D DIRZ^WVUTL3
127 ;
128 ;---> NEXT LINES KILL "APRT" XREF AND SET "DATE PRINTED"=TODAY.
129 ;---> ("APRT" XREF INDICATE A NOTIFICATION IS QUEUED TO BE PRINTED.)
130 D KILLXREF(WVDA,WVKDT)
131 D DIE^WVFMAN(790.4,".1////"_DT,WVDA)
132 L -^WV(790.4,WVDA) Q
133 Q
134 ;
135KILLXREF(WVDA,WVKDT) ;EP
136 ;---> KILL "APRT" XREF (REMOVE LETTER FROM QUEUE).
137 Q:'$G(WVDA) Q:'$G(WVKDT)
138 K ^WV(790.4,"APRT",WVKDT,WVDA)
139 Q
140 ;
141DECEASED ;EP
142 ;---> IF THE PATIENT IS DECEASED.
143 ;---> DON'T STUFF "DATE PRINTED" IF IT'S JUST TO THE SCREEN.
144 W !!?3,"NOTE: Because this patient, ",$$NAME^WVUTL1(WVDFN)," #"
145 W $$SSN^WVUTL1(WVDFN),", is now"
146 W !?9,"registered as deceased, the letter will NOT be printed."
147 W !?9,"Instead, this notification will be given a status of CLOSED"
148 W !?9,"and an outcome of ""Patient Deceased""."
149 D:WVCRT&('$D(IO("S"))) DIRZ^WVUTL3
150 W:'WVCRT @IOF
151 S DR=".14////c;.05///Patient Deceased"
152 D DIE^WVFMAN(790.4,DR,WVDA)
153 ;---> KILL "APRT" XREF (FLAGS NOTIFICATION AS QUEUED TO BE PRINTED).
154 D KILLXREF(WVDA,WVKDT)
155 L -^WV(790.4,WVDA)
156 Q
157 ;
158PROMPT ;EP
159 ;---> PROMPT IF NECESSARY, PROMPT DEVICE.
160 D:WVCRT DIRZ^WVUTL3
161 Q
162 ;
163NONE ;EP
164 S WVTITLE="* No letters selected for printing. *"
165 D CENTERT^WVUTL5(.WVTITLE)
166 W !!!!,WVTITLE,!!
167 D DIRZ^WVUTL3
168 Q
169 ;
170TEXT1 ;EP
171 ;;
172 ;;* NOTE: The Facility with which this letter is associated does not
173 ;; match the Facility under which you are currently logged on.
174 ;; To print this Notification, you must either edit the Facility
175 ;; for this Notification, or log off and log back in under the
176 ;; same Facility with which the Notification is associated.
177 S WVTAB=5,WVLINL="TEXT1" D PRINTX
178 Q
179 ;
180PRINTX ;EP
181 N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
182 F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
183 Q
Note: See TracBrowser for help on using the repository browser.