190 lines
9.2 KiB
Mathematica
190 lines
9.2 KiB
Mathematica
SDWLREB ;BP/ESW - EWL matched with Canceled and Rebooked Appointment by Clinic ; 11/16/05 1:16pm
|
|
;;5.3;Scheduling;**467**;Aug 13, 1993
|
|
;
|
|
;SD*5.3*467 - Match canceled appointments in EWL entries
|
|
;
|
|
Q
|
|
REBOOK(DFN,SD,SC,RBFLG,SDTRB,SDCAN) ; rebook section
|
|
;create appt TMP to check for rebooking
|
|
;SD - appt date/time
|
|
;SC - Hospital Location IEN
|
|
;called by reference:
|
|
; RBFLG - cancellation status from Appointment Multiple
|
|
; Only if RBFLG="CCR" - canceled by clinic, rebooked
|
|
; SDTRB - asked for scheduled Date/Time of Rebooked Appointment
|
|
; SDCAN - asked for cancellation date/time
|
|
N SDARR,SCNT
|
|
S RBFLG=0,SDTRB="",SDCAN="NONE" ;initiate if not 'good' appointment
|
|
S SDARR(1)=SD_";"_SD
|
|
S SDARR(2)=SC
|
|
S SDARR(4)=DFN
|
|
S SDARR("FLDS")="1;2;3;24;25"
|
|
N SAPP S SAPP=$$SDAPI^SDAMA301(.SDARR) D
|
|
.N SDINST,SDFAC,SDINSTE
|
|
.Q:'$D(^TMP($J,"SDAMA301",DFN))
|
|
.N SDSTR S SDSTR=^TMP($J,"SDAMA301",DFN,SC,SD)
|
|
.N SDSTAT S SDSTAT=$P(SDSTR,U,3)
|
|
.K ^TMP($J,"SDAMA301",DFN,SC,SD)
|
|
.S RBFLG=$P(SDSTAT,";")
|
|
.S SDTRB=$P(SDSTR,U,24)
|
|
.S SDCAN=$P(SDSTR,U,25)
|
|
Q
|
|
DISREB(DFN,SDTRB,SC) ;DISPOSITION REBOOK OR NOT
|
|
; DFN - IEN of file #2 (Patient)
|
|
; SDTRB - Scheduled Date/Time of Rebooked Appt
|
|
; SC - Clinic IEN
|
|
; Temporary ^TMP($J,"APPT" will be created with rebooked appt data
|
|
N SDARR,SCNT
|
|
S SDDIV=""
|
|
S SDARR(1)=SDTRB_";"_SDTRB
|
|
S SDARR(2)=SC
|
|
S SDARR(4)=DFN
|
|
S SDARR("FLDS")="1;2;3;4;10;13;14"
|
|
N SAPP S SAPP=$$SDAPI^SDAMA301(.SDARR) D
|
|
.N SDINST,SDFAC,SDINSTE
|
|
.Q:'$D(^TMP($J,"SDAMA301",DFN))
|
|
.K ^TMP($J,"APPT") S SCNT=1
|
|
.S ^TMP($J,"APPT",SCNT)=^TMP($J,"SDAMA301",DFN,SC,SDTRB)
|
|
.S SDINST=$$GET1^DIQ(44,SC_",",3,"I") ; get Institution
|
|
.S SDINSTE=$$GET1^DIQ(44,SC_",",3,"E")
|
|
.S SDFAC=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Station
|
|
.I SDFAC="" N SDDIV S SDDIV="" S SDDIV=$$GET1^DIQ(44,SC_",",3.5,"I") D
|
|
..I SDDIV'="" S SDINST=$$GET1^DIQ(40.8,SDDIV_",",.07,"I") I SDINST'="" D
|
|
...S SDFAC=$S(SDINST="":"",1:$$GET1^DIQ(4,SDINST_",",99,"I")) ; Station
|
|
..I SDDIV="" S SDFAC=$P($$SITE^VASITE(,),"^",3)
|
|
.S $P(^TMP($J,"APPT",SCNT),"^",15)=SDINST_";"_SDINSTE
|
|
.S $P(^TMP($J,"APPT",SCNT),"^",16)=SDFAC
|
|
.K ^TMP($J,"SDAMA301",DFN,SC,SDTRB)
|
|
Q
|
|
OPENEWL(DFN,SDT,SC,SDREB,CEWL) ; SD*5.3*467 Open EWL entry if closed with appointment being canceled
|
|
;SDT - appointment date/time
|
|
;SC - appointment clinic IEN
|
|
;SDREB - REBOOKING FLAG: 1 - cancel & rebook
|
|
; 0 - cancel only
|
|
;CEWL - counter, optionally passed by reference with initial value=0
|
|
N DH,IEN,STATUS,CLINIC,WLAPPT,WLSTAT,SDNAM,SDAPPT,SSN,SCN
|
|
K ^TMP("SDWLPL",$J),^TMP($J,"SDWLPL")
|
|
I '$D(CEWL) D
|
|
.I $D(^TMP("SDWLREB",$J)) S CEWL=$O(^TMP("SDWLREB",$J,""),-1)
|
|
.E S CEWL=0
|
|
S IEN="" F S IEN=$O(^SDWL(409.3,"B",DFN,IEN)) Q:IEN<1 D
|
|
.S STATUS="" S STATUS=$$GET1^DIQ(409.3,IEN_",",23,"I") IF STATUS="C" D
|
|
..IF $G(^SDWL(409.3,IEN,"SDAPT")) D
|
|
...S CLINIC=$$GET1^DIQ(409.3,IEN_",",13.2,"I"),WLAPPT=$$GET1^DIQ(409.3,IEN_",",13,"I")
|
|
...IF CLINIC=SC&(WLAPPT=SDT) S WLSTAT=$$GET1^DIQ(409.3,IEN_",",21,"I") I WLSTAT="SA" D
|
|
....N Y S Y=WLAPPT D DD^%DT S SDAPPT=Y
|
|
....S SCN=$$GET1^DIQ(44,SC_",",.01),SCN=$E(SCN,1,20)
|
|
....S SDNAM=$$GET1^DIQ(2,DFN_",",.01,"I"),SDNAM=$E(SDNAM,1,25),SSN=$$GET1^DIQ(2,DFN_",",.09,"I")
|
|
....S SDFORM=$$FORM^SDFORM(SDNAM,23,SSN,12,SCN,24,SDAPPT,20)
|
|
....S CEWL=CEWL+1 S ^TMP("SDWLREB",$J,CEWL)=SDFORM
|
|
....N DIE,DA,DR
|
|
....S DIE="^SDWL(409.3,",DA=IEN,DR="23////^S X=""O""" D ^DIE
|
|
....S DR="13.8////^S X=""CC""" D ^DIE
|
|
....S DR="29////^S X=""CA""" D ^DIE
|
|
....S DR="19///@" D ^DIE
|
|
....S DR="20///@" D ^DIE
|
|
....S DR="21///@" D ^DIE
|
|
....S DR="13///@;13.1////@;13.2///@;13.3///@;13.4///@;13.5///@;13.6///@;13.8///@;13.7///@" D ^DIE
|
|
....I $D(^TMP("SDWLREB",$J)) I SDREB D ASKDISP(IEN)
|
|
I '$D(^TMP($J,"SDWLPL")) Q ; no closed EWL related entry
|
|
I SDREB D DISP
|
|
Q
|
|
MESS ; SD*5.3*467 - send message with a list of opened EWL entries because of canceled appointments
|
|
S ^TMP("SDWLREB",$J,.01)="This message displays patients that had their EWL entry opened because of "
|
|
S ^TMP("SDWLREB",$J,.02)="their matching appointment being now 'CANCELED BY CLINIC'. Some of those "
|
|
S ^TMP("SDWLREB",$J,.03)="entries may be already closed again if new appointments were scheduled and "
|
|
S ^TMP("SDWLREB",$J,.04)="matched with those EWL entries. You may use 'SD WAIT LIST REOPEN ENTRIES' "
|
|
S ^TMP("SDWLREB",$J,.05)="to run report identifying the related EWL entries."
|
|
N SDFORM S SDFORM=$$FORM^SDFORM("PATIENT NAME",23,"SSN",12,"CLINIC",24,"DATE/TIME of APPT",20) D ;added
|
|
.S ^TMP("SDWLREB",$J,.06)=SDFORM
|
|
S ^TMP("SDWLREB",$J,.07)="-----------------------------------------------------------------------"
|
|
S ^TMP("SDWLREB",$J,.08)=""
|
|
N XMSUB,XMY,XMTEXT,XMDUZ
|
|
S XMSUB="EWL opened entries with appointments 'CANCELED BY CLINIC'."
|
|
S XMY("G.SD EWL BACKGROUND UPDATE")=""
|
|
S XMTEXT="^TMP(""SDWLREB"",$J,"
|
|
S XMDUZ="POSTMASTER"
|
|
D ^XMD K ^TMP("SDWLREB",$J)
|
|
Q
|
|
ASKDISP(IEN) ;
|
|
;IEN - pointer to 409.3 to get data and display
|
|
N SDDIS S SDDIS=0 ; flag indicating disposition
|
|
W ! N X,DIR,DENTER
|
|
Q:$$GET1^DIQ(409.3,IEN_",",23,"I")="C"
|
|
S ^TMP("SDWLPL",$J,IEN)=$G(^SDWL(409.3,IEN,0)) S DENTER="",DENTER=$P($G(^TMP("SDWLPL",$J,IEN)),"^",2)
|
|
S (WLTYPE,TYPE,WLTN,NUM)="",TYPE=$P($G(^TMP("SDWLPL",$J,IEN)),"^",5)
|
|
IF DENTER'=""&(TYPE'="") D
|
|
.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)
|
|
.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)
|
|
.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)
|
|
.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)
|
|
E Q
|
|
D SAVE(TYPE,WLTNI,IEN)
|
|
Q
|
|
SAVE(TYPE,WLTNI,IEN) ;
|
|
;TYPE - EWL type
|
|
;WLTNI - TYPE related name the EWL entry is waiting for
|
|
;IEN - pointer to 409.3
|
|
S REQBY=$P($G(^TMP("SDWLPL",$J,IEN)),"^",12)
|
|
S INST=$P($G(^TMP("SDWLPL",$J,IEN)),"^",3)
|
|
N DESIRED S DESIRED=$P($G(^TMP("SDWLPL",$J,IEN)),"^",16)
|
|
N NAME,SSN S NAME=$$GET1^DIQ(2,DFN_",",.01),SSN=$$GET1^DIQ(2,DFN_",",.09)
|
|
N SDBY S SDBY=$$GET1^DIQ(409.3,IEN_",",11),SDBY=$E(SDBY,1,3)
|
|
S NN=$O(^TMP($J,"SDWLPL",""),-1)+1
|
|
S ^TMP($J,"SDWLPL",NN)=IEN_U_WLTYPE_U_U_WLTN_U_INST_U_DENTER_U_SDBY_U_DESIRED
|
|
;
|
|
N SPIEC S SPIEC=$S(TYPE=4:9,TYPE=3:10,TYPE=2:11,TYPE=1:12)
|
|
S $P(^TMP($J,"SDWLPL",NN),U,SPIEC)=WLTNI
|
|
K ^TMP("SDWLPL",$J,IEN)
|
|
Q
|
|
DISP ;
|
|
W !,"EWL Entry has just been opened because of its matching appointment",!,"being canceled.",!!
|
|
N DIR S DIR("B")="YES" ; default to match and close rebooked appointments
|
|
S DIR("A")="Do you wish to close this EWL entry with Rebooked Appointment(Yes/No)",DIR(0)="Y"
|
|
W "Closing this entry will disposition it: SA - REMOVED/SCHEDULED-ASSIGNED",!,"with Rebooked Appointment.",!!
|
|
S DIR("?")="Y(ES) will disposition this EWL entry as 'SA' with just rebooked appointment."
|
|
D LIST ; disable displaying EWL entry per SRS.
|
|
W ! D ^DIR
|
|
N SDDIS S SDDIS=0 I Y S SDDIS=1
|
|
E Q
|
|
N SDWLDISP,SDWLDA,SDWLDFN,NUM
|
|
I SDDIS S SDWLDISP="SA",NUM="" F S NUM=$O(^TMP($J,"SDWLPL",NUM)) Q:NUM="" S REC=^TMP($J,"SDWLPL",NUM) D
|
|
.S SDWLDA=+REC N SDP,SDR D
|
|
.S DIE="^SDWL(409.3,",DA=SDWLDA,DR="21////^S X=SDWLDISP" D ^DIE
|
|
.S DR="19////^S X=DT" D ^DIE
|
|
.S DR="20////^S X=DUZ" D ^DIE
|
|
.S DR="23////^S X=""C""" D ^DIE
|
|
.;I SDWLDISP="SA" update with appointment data
|
|
.;get appointment data to file (for a particular appt #)
|
|
.I SDWLDISP="SA" N SDA D DATP^SDWLEVAL(1,.SDA) D
|
|
..I $D(SDA) S DIE="^SDWL(409.3,",DA=SDWLDA D
|
|
...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
|
|
...D ^DIE
|
|
.N SDWLSCL,SDWLSS,SDC
|
|
.S SDC=1
|
|
.S SDWLSCL=$P($G(^TMP($J,"SDWLPL",SDC)),U,9)
|
|
.S SDWLSS=$P($G(^TMP($J,"SDWLPL",SDC)),U,10)
|
|
.I SDWLSCL K:$D(^SDWL(409.3,"SC",SDWLSCL,SDWLDA)) ^SDWL(409.3,"SC",SDWLSCL,SDWLDA)
|
|
.S SDWLDFN=$P($G(^TMP($J,"APPT",1)),U,4)
|
|
.I SDWLSS,SDWLDFN K:$D(^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLDA)) ^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLDA)
|
|
Q
|
|
LIST ;LIST
|
|
;may be called if EWL entry display would be needed
|
|
S (REC,NUM)="" N SDPN
|
|
F S NUM=$O(^TMP($J,"SDWLPL",NUM)) Q:NUM="" S REC=^TMP($J,"SDWLPL",NUM) D
|
|
.S IEN=+REC N SDP,SDR D
|
|
..S SDPN=$$GET1^DIQ(409.3,IEN_",",.01) W !,"Patient: ",SDPN
|
|
..W !," EW List Type P Waiting for Institution Orig Date By Des. Date Reopen"
|
|
..W !,"--------------------------------------------------------------------------"
|
|
..S SDP=$E($$GET1^DIQ(409.3,IEN_",",10)) ;priority
|
|
..S SDR=$$GET1^DIQ(409.3,IEN_",",29,"I") ;reopen reason
|
|
.N SDINS,SDIN S SDINS=$P(REC,"^",5) S SDIN=$$GET1^DIQ(4,SDINS_",",.01,"I")
|
|
.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
|
|
.N SDUP,SDLO
|
|
.S SDUP="ABCDEFGHIJKLMNOPRSTUWQXYzv",SDLO="abcdefghijklmnoprstuwqxyzv"
|
|
.N SMT S SMT=$$GET1^DIQ(409.3,IEN_",",25) I SMT'="" S SMT=$TR(SMT,SDUP,SDLO) W !?2,"Comment: ",SMT
|
|
.N SMO S SMO=$$GET1^DIQ(409.3,IEN_",",30) I SMO'="" S SMO=$TR(SMO,SDUP,SDLO) W !?2,"Reopen: ",SMO
|
|
K ANS1,NN,INST,SCODE,CLINIC,DENTER,REQBY,DESIRD,SCPRI
|
|
K CLINIC,WLTYPE,TYPE,WLTN,NUM,REC
|
|
Q
|