Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLREB.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLREB.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLREB.m
r613 r623 1 SDWLREB ;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 7 REBOOK(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 32 DISREB(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 54 OPENEWL(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 87 MESS ; 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 104 ASKDISP(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 119 SAVE(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 135 DISP ; 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 166 LIST ;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 1 SDWLREB ;BP/ESW - EWL matched with Canceled and Rebooked Appointment by Clinic ; 11/16/05 1:16pm 2 ;;5.3;Scheduling;**467**;Aug 13, 1993 3 ; 4 ;SD*5.3*467 - Match canceled appointments in EWL entries 5 ; 6 Q 7 REBOOK(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 32 DISREB(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 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 .S SDINST=$$GET1^DIQ(44,SC_",",3,"I") ; get Institution 49 .S SDINSTE=$$GET1^DIQ(44,SC_",",3,"E") 50 .S SDFAC=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Station 51 .I SDFAC="" N SDDIV S SDDIV="" S SDDIV=$$GET1^DIQ(44,SC_",",3.5,"I") D 52 ..I SDDIV'="" S SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I") I SDINST'="" D 53 ...S SDFAC=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Station 54 ..I SDDIV="" S SDFAC=$P($$SITE^VASITE(,),"^",3) 55 .S $P(^TMP($J,"APPT",SCNT),"^",15)=SDINST_";"_SDINSTE 56 .S $P(^TMP($J,"APPT",SCNT),"^",16)=SDFAC 57 .K ^TMP($J,"SDAMA301",DFN,SC,SDTRB) 58 Q 59 OPENEWL(DFN,SDT,SC,SDREB,CEWL) ; SD*5.3*467 Open EWL entry if closed with appointment being canceled 60 ;SDT - appointment date/time 61 ;SC - appointment clinic IEN 62 ;SDREB - REBOOKING FLAG: 1 - cancel & rebook 63 ; 0 - cancel only 64 ;CEWL - counter, optionally passed by reference with initial value=0 65 N DH,IEN,STATUS,CLINIC,WLAPPT,WLSTAT,SDNAM,SDAPPT,SSN,SCN 66 K ^TMP("SDWLPL",$J),^TMP($J,"SDWLPL") 67 I '$D(CEWL) D 68 .I $D(^TMP("SDWLREB",$J)) S CEWL=$O(^TMP("SDWLREB",$J,""),-1) 69 .E S CEWL=0 70 S IEN="" F S IEN=$O(^SDWL(409.3,"B",DFN,IEN)) Q:IEN<1 D 71 .S STATUS="" S STATUS=$$GET1^DIQ(409.3,IEN_",",23,"I") IF STATUS="C" D 72 ..IF $G(^SDWL(409.3,IEN,"SDAPT")) D 73 ...S CLINIC=$$GET1^DIQ(409.3,IEN_",",13.2,"I"),WLAPPT=$$GET1^DIQ(409.3,IEN_",",13,"I") 74 ...IF CLINIC=SC&(WLAPPT=SDT) S WLSTAT=$$GET1^DIQ(409.3,IEN_",",21,"I") I WLSTAT="SA" D 75 ....N Y S Y=WLAPPT D DD^%DT S SDAPPT=Y 76 ....S SCN=$$GET1^DIQ(44,SC_",",.01),SCN=$E(SCN,1,20) 77 ....S SDNAM=$$GET1^DIQ(2,DFN_",",.01,"I"),SDNAM=$E(SDNAM,1,25),SSN=$$GET1^DIQ(2,DFN_",",.09,"I") 78 ....S SDFORM=$$FORM^SDFORM(SDNAM,23,SSN,12,SCN,24,SDAPPT,20) 79 ....S CEWL=CEWL+1 S ^TMP("SDWLREB",$J,CEWL)=SDFORM 80 ....N DIE,DA,DR 81 ....S DIE="^SDWL(409.3,",DA=IEN,DR="23////^S X=""O""" D ^DIE 82 ....S DR="13.8////^S X=""CC""" D ^DIE 83 ....S DR="29////^S X=""CA""" D ^DIE 84 ....S DR="19///@" D ^DIE 85 ....S DR="20///@" D ^DIE 86 ....S DR="21///@" D ^DIE 87 ....S DR="13///@;13.1////@;13.2///@;13.3///@;13.4///@;13.5///@;13.6///@;13.8///@;13.7///@" D ^DIE 88 ....I $D(^TMP("SDWLREB",$J)) I SDREB D ASKDISP(IEN) 89 I '$D(^TMP($J,"SDWLPL")) Q ; no closed EWL related entry 90 I SDREB D DISP 91 Q 92 MESS ; SD*5.3*467 - send message with a list of opened EWL entries because of canceled appointments 93 S ^TMP("SDWLREB",$J,.01)="This message displays patients that had their EWL entry opened because of " 94 S ^TMP("SDWLREB",$J,.02)="their matching appointment being now 'CANCELED BY CLINIC'. Some of those " 95 S ^TMP("SDWLREB",$J,.03)="entries may be already closed again if new appointments were scheduled and " 96 S ^TMP("SDWLREB",$J,.04)="matched with those EWL entries. You may use 'SD WAIT LIST REOPEN ENTRIES' " 97 S ^TMP("SDWLREB",$J,.05)="to run report identifying the related EWL entries." 98 N SDFORM S SDFORM=$$FORM^SDFORM("PATIENT NAME",23,"SSN",12,"CLINIC",24,"DATE/TIME of APPT",20) D ;added 99 .S ^TMP("SDWLREB",$J,.06)=SDFORM 100 S ^TMP("SDWLREB",$J,.07)="-----------------------------------------------------------------------" 101 S ^TMP("SDWLREB",$J,.08)="" 102 N XMSUB,XMY,XMTEXT,XMDUZ 103 S XMSUB="EWL opened entries with appointments 'CANCELED BY CLINIC'." 104 S XMY("G.SD EWL BACKGROUND UPDATE")="" 105 S XMTEXT="^TMP(""SDWLREB"",$J," 106 S XMDUZ="POSTMASTER" 107 D ^XMD K ^TMP("SDWLREB",$J) 108 Q 109 ASKDISP(IEN) ; 110 ;IEN - pointer to 409.3 to get data and display 111 N SDDIS S SDDIS=0 ; flag indicating disposition 112 W ! N X,DIR,DENTER 113 Q:$$GET1^DIQ(409.3,IEN_",",23,"I")="C" 114 S ^TMP("SDWLPL",$J,IEN)=$G(^SDWL(409.3,IEN,0)) S DENTER="",DENTER=$P($G(^TMP("SDWLPL",$J,IEN)),"^",2) 115 S (WLTYPE,TYPE,WLTN,NUM)="",TYPE=$P($G(^TMP("SDWLPL",$J,IEN)),"^",5) 116 IF DENTER'=""&(TYPE'="") D 117 .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) 118 .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) 119 .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) 120 .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) 121 E Q 122 D SAVE(TYPE,WLTNI,IEN) 123 Q 124 SAVE(TYPE,WLTNI,IEN) ; 125 ;TYPE - EWL type 126 ;WLTNI - TYPE related name the EWL entry is waiting for 127 ;IEN - pointer to 409.3 128 S REQBY=$P($G(^TMP("SDWLPL",$J,IEN)),"^",12) 129 S INST=$P($G(^TMP("SDWLPL",$J,IEN)),"^",3) 130 N DESIRED S DESIRED=$P($G(^TMP("SDWLPL",$J,IEN)),"^",16) 131 N NAME,SSN S NAME=$$GET1^DIQ(2,DFN_",",.01),SSN=$$GET1^DIQ(2,DFN_",",.09) 132 N SDBY S SDBY=$$GET1^DIQ(409.3,IEN_",",11),SDBY=$E(SDBY,1,3) 133 S NN=$O(^TMP($J,"SDWLPL",""),-1)+1 134 S ^TMP($J,"SDWLPL",NN)=IEN_U_WLTYPE_U_U_WLTN_U_INST_U_DENTER_U_SDBY_U_DESIRED 135 ; 136 N SPIEC S SPIEC=$S(TYPE=4:9,TYPE=3:10,TYPE=2:11,TYPE=1:12) 137 S $P(^TMP($J,"SDWLPL",NN),U,SPIEC)=WLTNI 138 K ^TMP("SDWLPL",$J,IEN) 139 Q 140 DISP ; 141 W !,"EWL Entry has just been opened because of its matching appointment",!,"being canceled.",!! 142 N DIR S DIR("B")="YES" ; default to match and close rebooked appointments 143 S DIR("A")="Do you wish to close this EWL entry with Rebooked Appointment(Yes/No)",DIR(0)="Y" 144 W "Closing this entry will disposition it: SA - REMOVED/SCHEDULED-ASSIGNED",!,"with Rebooked Appointment.",!! 145 S DIR("?")="Y(ES) will disposition this EWL entry as 'SA' with just rebooked appointment." 146 D LIST ; disable displaying EWL entry per SRS. 147 W ! D ^DIR 148 N SDDIS S SDDIS=0 I Y S SDDIS=1 149 E Q 150 N SDWLDISP,SDWLDA,SDWLDFN,NUM 151 I SDDIS S SDWLDISP="SA",NUM="" F S NUM=$O(^TMP($J,"SDWLPL",NUM)) Q:NUM="" S REC=^TMP($J,"SDWLPL",NUM) D 152 .S SDWLDA=+REC N SDP,SDR D 153 .S DIE="^SDWL(409.3,",DA=SDWLDA,DR="21////^S X=SDWLDISP" D ^DIE 154 .S DR="19////^S X=DT" D ^DIE 155 .S DR="20////^S X=DUZ" D ^DIE 156 .S DR="23////^S X=""C""" D ^DIE 157 .;I SDWLDISP="SA" update with appointment data 158 .;get appointment data to file (for a particular appt #) 159 .I SDWLDISP="SA" N SDA D DATP^SDWLEVAL(1,.SDA) D 160 ..I $D(SDA) S DIE="^SDWL(409.3,",DA=SDWLDA D 161 ...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 162 ...D ^DIE 163 .N SDWLSCL,SDWLSS,SDC 164 .S SDC=1 165 .S SDWLSCL=$P($G(^TMP($J,"SDWLPL",SDC)),U,9) 166 .S SDWLSS=$P($G(^TMP($J,"SDWLPL",SDC)),U,10) 167 .I SDWLSCL K:$D(^SDWL(409.3,"SC",SDWLSCL,SDWLDA)) ^SDWL(409.3,"SC",SDWLSCL,SDWLDA) 168 .S SDWLDFN=$P($G(^TMP($J,"APPT",1)),U,4) 169 .I SDWLSS,SDWLDFN K:$D(^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLDA)) ^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLDA) 170 Q 171 LIST ;LIST 172 ;may be called if EWL entry display would be needed 173 S (REC,NUM)="" N SDPN 174 F S NUM=$O(^TMP($J,"SDWLPL",NUM)) Q:NUM="" S REC=^TMP($J,"SDWLPL",NUM) D 175 .S IEN=+REC N SDP,SDR D 176 ..S SDPN=$$GET1^DIQ(409.3,IEN_",",.01) W !,"Patient: ",SDPN 177 ..W !," EW List Type P Waiting for Institution Orig Date By Des. Date Reopen" 178 ..W !,"--------------------------------------------------------------------------" 179 ..S SDP=$E($$GET1^DIQ(409.3,IEN_",",10)) ;priority 180 ..S SDR=$$GET1^DIQ(409.3,IEN_",",29,"I") ;reopen reason 181 .N SDINS,SDIN S SDINS=$P(REC,"^",5) S SDIN=$$GET1^DIQ(4,SDINS_",",.01,"I") 182 .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 183 .N SDUP,SDLO 184 .S SDUP="ABCDEFGHIJKLMNOPRSTUWQXYzv",SDLO="abcdefghijklmnoprstuwqxyzv" 185 .N SMT S SMT=$$GET1^DIQ(409.3,IEN_",",25) I SMT'="" S SMT=$TR(SMT,SDUP,SDLO) W !?2,"Comment: ",SMT 186 .N SMO S SMO=$$GET1^DIQ(409.3,IEN_",",30) I SMO'="" S SMO=$TR(SMO,SDUP,SDLO) W !?2,"Reopen: ",SMO 187 K ANS1,NN,INST,SCODE,CLINIC,DENTER,REQBY,DESIRD,SCPRI 188 K CLINIC,WLTYPE,TYPE,WLTN,NUM,REC 189 Q
Note:
See TracChangeset
for help on using the changeset viewer.
