1 | WVNOTIF ;HCIOFO/FT,JR-WV ADD/EDIT WV NOTIFICATIONS; ;6/10/99 17:14
|
---|
2 | ;;1.0;WOMEN'S HEALTH;**7**;Sep 30, 1998
|
---|
3 | ;; Original routine created by IHS/ANMC/MWR
|
---|
4 | ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
|
---|
5 | ;; CALLED BY DIFFERENT OPTIONS TO ADD/EDIT NOTIFICATIONS.
|
---|
6 | ;
|
---|
7 | ADD ;EP
|
---|
8 | ;---> CALLED BY OPTION: "WV ADD A NEW NOTIFICATION".
|
---|
9 | D SETVARS^WVUTL5
|
---|
10 | D TITLE^WVUTL5("ADD NEW NOTIFICATION")
|
---|
11 | D PATLKUP^WVUTL8(.Y)
|
---|
12 | D:Y>0 NEW(+Y)
|
---|
13 | D EXIT
|
---|
14 | Q
|
---|
15 | ;
|
---|
16 | ;
|
---|
17 | EDIT ;EP
|
---|
18 | ;---> CALLED BY OPTION: "WV EDIT NOTIFICATION".
|
---|
19 | ;---> EDIT AN EXISTING NOTIFICATION.
|
---|
20 | N WVENFLAG S WVENFLAG=0
|
---|
21 | F Q:WVENFLAG<0 D EDIT1
|
---|
22 | Q
|
---|
23 | EDIT1 ;
|
---|
24 | D SETVARS^WVUTL5
|
---|
25 | N WVDICB,Y
|
---|
26 | D TITLE^WVUTL5("EDIT A NOTIFICATION")
|
---|
27 | S WVDICB=+$G(^DISV(DUZ,"^WV(790.4,"))
|
---|
28 | S WVDICB=$S(WVDICB>0:$$GET1^DIQ(2,+$P($G(^WV(790.4,WVDICB,0)),U),.01,"E"),1:"")
|
---|
29 | I WVDICB="" D DIC^WVFMAN(790.4,"QEMA",.Y," Select PATIENT: ")
|
---|
30 | I WVDICB]"" D DIC^WVFMAN(790.4,"QEMA",.Y," Select PATIENT: ",WVDICB)
|
---|
31 | I Y<0 D EXIT S WVENFLAG=-1 Q
|
---|
32 | D EDIT2(+Y),EXIT
|
---|
33 | Q
|
---|
34 | ;
|
---|
35 | EXIT ;EP
|
---|
36 | D KILLALL^WVUTL8
|
---|
37 | Q
|
---|
38 | ;
|
---|
39 | ;
|
---|
40 | NEW(WVDFN,WVACCN) ;EP
|
---|
41 | ;---> STUFF NEW ENTRY IN WV NOTIFICATION FILE, .01=DFN.
|
---|
42 | ;---> REQUIRED VARIABLE: WVDFN=IEN OF WV PATIENT, FILE 790.
|
---|
43 | ;---> OPTIONAL VARIABLE: WVACCN=ACCESSION# FOR PROCEDURE.
|
---|
44 | I $$DECEASED^WVUTL1(WVDFN) D Q
|
---|
45 | .W !!?5,"This patient is registered as deceased." D DIRZ^WVUTL3
|
---|
46 | N DA,DIC,X
|
---|
47 | S X=WVDFN K DD,DO
|
---|
48 | S DIC="^WV(790.4,",DIC(0)="ML",DLAYGO=790
|
---|
49 | S DIC("DR")=".02///T;.06///"_$S($D(WVACCN):$P(WVACCN,","),1:"")
|
---|
50 | S DIC("DR")=DIC("DR")_";.07////"_$G(DUZ(2))
|
---|
51 | D FILE^DICN K DD,DO,DIC
|
---|
52 | ;---> IF Y<0, CHECK PERMISSIONS.
|
---|
53 | I Y<0 D ERROR1 Q
|
---|
54 | D EDIT2(+Y)
|
---|
55 | Q
|
---|
56 | ;
|
---|
57 | ;
|
---|
58 | EDIT2(DA) ;EP - FROM WVBRNOT2
|
---|
59 | ;---> REQUIRED VARIABLES: DA=IEN IN ^WV(790.4,.
|
---|
60 | N WVDA D SETVARS^WVUTL5
|
---|
61 | S WVDFN=$P(^WV(790.4,DA,0),U)
|
---|
62 | D SCREEN(DA,WVDFN,.WVPOP)
|
---|
63 | Q:WVPOP
|
---|
64 | I $G(DA) S WVDA=DA D PRINTNOW
|
---|
65 | ;---> OPPORTUNITY TO EDIT PATIENT'S CASE DATA.
|
---|
66 | ;---> IF $D(WVLOOP), NEW (ABOVE) WAS CALLED FROM CASEDATA^WVPATE,
|
---|
67 | ;---> SO DON'T LOOP THROUGH AGAIN.
|
---|
68 | D:'$D(WVLOOP) CASEDATA^WVPATE(WVDFN)
|
---|
69 | Q
|
---|
70 | ;
|
---|
71 | ;
|
---|
72 | SCREEN(DA,WVDFN,WVPOP) ;EP
|
---|
73 | ;---> EDIT WITH SCREENMAN.
|
---|
74 | ;---> NEEDS WVDFN FOR SCREEN ON ACCESSION# FIELD LOOKUP.
|
---|
75 | S DDSFILE=790.4,DR="[WV NOTIF-FORM-1]",WVPOP=0
|
---|
76 | ;---> IF THIS NOTIFICATION HAS ALREADY BEEN PRINTED, THEN DISALLOW
|
---|
77 | ;---> THE USER TO EDIT MOST FIELDS BY USING FORM-2 BELOW.
|
---|
78 | S:$P(^WV(790.4,DA,0),U,10) DR="[WV NOTIF-FORM-2]"
|
---|
79 | D DDS^WVFMAN(DDSFILE,DR,DA,"","",.WVPOP)
|
---|
80 | Q
|
---|
81 | ;
|
---|
82 | ;
|
---|
83 | PRINTNOW ;EP
|
---|
84 | ;---> PRINT OR VIEW NOTIFICATION NOW, IF IT'S A LETTER.
|
---|
85 | ;---> REQUIRED VARIABLE: WVDA=IEN IN ^WV(790.4,
|
---|
86 | Q:'$D(WVDA)
|
---|
87 | ;---> QUIT IF THIS NOTIFICATION DOES NOT HAVE A "TYPE OF NOTIFICATION".
|
---|
88 | Q:'$P(^WV(790.4,WVDA,0),U,3)
|
---|
89 | ;---> QUIT IF TYPE OF NOTIFICATION IS NOT PRINTABLE.
|
---|
90 | Q:'$P(^WV(790.403,$P(^WV(790.4,WVDA,0),U,3),0),U,2)
|
---|
91 | ;---> QUIT IF THIS NOTIFICATION HAS ALREADY BEEN PRINTED.
|
---|
92 | ;Q:$P(^WV(790.4,WVDA,0),U,10) ;DISABLED FOR NOW, ALLOW VIEW OR REPRINT.
|
---|
93 | F D Q:WVPOP Q:$P(^WV(790.4,WVDA,0),U,10)
|
---|
94 | .N WVCRT,DA,DIR
|
---|
95 | .N WVPRMT,WVPRMT1,WVPRMT2,WVPRMTQ
|
---|
96 | .W !!,"Do you wish to PREVIEW or PRINT this letter now?"
|
---|
97 | .S DIR(0)="Y",DIR("B")="NO" D HELP2
|
---|
98 | .D ^DIR K DIR W !
|
---|
99 | .I $D(DIRUT)!(Y<1) S WVPOP=1 Q
|
---|
100 | .;---> QUIT IF NOT ASSOCIATED WITH THE USER'S CURRENT FACILITY.
|
---|
101 | .N WVFACIL S WVFACIL=$P(^WV(790.4,WVDA,0),U,7)
|
---|
102 | .I ((WVFACIL'=DUZ(2))&(WVFACIL)) D S WVPOP=1 Q
|
---|
103 | ..D TEXT1^WVLETPR,DIRZ^WVUTL3
|
---|
104 | .I Y D DEVICE^WVLETPR Q:WVPOP D PRINT^WVLETPR
|
---|
105 | Q
|
---|
106 | ;
|
---|
107 | ERROR1 ;EP
|
---|
108 | W !!?10,*7,"NEW NOTIFICATION ENTRY FOR THIS PATIENT FAILED."
|
---|
109 | D DIRZ^WVUTL3
|
---|
110 | Q
|
---|
111 | ;
|
---|
112 | ADDNOTIF ;EP
|
---|
113 | ;---> ADD NEW NOTIFICATION.
|
---|
114 | ;---> AT PRESENT THIS EP IS NOT CALLED BY ANTHING.
|
---|
115 | W !,"Do you wish to add a NEW Notification for this patient?"
|
---|
116 | S DIR(0)="Y",DIR("B")="NO" D HELP1
|
---|
117 | D ^DIR K DIR W !
|
---|
118 | I Y D
|
---|
119 | .N WVLOOP,DIC,DIE,Y
|
---|
120 | .S Y=WVDFN,WVLOOP=1 D NEW(WVDFN)
|
---|
121 | Q
|
---|
122 | ;
|
---|
123 | HELP1 ;EP
|
---|
124 | ;;Enter YES to add a NEW Notification for this patient. If the
|
---|
125 | ;;notification is a letter, the letter may be queued to print shortly
|
---|
126 | ;;before the patient's next appointment by selecting an appropriate
|
---|
127 | ;;"Print Date".
|
---|
128 | S WVTAB=5,WVLINL="HELP1" D HELPTX
|
---|
129 | Q
|
---|
130 | ;
|
---|
131 | HELP2 ;EP
|
---|
132 | ;;"Preview" allows you to look at the letter that has just been queued.
|
---|
133 | ;;To preview this letter, select HOME at the "DEVICE: " prompt.
|
---|
134 | ;;
|
---|
135 | ;;"Print" will print the letter now (regardless of its "Print Date")
|
---|
136 | ;;and remove it from the queue of letters waiting to print.
|
---|
137 | ;;To print this letter now, select a printer at the "DEVICE: " prompt.
|
---|
138 | S WVTAB=5,WVLINL="HELP2" D HELPTX
|
---|
139 | Q
|
---|
140 | ;
|
---|
141 | HELPTX ;EP
|
---|
142 | ;---> CREATES DIR ARRAY FOR DIR. REQUIRED VARIABLES: WVTAB,WVLINL.
|
---|
143 | N I,T,X S T=$$REPEAT^XLFSTR(" ",WVTAB)
|
---|
144 | F I=1:1 S X=$T(@WVLINL+I) Q:X'[";;" S DIR("?",I)=T_$P(X,";;",2)
|
---|
145 | S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
|
---|
146 | Q
|
---|