- 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 Feb 19, 2025@00:29:36 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
