source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLREB.m@ 619

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

initial load of WorldVistAEHR
File size: 8.9 KB
Line 
1SDWLREB ;BP/ESW - EWL matched with Canceled and Rebooked Appointment by Clinic ; 11/16/05 1:16pm ; Compiled October 25, 2006 17:29:46
2 ;;5.3;Scheduling;**467,491**;Aug 13, 1993;Build 53
3 ;
4 ;SD*5.3*467 - Match canceled appointments in EWL entries
5 ;
6 Q
7REBOOK(DFN,SD,SC,RBFLG,SDTRB,SDCAN) ; rebook section
8 ;create appt TMP to check for rebooking
9 ;SD - appt date/time
10 ;SC - Hospital Location IEN
11 ;called by reference:
12 ; RBFLG - cancellation status from Appointment Multiple
13 ; Only if RBFLG="CCR" - canceled by clinic, rebooked
14 ; SDTRB - asked for scheduled Date/Time of Rebooked Appointment
15 ; SDCAN - asked for cancellation date/time
16 N SDARR,SCNT
17 S RBFLG=0,SDTRB="",SDCAN="NONE" ;initiate if not 'good' appointment
18 S SDARR(1)=SD_";"_SD
19 S SDARR(2)=SC
20 S SDARR(4)=DFN
21 S SDARR("FLDS")="1;2;3;24;25"
22 N SAPP S SAPP=$$SDAPI^SDAMA301(.SDARR) D
23 .N SDINST,SDFAC,SDINSTE
24 .Q:'$D(^TMP($J,"SDAMA301",DFN))
25 .N SDSTR S SDSTR=^TMP($J,"SDAMA301",DFN,SC,SD)
26 .N SDSTAT S SDSTAT=$P(SDSTR,U,3)
27 .K ^TMP($J,"SDAMA301",DFN,SC,SD)
28 .S RBFLG=$P(SDSTAT,";")
29 .S SDTRB=$P(SDSTR,U,24)
30 .S SDCAN=$P(SDSTR,U,25)
31 Q
32DISREB(DFN,SDTRB,SC) ;DISPOSITION REBOOK OR NOT
33 ; DFN - IEN of file #2 (Patient)
34 ; SDTRB - Scheduled Date/Time of Rebooked Appt
35 ; SC - Clinic IEN
36 ; Temporary ^TMP($J,"APPT" will be created with rebooked appt data
37 N SDARR,SCNT,SDDIV
38 S SDDIV=""
39 S SDARR(1)=SDTRB_";"_SDTRB
40 S SDARR(2)=SC
41 S SDARR(4)=DFN
42 S SDARR("FLDS")="1;2;3;4;10;13;14"
43 N SAPP S SAPP=$$SDAPI^SDAMA301(.SDARR) D
44 .N SDINST,SDFAC,SDINSTE
45 .Q:'$D(^TMP($J,"SDAMA301",DFN))
46 .K ^TMP($J,"APPT") S SCNT=1
47 .S ^TMP($J,"APPT",SCNT)=^TMP($J,"SDAMA301",DFN,SC,SDTRB)
48 .N SFAC S SFAC=$$CLIN^SDWLPE(SC) D ;SD/491
49 ..S SDINST=+SFAC,SDINSTE=$P(SFAC,U,3),SDFAC=$P(SFAC,U,2)
50 .S $P(^TMP($J,"APPT",SCNT),"^",15)=SDINST_";"_SDINSTE
51 .S $P(^TMP($J,"APPT",SCNT),"^",16)=SDFAC
52 .K ^TMP($J,"SDAMA301",DFN,SC,SDTRB)
53 Q
54OPENEWL(DFN,SDT,SC,SDREB,CEWL) ; SD*5.3*467 Open EWL entry if closed with appointment being canceled
55 ;SDT - appointment date/time
56 ;SC - appointment clinic IEN
57 ;SDREB - REBOOKING FLAG: 1 - cancel & rebook
58 ; 0 - cancel only
59 ;CEWL - counter, optionally passed by reference with initial value=0
60 N DH,IEN,STATUS,CLINIC,WLAPPT,WLSTAT,SDNAM,SDAPPT,SSN,SCN
61 K ^TMP("SDWLPL",$J),^TMP($J,"SDWLPL")
62 I '$D(CEWL) D
63 .I $D(^TMP("SDWLREB",$J)) S CEWL=$O(^TMP("SDWLREB",$J,""),-1)
64 .E S CEWL=0
65 S IEN="" F S IEN=$O(^SDWL(409.3,"B",DFN,IEN)) Q:IEN<1 D
66 .S STATUS="" S STATUS=$$GET1^DIQ(409.3,IEN_",",23,"I") IF STATUS="C" D
67 ..IF $G(^SDWL(409.3,IEN,"SDAPT")) D
68 ...S CLINIC=$$GET1^DIQ(409.3,IEN_",",13.2,"I"),WLAPPT=$$GET1^DIQ(409.3,IEN_",",13,"I")
69 ...IF CLINIC=SC&(WLAPPT=SDT) S WLSTAT=$$GET1^DIQ(409.3,IEN_",",21,"I") I WLSTAT="SA" D
70 ....N Y S Y=WLAPPT D DD^%DT S SDAPPT=Y
71 ....S SCN=$$GET1^DIQ(44,SC_",",.01),SCN=$E(SCN,1,20)
72 ....S SDNAM=$$GET1^DIQ(2,DFN_",",.01,"I"),SDNAM=$E(SDNAM,1,25),SSN=$$GET1^DIQ(2,DFN_",",.09,"I")
73 ....S SDFORM=$$FORM^SDFORM(SDNAM,23,SSN,12,SCN,24,SDAPPT,20)
74 ....S CEWL=CEWL+1 S ^TMP("SDWLREB",$J,CEWL)=SDFORM
75 ....N DIE,DA,DR
76 ....S DIE="^SDWL(409.3,",DA=IEN,DR="23////^S X=""O""" D ^DIE
77 ....S DR="13.8////^S X=""CC""" D ^DIE
78 ....S DR="29////^S X=""CA""" D ^DIE
79 ....S DR="19///@" D ^DIE
80 ....S DR="20///@" D ^DIE
81 ....S DR="21///@" D ^DIE
82 ....S DR="13///@;13.1////@;13.2///@;13.3///@;13.4///@;13.5///@;13.6///@;13.8///@;13.7///@" D ^DIE
83 ....I $D(^TMP("SDWLREB",$J)) I SDREB D ASKDISP(IEN)
84 I '$D(^TMP($J,"SDWLPL")) Q ; no closed EWL related entry
85 I SDREB D DISP
86 Q
87MESS ; SD*5.3*467 - send message with a list of opened EWL entries because of canceled appointments
88 S ^TMP("SDWLREB",$J,.01)="This message displays patients that had their EWL entry opened because of "
89 S ^TMP("SDWLREB",$J,.02)="their matching appointment being now 'CANCELED BY CLINIC'. Some of those "
90 S ^TMP("SDWLREB",$J,.03)="entries may be already closed again if new appointments were scheduled and "
91 S ^TMP("SDWLREB",$J,.04)="matched with those EWL entries. You may use 'SD WAIT LIST REOPEN ENTRIES' "
92 S ^TMP("SDWLREB",$J,.05)="to run report identifying the related EWL entries."
93 N SDFORM S SDFORM=$$FORM^SDFORM("PATIENT NAME",23,"SSN",12,"CLINIC",24,"DATE/TIME of APPT",20) D ;added
94 .S ^TMP("SDWLREB",$J,.06)=SDFORM
95 S ^TMP("SDWLREB",$J,.07)="-----------------------------------------------------------------------"
96 S ^TMP("SDWLREB",$J,.08)=""
97 N XMSUB,XMY,XMTEXT,XMDUZ
98 S XMSUB="EWL opened entries with appointments 'CANCELED BY CLINIC'."
99 S XMY("G.SD EWL BACKGROUND UPDATE")=""
100 S XMTEXT="^TMP(""SDWLREB"",$J,"
101 S XMDUZ="POSTMASTER"
102 D ^XMD K ^TMP("SDWLREB",$J)
103 Q
104ASKDISP(IEN) ;
105 ;IEN - pointer to 409.3 to get data and display
106 N SDDIS S SDDIS=0 ; flag indicating disposition
107 W ! N X,DIR,DENTER
108 Q:$$GET1^DIQ(409.3,IEN_",",23,"I")="C"
109 S ^TMP("SDWLPL",$J,IEN)=$G(^SDWL(409.3,IEN,0)) S DENTER="",DENTER=$P($G(^TMP("SDWLPL",$J,IEN)),"^",2)
110 S (WLTYPE,TYPE,WLTN,NUM)="",TYPE=$P($G(^TMP("SDWLPL",$J,IEN)),"^",5)
111 IF DENTER'=""&(TYPE'="") D
112 .IF TYPE=1 S WLTYPE="PCMM TEAM",NUM=$P($G(^TMP("SDWLPL",$J,IEN)),"^",6),WLTNI=$$GET1^DIQ(404.51,NUM_",",.01,"I"),WLTN=$$GET1^DIQ(404.51,NUM_",",.01)
113 .IF TYPE=2 S WLTYPE="PCMM POSITION",NUM=$P($G(^TMP("SDWLPL",$J,IEN)),"^",7),WLTNI=$$GET1^DIQ(404.57,NUM_",",.01,"I"),WLTN=$$GET1^DIQ(404.57,NUM_",",.01)
114 .IF TYPE=3 S WLTYPE="SERV/SPECIALTY",NUM=$P($G(^TMP("SDWLPL",$J,IEN)),"^",8),WLTNI=$$GET1^DIQ(409.31,NUM_",",.01,"I"),WLTN=$$GET1^DIQ(409.31,NUM_",",.01)
115 .IF TYPE=4 S WLTYPE="CLINIC",NUM=$P($G(^TMP("SDWLPL",$J,IEN)),"^",9),WLTNI=$$GET1^DIQ(409.32,NUM_",",.01,"I"),WLTN=$$GET1^DIQ(409.32,NUM_",",.01)
116 E Q
117 D SAVE(TYPE,WLTNI,IEN)
118 Q
119SAVE(TYPE,WLTNI,IEN) ;
120 ;TYPE - EWL type
121 ;WLTNI - TYPE related name the EWL entry is waiting for
122 ;IEN - pointer to 409.3
123 S REQBY=$P($G(^TMP("SDWLPL",$J,IEN)),"^",12)
124 S INST=$P($G(^TMP("SDWLPL",$J,IEN)),"^",3)
125 N DESIRED S DESIRED=$P($G(^TMP("SDWLPL",$J,IEN)),"^",16)
126 N NAME,SSN S NAME=$$GET1^DIQ(2,DFN_",",.01),SSN=$$GET1^DIQ(2,DFN_",",.09)
127 N SDBY S SDBY=$$GET1^DIQ(409.3,IEN_",",11),SDBY=$E(SDBY,1,3)
128 S NN=$O(^TMP($J,"SDWLPL",""),-1)+1
129 S ^TMP($J,"SDWLPL",NN)=IEN_U_WLTYPE_U_U_WLTN_U_INST_U_DENTER_U_SDBY_U_DESIRED
130 ;
131 N SPIEC S SPIEC=$S(TYPE=4:9,TYPE=3:10,TYPE=2:11,TYPE=1:12)
132 S $P(^TMP($J,"SDWLPL",NN),U,SPIEC)=WLTNI
133 K ^TMP("SDWLPL",$J,IEN)
134 Q
135DISP ;
136 W !,"EWL Entry has just been opened because of its matching appointment",!,"being canceled.",!!
137 N DIR S DIR("B")="YES" ; default to match and close rebooked appointments
138 S DIR("A")="Do you wish to close this EWL entry with Rebooked Appointment(Yes/No)",DIR(0)="Y"
139 W "Closing this entry will disposition it: SA - REMOVED/SCHEDULED-ASSIGNED",!,"with Rebooked Appointment.",!!
140 S DIR("?")="Y(ES) will disposition this EWL entry as 'SA' with just rebooked appointment."
141 D LIST ; disable displaying EWL entry per SRS.
142 W ! D ^DIR
143 N SDDIS S SDDIS=0 I Y S SDDIS=1
144 E Q
145 N SDWLDISP,SDWLDA,SDWLDFN,NUM
146 I SDDIS S SDWLDISP="SA",NUM="" F S NUM=$O(^TMP($J,"SDWLPL",NUM)) Q:NUM="" S REC=^TMP($J,"SDWLPL",NUM) D
147 .S SDWLDA=+REC N SDP,SDR D
148 .S DIE="^SDWL(409.3,",DA=SDWLDA,DR="21////^S X=SDWLDISP" D ^DIE
149 .S DR="19////^S X=DT" D ^DIE
150 .S DR="20////^S X=DUZ" D ^DIE
151 .S DR="23////^S X=""C""" D ^DIE
152 .;I SDWLDISP="SA" update with appointment data
153 .;get appointment data to file (for a particular appt #)
154 .I SDWLDISP="SA" N SDA D DATP^SDWLEVAL(1,.SDA) D
155 ..I $D(SDA) S DIE="^SDWL(409.3,",DA=SDWLDA D
156 ...S DR="13////"_SDA(1)_";13.1////"_DT_";13.2////"_SDA(2)_";13.3////"_SDA(15)_";13.4////"_SDA(13)_";13.5////"_SDA(14)_";13.6////"_SDA(16)_";13.8////"_SDA(3)_";13.7////"_DUZ
157 ...D ^DIE
158 .N SDWLSCL,SDWLSS,SDC
159 .S SDC=1
160 .S SDWLSCL=$P($G(^TMP($J,"SDWLPL",SDC)),U,9)
161 .S SDWLSS=$P($G(^TMP($J,"SDWLPL",SDC)),U,10)
162 .I SDWLSCL K:$D(^SDWL(409.3,"SC",SDWLSCL,SDWLDA)) ^SDWL(409.3,"SC",SDWLSCL,SDWLDA)
163 .S SDWLDFN=$P($G(^TMP($J,"APPT",1)),U,4)
164 .I SDWLSS,SDWLDFN K:$D(^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLDA)) ^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLDA)
165 Q
166LIST ;LIST
167 ;may be called if EWL entry display would be needed
168 S (REC,NUM)="" N SDPN
169 F S NUM=$O(^TMP($J,"SDWLPL",NUM)) Q:NUM="" S REC=^TMP($J,"SDWLPL",NUM) D
170 .S IEN=+REC N SDP,SDR D
171 ..S SDPN=$$GET1^DIQ(409.3,IEN_",",.01) W !,"Patient: ",SDPN
172 ..W !," EW List Type P Waiting for Institution Orig Date By Des. Date Reopen"
173 ..W !,"--------------------------------------------------------------------------"
174 ..S SDP=$E($$GET1^DIQ(409.3,IEN_",",10)) ;priority
175 ..S SDR=$$GET1^DIQ(409.3,IEN_",",29,"I") ;reopen reason
176 .N SDINS,SDIN S SDINS=$P(REC,"^",5) S SDIN=$$GET1^DIQ(4,SDINS_",",.01,"I")
177 .W !,NUM_". ",$E($P(REC,"^",2),1,12),?17,SDP,?21,$E($P(REC,U,4),1,13),?35,SDIN,?45,$$FMTE^XLFDT($P(REC,"^",6),8),?57,$P(REC,"^",7),?61,$$FMTE^XLFDT($P(REC,"^",8),8),?76,SDR
178 .N SDUP,SDLO
179 .S SDUP="ABCDEFGHIJKLMNOPRSTUWQXYzv",SDLO="abcdefghijklmnoprstuwqxyzv"
180 .N SMT S SMT=$$GET1^DIQ(409.3,IEN_",",25) I SMT'="" S SMT=$TR(SMT,SDUP,SDLO) W !?2,"Comment: ",SMT
181 .N SMO S SMO=$$GET1^DIQ(409.3,IEN_",",30) I SMO'="" S SMO=$TR(SMO,SDUP,SDLO) W !?2,"Reopen: ",SMO
182 K ANS1,NN,INST,SCODE,CLINIC,DENTER,REQBY,DESIRD,SCPRI
183 K CLINIC,WLTYPE,TYPE,WLTN,NUM,REC
184 Q
Note: See TracBrowser for help on using the repository browser.