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