- SDECCAP ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
- ;;5.3;Scheduling;**642,694**;Aug 13, 1993;Build 61
- ;
- Q
- ;
- GET(SDECY,DFN,SDCL,SDT,TYPE,APTYPE) ;GET entries from 2507 REQUEST file 396.3
- ;INPUT:
- ; DFN - (required) Patient ID pointer to PATIENT file 2
- ; SDCL - (required) Clinic ID pointer to HOSPITAL LOCATION file 44
- ; SDT - (required) Appointment Date/Time in external format
- ; TYPE - (required) O:MAKE
- ; R:REBOOK
- ; C:CANCEL or NO SHOW
- ; APTYPE - (required) Must be 1 for COMP and Pen
- ;RETURN:
- ; REQIEN - 2507 REQUEST id pointer to 2507 REQUEST file 396.3
- ; IEN - Patient ID pointer to PATIENT file 2
- ; NAME - Patient name from PATIENT file 2
- ; DATE - Request Date in external format (field #1)
- ; EXISTS - Flag to indicate that a 2507 REQUEST already has an appointment.
- ; This is indicated by an entry in file 396.95
- ; 0=No; 1=Yes
- ; APPT_LINKS - Appointment Links separated by pipe |
- ; each pipe piece contains the following ~ pieces
- ; 1. Link ID - Pointer to AMIE C&P EXAM TRACKING file 396.95
- ; 2. Initial Appt - Date/time in external format
- ; 3. Clock Stop Appt - Date/time in external format
- ; 4. Current Appt - Date/time in external format
- ; 5. Clinic Name - Name from HOSPITAL LOCATION
- ;
- N %DT,X,Y
- N SDDA,SDECI,SDMKHDL
- S SDECI=0
- S SDECY="^TMP(""SDECCAP"","_$J_",""CAPGET"")"
- K @SDECY
- S @SDECY@(SDECI)="T00030REQIEN^T00030IEN^T00030NAME^T00030DATE^T00030EXISTS^T00250APPT_LINKS"_$C(30)
- ;validate DFN
- S DFN=$G(DFN)
- I ('+DFN)!('$D(^DPT(+DFN,0))) S @SDECY@(1)="-1^Invalid patient ID."_$C(30,31) Q
- ;validate SDCL
- S SDCL=$G(SDCL)
- I ('+SDCL)!('$D(^SC(+SDCL,0))) S @SDECY@(1)="-1^Invalid clinic ID."_$C(30,31) Q
- ;validate SDT
- S SDT=$G(SDT)
- S %DT="RXT",X=SDT D ^%DT S SDT=Y
- S SDDA=0 F S SDDA=$O(^SC(SDCL,"S",SDT,1,SDDA)) Q:SDDA'>0 Q:$P($G(^SC(SDCL,"S",SDT,1,SDDA,0)),U,1)=DFN
- I SDDA="" S @SDECY@(1)="-1^Appointment not found."_$C(30,31) Q
- I SDT=-1 S @SDECY@(1)="-1^Invalid appointment date/time."_$C(30,31) Q
- ;validate TYPE
- S TYPE=$G(TYPE)
- I "ORC"'[TYPE S @SDECY@(1)="-1^Type must be O:Original Make, R for Rebook, or C for Cancel/No Show."_$C(30,31) Q
- ;validate APTYPE
- S APTYPE=$G(APTYPE)
- I APTYPE'=1 S @SDECY@(1)="-1^Only Comp & Pen is currently supported."_$C(30,31) Q
- ;from MAKE^SDAMEVT
- K ^TMP("SDAMEVT",$J)
- S SDMKHDL=$$HANDLE^SDAMEVT(1)
- S (^TMP("SDAMEVT",$J,"BEFORE","DPT"),^TMP("SDAMEVT",$J,"BEFORE","SC"),^TMP("SDAMEVT",$J,"BEFORE","STATUS"))=""
- S SDATA("BEFORE","STATUS")=""
- S (^TMP("SDEVT",$J,SDMKHDL,1,"DPT",0,"BEFORE"),^TMP("SDEVT",$J,SDMKHDL,1,"SC",0,"BEFORE"))=""
- S (^TMP("SDEVT",$J,SDMKHDL,1,"DPT",0,"AFTER"),^TMP("SDEVT",$J,SDMKHDL,1,"SC",0,"AFTER"))=""
- ;D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMKHDL)
- S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
- D EVT(.SDATA,1,0,SDMKHDL)
- ;
- S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
- Q
- ;
- EVT(SDATA,SDAMEVT,SDMODE,SDHDL) ;EVT^SDAMEVT
- K DTOUT,DIROUT
- S:$P(SDATA,U,3) $P(SDATA,U,5)=$$REQ^SDM1A(+$P(SDATA,U,3))
- D EN
- Q
- ;
- ;from EN^DVBCSDEV
- EN ;**AMIE Scheduling event driver main entry point
- K KDFN I '$D(DFN) N DFN S DFN=$P(SDATA,U,2),KDFN=""
- S DVBAORG=$$SDORGST^DVBCUTL5
- I +DVBAORG=1 D
- .S DVBAXST=$$SDEVTXST^DVBCUTL5
- .I +DVBAXST=1 D
- ..S DVBATYPE=1 ;$$SDEVTSPC^DVBCUTL5(16)
- ..I +DVBATYPE=1 D
- ...I +SDAMEVT=1 D EN1 ;EN^DVBCMKLK ;** Original Make event
- ...;I +SDAMEVT=1,($D(DVBAAUTO)) K DVBAAUTO ;** Auto-rebook Make event
- ...I +SDAMEVT=2 D ENCAN ;EN^DVBCCNNS ;** Cancel/No show event
- ..K DVBATYPE
- .K DVBAXST
- K DVBAORG
- I $D(KDFN) K KDFN,DFN
- D KVARS^DVBCMKLK
- Q
- ;
- ;from DVBCMKLK
- EN1 ;** Link C&P appointment to 2507
- N DVBADFN,DVBASDPR,DVBASTAT
- N SDI,SDJ,DVBADA,SDL,SDLINKS,SDM,SDTMP,TMP,TMP1
- S DVBADFN=DFN,DVBASTAT="P" ;**DVBASTAT used in REQARY^DVBCUTL5
- ;
- ;**If user entered from AMIE Scheduling, only prompted if enhanced
- ;** dialogue turned on and is needed
- ;** QUIT on next line if from DVBCSCHD
- ;I $D(DVBASDRT) S DVBADA=REQDA D LINKAPPT^DVBCMKL2,KVARS QUIT ;*DVBCSCHD
- S (DVBADA,DVBASDPR)=""
- D REQARY^DVBCUTL5 ;**Set up ^TMP of AMIE 2507's
- ;^TMP("DVBC",8945,6889775.889799,3110224.1102,34231)=""
- ; Inverse REQUEST DATE, REQUEST DATE, IEN)
- S SDI="" F S SDI=$O(^TMP("DVBC",$J,SDI)) Q:SDI="" D
- .S SDJ="" F S SDJ=$O(^TMP("DVBC",$J,SDI,SDJ)) Q:SDJ="" D
- ..S DVBADA="" F S DVBADA=$O(^TMP("DVBC",$J,SDI,SDJ,DVBADA)) Q:DVBADA="" D
- ...S $P(SDTMP,U,1)=DVBADA ;2507 REQUEST id
- ...S $P(SDTMP,U,2)=DFN
- ...S $P(SDTMP,U,3)=$$GET1^DIQ(2,DFN_",",.01)
- ... ;
- ... ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
- ... ;
- ... S $P(SDTMP,U,4)=$$FMTONET^SDECDATE(SDJ) ;
- ... ;S $P(SDTMP,U,4)=$$FMTE^XLFDT(SDJ)
- ... S $P(SDTMP,U,5)=+$E($D(^DVB(396.95,"AR",+DVBADA)),1)
- ...D
- ....K TMP("DVBC LINK")
- ....S SDLINKS="" ;SDLINKS | ~
- ....D LNKARY^DVBCUTA3(DVBADA,DFN)
- ....S SDL="" F S SDL=$O(TMP("DVBC LINK",SDL)) Q:SDL="" D
- .....S SDM="" F S SDM=$O(TMP("DVBC LINK",SDL,SDM)) Q:SDM="" D
- ......S TMP1=SDM_"~"_$TR(TMP("DVBC LINK",SDL,SDM),"^","~")
- ......S SDLINKS=SDLINKS_$S(SDLINKS'="":"|",1:"")_TMP1
- ...S $P(SDTMP,U,6)=SDLINKS
- ...S SDECI=SDECI+1 S @SDECY@(SDECI)=SDTMP_$C(30)
- K ^TMP("DVBC LINK")
- Q
- ;
- ;
- SET(SDECY,REQIEN,APPTLNK,VETREQ,SDCL,SDT) ;SET entries to AMIE C&P EXAM TRACKING file 396.95 and update file 396.3
- ;INPUT:
- ; 1. REQIEN - (required) 2507 REQUEST id pointer to 2507 REQUEST file 396.3
- ; 2. APPTLNK - (optional) Appointment Link with the following ~ pieces: (a new link will be made if this is null)
- ; 1. Link ID - Pointer to AMIE C&P EXAM TRACKING file 396.95
- ; 2. Initial Appt - Date/time in external format
- ; 3. Clock Stop Appt - Date/time in external format
- ; 4. Current Appt - Date/time in external format
- ; 5. Clinic Name - Name from HOSPITAL LOCATION
- ; 3. VETREQ - (optional) Veteran Request flag - (field .04 in file 396.95)
- ; "Is this appointment due to a veteran requested cancellation or 'No Show'"
- ; 0=NO; 1=YES
- ; 4. SDCL - (required) pointer to HOSPITAL LOCATION file 44
- ; 5. SDT - (required) Appointment date/time in external format
- ;RETURN:
- ; CODE ^ MESSAGE
- N DFN,DVBADA,DVBALKRC,DVBAVTRQ
- N SDDA,SDECI
- S SDECI=0
- S SDECY="^TMP(""SDECCAP"","_$J_",""CAPSET"")"
- K @SDECY
- S @SDECY@(SDECI)="T00030CODE^T00250MESSAGE"_$C(30)
- ;validate REQIEN
- S (REQIEN,DVBADA)=$G(REQIEN)
- I '+REQIEN S @SDECY@(1)="-1^Invalid 2507 REQUEST id."_$C(30,31) Q
- I '$D(^DVB(396.3,+REQIEN,0)) S @SDECY@(1)="-1^Invalid 2507 REQUEST id."_$C(30,31) Q
- S DFN=$$GET1^DIQ(396.3,REQIEN_",",.01,"I")
- ;validate APPTLNK
- S APPTLNK=$G(APPTLNK)
- ;validate VETREQ
- S VETREQ=$G(VETREQ)
- I VETREQ'=1,VETREQ'=2 S VETREQ=""
- ;validate SDCL
- S SDCL=$G(SDCL)
- I ('+SDCL)!('$D(^SC(+SDCL,0))) S @SDECY@(1)="-1^Invalid clinic ID."_$C(30,31) Q
- ;validate SDT
- S SDT=$G(SDT)
- S %DT="RXT",X=SDT D ^%DT S SDT=Y
- I SDT=-1 S @SDECY@(1)="-1^Invalid appointment date/time."_$C(30,31) Q
- S SDDA=0 F S SDDA=$O(^SC(SDCL,"S",SDT,1,SDDA)) Q:SDDA'>0 Q:$P($G(^SC(SDCL,"S",SDT,1,SDDA,0)),U,1)=DFN
- I SDDA="" S @SDECY@(1)="-1^Appointment not found."_$C(30,31) Q
- ;
- ;from MAKE^SDAMEVT
- ;K ^TMP("SDAMEVT",$J)
- ;S SDMKHDL=$$HANDLE^SDAMEVT(1)
- ;S (^TMP("SDAMEVT",$J,"BEFORE","DPT"),^TMP("SDAMEVT",$J,"BEFORE","SC"),^TMP("SDAMEVT",$J,"BEFORE","STATUS"))=""
- ;S SDATA("BEFORE","STATUS")=""
- ;S (^TMP("SDEVT",$J,SDMKHDL,1,"DPT",0,"BEFORE"),^TMP("SDEVT",$J,SDMKHDL,1,"SC",0,"BEFORE"))=""
- ;S (^TMP("SDEVT",$J,SDHDL,1,"DPT",0,"AFTER"),^TMP("SDEVT",$J,SDHDL,1,"SC",0,"AFTER"))=""
- ; ;D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMKHDL)
- S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
- I APPTLNK="" D CRTREC S @SDECY@(1)=+Y_U_"AMIE C&P EXAM TRACKING record added"_$C(30,31) G SETX
- I APPTLNK'="" S DVBALKRC=$P(APPTLNK,"~",1),DVBAVTRQ=VETREQ D UPDTLK S @SDECY@(1)=DVBALKRC_U_"AMIE C&P EXAM TRACKING record updated"_$C(30,31) G SETX
- S @SDECY@(1)="-1^No updates made"_$C(30,31)
- SETX ;
- Q
- CRTREC ;** Add a record to file 396.95 (Appt Tracking)
- N DIC,DD,DLAYGO,DO,DVBAADT,X
- S DVBAADT=$P(SDATA,U,3)
- S DIC="^DVB(396.95,",X=DVBAADT,DIC(0)="LX",DLAYGO="396.95"
- S DIC("DR")=".02////^S X=DVBAADT;.03////^S X=DVBAADT;"
- S DIC("DR")=DIC("DR")_".04////^S X=0;.06////^S X=DVBADA;"
- S DIC("DR")=DIC("DR")_".07////^S X=1"
- D FILE^DICN K DIC,X,DLAYGO,DVBAADT
- Q
- UPDTLK ;** Update selected 396.95 link
- N DVBARSAP
- S DVBARSAP=$P(^DVB(396.95,DVBALKRC,0),U,3)
- K Y,DIR D RSCHAPT(DVBALKRC,$P(SDATA,U,3))
- K DVBAVTRQ
- N DVBAAPST
- S DVBAAPST=$P(^DPT(DFN,"S",SDT,0),U,2)
- Q
- RSCHAPT(LKDA,RSCHDT) ;** Update Appt record with reschedule data ;from DVBCMKLK
- N DA,DIE,DR
- S DA=+LKDA,DIE="^DVB(396.95,",DR=".03////^S X=RSCHDT;.07////1"
- S:(+$P(^DVB(396.95,DA,0),U,4)=0&('$D(DVBAVTRQ))) DR=".02////^S X=RSCHDT;"_DR
- S:($D(DVBAVTRQ)) DR=".04////^S X=1;.05////^S X=RSCHDT;"_DR
- D ^DIE K DA,DIE,DR
- Q
- ;
- CAN(SDECY,DFN,SDCL,SDT) ;SET AMIE C&P EXAM TRACKING as cancel
- ;INPUT:
- ; DFN - (required) Patient ID pointer to PATIENT file 2
- ; SDCL - (required) Clinic ID pointer to HOSPITAL LOCATION file 44
- ; SDT - (required) Appointment Date/Time in external format
- ;RETURN:
- ; an array of codes and messages:
- ; code ^ message
- ; code - -1=error -2=message to be displayed to the user
- N SDAMEVT,SDATA,SDCPHDL,SDECI,SDHDL
- N ZTQUEUED
- S ZTQUEUED=1
- S SDAMEVT=2
- S SDECI=0
- S SDECY="^TMP(""SDECCAP"","_$J_",""CAPSET"")"
- K @SDECY
- S @SDECY@(SDECI)="T00030REQIEN^T00030IEN^T00030NAME^T00030DATE^T00030EXISTS_T00250APPT_LINKS"_$C(30)
- ;validate DFN
- S DFN=$G(DFN)
- I ('+DFN)!('$D(^DPT(+DFN,0))) S @SDECY@(1)="-1^Invalid patient ID."_$C(30,31) Q
- ;validate SDCL
- S SDCL=$G(SDCL)
- I ('+SDCL)!('$D(^SC(+SDCL,0))) S @SDECY@(1)="-1^Invalid clinic ID."_$C(30,31) Q
- ;validate SDT
- S SDT=$G(SDT)
- S %DT="RXT",X=SDT D ^%DT S SDT=Y
- I SDT=-1 S @SDECY@(1)="-1^Invalid appointment date/time."_$C(30,31) Q
- S SDDA=0 F S SDDA=$O(^SC(SDCL,"S",SDT,1,SDDA)) Q:SDDA'>0 Q:$P($G(^SC(SDCL,"S",SDT,1,SDDA,0)),U,1)=DFN
- I SDDA="" S @SDECY@(1)="-1^Appointment not found."_$C(30,31) Q
- S (SDHDL,SDCPHDL)=$$HANDLE^SDAMEVT(1) D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,"",SDCPHDL) ;CAN^SDCNP0
- ;D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,0,SDCPHDL) ;EVT^SDCNP0
- D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL) ;CANCEL^SDAMEVT
- S SDATA=SDDA_U_DFN_U_SDT_U_SDCL
- D EVT(.SDATA,SDAMEVT,0,SDCPHDL)
- S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
- Q
- ;
- ENCAN ;from DVBCCNNS
- N DVBAAPDA,DVBAAUTO,DVBACURA,DVBAFND,DVBALKDA,DVBARQDA,DVBASTAT,DVBAUPDT
- N LNKCNT
- S DVBASTAT=$$SDEVTSPC^DVBCUTL5(2)
- S DVBACURA=$P(SDATA,U,3) ;**Get the date being canceled
- S (DVBAAPDA,DVBALKDA)=""
- S DVBAUPDT=0
- K DVBAFND
- S LNKCNT=0
- F S DVBAAPDA=$O(^DVB(396.95,"CD",DVBACURA,DVBAAPDA)) Q:(DVBAAPDA="") D
- .S DVBARQDA=$P(^DVB(396.95,DVBAAPDA,0),U,6)
- .I ($P(^DVB(396.3,DVBARQDA,0),U,1)=DFN) D
- ..S LNKCNT=LNKCNT+1
- ..S:(+$P(^DVB(396.95,DVBAAPDA,0),U,7)=1) DVBAFND="",DVBALKDA=DVBAAPDA
- ..I '$D(DVBAFND),($P(^DVB(396.95,DVBAAPDA,0),U,8)>DVBAUPDT) D
- ...S DVBAUPDT=$P(^DVB(396.95,DVBAAPDA,0),U,8) ;**Keep latest cancel dte
- ...S DVBALKDA=DVBAAPDA ;**Keep DA of rec last cancelled
- I (DVBASTAT="PCA")!((DVBASTAT="NA")!(DVBASTAT="CA")) S DVBAAUTO=""
- ;
- ;** Appt not linked, enhnc dilog on, not processing in background
- I LNKCNT=0 D
- .N DVBACROT,Y
- . ;
- . ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
- . ;
- . S DVBACROT=$$FMTONET^SDECDATE(DVBACURA) ;
- . ;S Y=DVBACURA X ^DD("DD") S DVBACROT=Y K Y
- .S SDECI=SDECI+1 S @SDECY@(SDECI)="-2^Appointment "_DVBACROT_" was not linked to a 2507 request or was"
- .S SDECI=SDECI+1 S @SDECY@(SDECI)=" manually rebooked and linked to another appointment."
- .S SDECI=SDECI+1 S @SDECY@(SDECI)=" (If the appointment was manually rebooked, you do not want to auto-rebook.)"
- .S SDECI=SDECI+1 S @SDECY@(SDECI)="If the appointment was not properly linked, it will need to be linked with the"
- .S SDECI=SDECI+1 S @SDECY@(SDECI)=" AMIE/C&P appointment link management option."_$C(30)
- ;I $D(DVBAAUTO),($D(DVBAFND)!('$D(DVBAFND)&(+LNKCNT>0))) DO ;**Auto-rbk
- ;.S:(+$$SDEVTXST^DVBCUTL5=1) DVBAAPDT=$$SDEVTSPC^DVBCUTL5(10)
- ;.K DVBAVTRQ ;**Set if appointment canceled by vet
- ;.S:(DVBASTAT["P"!(DVBASTAT["N"&(DVBASTAT'="NT"))) DVBAVTRQ=""
- ;.D RSCHAPT^DVBCMKLK(DVBALKDA,DVBAAPDT)
- ;.D:((+$$ENHNC^DVBCUTA4=1)&('$D(ZTQUEUED))) CNCMSG
- I '$D(DVBAAUTO),($D(DVBAFND)) D ;**Appt linked, not Auto
- .D CANCEL^DVBCCNNS
- .S SDECI=SDECI+1 S @SDECY@(SDECI)="-2^The link has been updated."_$C(30)
- .;D:((+$$ENHNC^DVBCUTA4=1)&('$D(ZTQUEUED))) CNCMSG
- I +LNKCNT>1 D
- .S SDECI=SDECI+1 S @SDECY@(SDECI)="-2^This C&P appointment has multiple links with the same Current Appt Date."
- .S SDECI=SDECI+1 S @SDECY@(SDECI)=" Use the AMIE/C&P Appointment Link Management option to review and delete"
- .S SDECI=SDECI+1 S @SDECY@(SDECI)=" any duplicate links."_$C(30)
- D KVARS^DVBCCNNS
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECCAP 13242 printed Feb 19, 2025@00:18:15 Page 2
- SDECCAP ;ALB/SAT,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
- +1 ;;5.3;Scheduling;**642,694**;Aug 13, 1993;Build 61
- +2 ;
- +3 QUIT
- +4 ;
- GET(SDECY,DFN,SDCL,SDT,TYPE,APTYPE) ;GET entries from 2507 REQUEST file 396.3
- +1 ;INPUT:
- +2 ; DFN - (required) Patient ID pointer to PATIENT file 2
- +3 ; SDCL - (required) Clinic ID pointer to HOSPITAL LOCATION file 44
- +4 ; SDT - (required) Appointment Date/Time in external format
- +5 ; TYPE - (required) O:MAKE
- +6 ; R:REBOOK
- +7 ; C:CANCEL or NO SHOW
- +8 ; APTYPE - (required) Must be 1 for COMP and Pen
- +9 ;RETURN:
- +10 ; REQIEN - 2507 REQUEST id pointer to 2507 REQUEST file 396.3
- +11 ; IEN - Patient ID pointer to PATIENT file 2
- +12 ; NAME - Patient name from PATIENT file 2
- +13 ; DATE - Request Date in external format (field #1)
- +14 ; EXISTS - Flag to indicate that a 2507 REQUEST already has an appointment.
- +15 ; This is indicated by an entry in file 396.95
- +16 ; 0=No; 1=Yes
- +17 ; APPT_LINKS - Appointment Links separated by pipe |
- +18 ; each pipe piece contains the following ~ pieces
- +19 ; 1. Link ID - Pointer to AMIE C&P EXAM TRACKING file 396.95
- +20 ; 2. Initial Appt - Date/time in external format
- +21 ; 3. Clock Stop Appt - Date/time in external format
- +22 ; 4. Current Appt - Date/time in external format
- +23 ; 5. Clinic Name - Name from HOSPITAL LOCATION
- +24 ;
- +25 NEW %DT,X,Y
- +26 NEW SDDA,SDECI,SDMKHDL
- +27 SET SDECI=0
- +28 SET SDECY="^TMP(""SDECCAP"","_$JOB_",""CAPGET"")"
- +29 KILL @SDECY
- +30 SET @SDECY@(SDECI)="T00030REQIEN^T00030IEN^T00030NAME^T00030DATE^T00030EXISTS^T00250APPT_LINKS"_$CHAR(30)
- +31 ;validate DFN
- +32 SET DFN=$GET(DFN)
- +33 IF ('+DFN)!('$DATA(^DPT(+DFN,0)))
- SET @SDECY@(1)="-1^Invalid patient ID."_$CHAR(30,31)
- QUIT
- +34 ;validate SDCL
- +35 SET SDCL=$GET(SDCL)
- +36 IF ('+SDCL)!('$DATA(^SC(+SDCL,0)))
- SET @SDECY@(1)="-1^Invalid clinic ID."_$CHAR(30,31)
- QUIT
- +37 ;validate SDT
- +38 SET SDT=$GET(SDT)
- +39 SET %DT="RXT"
- SET X=SDT
- DO ^%DT
- SET SDT=Y
- +40 SET SDDA=0
- FOR
- SET SDDA=$ORDER(^SC(SDCL,"S",SDT,1,SDDA))
- if SDDA'>0
- QUIT
- if $PIECE($GET(^SC(SDCL,"S",SDT,1,SDDA,0)),U,1)=DFN
- QUIT
- +41 IF SDDA=""
- SET @SDECY@(1)="-1^Appointment not found."_$CHAR(30,31)
- QUIT
- +42 IF SDT=-1
- SET @SDECY@(1)="-1^Invalid appointment date/time."_$CHAR(30,31)
- QUIT
- +43 ;validate TYPE
- +44 SET TYPE=$GET(TYPE)
- +45 IF "ORC"'[TYPE
- SET @SDECY@(1)="-1^Type must be O:Original Make, R for Rebook, or C for Cancel/No Show."_$CHAR(30,31)
- QUIT
- +46 ;validate APTYPE
- +47 SET APTYPE=$GET(APTYPE)
- +48 IF APTYPE'=1
- SET @SDECY@(1)="-1^Only Comp & Pen is currently supported."_$CHAR(30,31)
- QUIT
- +49 ;from MAKE^SDAMEVT
- +50 KILL ^TMP("SDAMEVT",$JOB)
- +51 SET SDMKHDL=$$HANDLE^SDAMEVT(1)
- +52 SET (^TMP("SDAMEVT",$JOB,"BEFORE","DPT"),^TMP("SDAMEVT",$JOB,"BEFORE","SC"),^TMP("SDAMEVT",$JOB,"BEFORE","STATUS"))=""
- +53 SET SDATA("BEFORE","STATUS")=""
- +54 SET (^TMP("SDEVT",$JOB,SDMKHDL,1,"DPT",0,"BEFORE"),^TMP("SDEVT",$JOB,SDMKHDL,1,"SC",0,"BEFORE"))=""
- +55 SET (^TMP("SDEVT",$JOB,SDMKHDL,1,"DPT",0,"AFTER"),^TMP("SDEVT",$JOB,SDMKHDL,1,"SC",0,"AFTER"))=""
- +56 ;D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMKHDL)
- +57 SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
- +58 DO EVT(.SDATA,1,0,SDMKHDL)
- +59 ;
- +60 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
- +61 QUIT
- +62 ;
- EVT(SDATA,SDAMEVT,SDMODE,SDHDL) ;EVT^SDAMEVT
- +1 KILL DTOUT,DIROUT
- +2 if $PIECE(SDATA,U,3)
- SET $PIECE(SDATA,U,5)=$$REQ^SDM1A(+$PIECE(SDATA,U,3))
- +3 DO EN
- +4 QUIT
- +5 ;
- +6 ;from EN^DVBCSDEV
- EN ;**AMIE Scheduling event driver main entry point
- +1 KILL KDFN
- IF '$DATA(DFN)
- NEW DFN
- SET DFN=$PIECE(SDATA,U,2)
- SET KDFN=""
- +2 SET DVBAORG=$$SDORGST^DVBCUTL5
- +3 IF +DVBAORG=1
- Begin DoDot:1
- +4 SET DVBAXST=$$SDEVTXST^DVBCUTL5
- +5 IF +DVBAXST=1
- Begin DoDot:2
- +6 ;$$SDEVTSPC^DVBCUTL5(16)
- SET DVBATYPE=1
- +7 IF +DVBATYPE=1
- Begin DoDot:3
- +8 ;EN^DVBCMKLK ;** Original Make event
- IF +SDAMEVT=1
- DO EN1
- +9 ;I +SDAMEVT=1,($D(DVBAAUTO)) K DVBAAUTO ;** Auto-rebook Make event
- +10 ;EN^DVBCCNNS ;** Cancel/No show event
- IF +SDAMEVT=2
- DO ENCAN
- End DoDot:3
- +11 KILL DVBATYPE
- End DoDot:2
- +12 KILL DVBAXST
- End DoDot:1
- +13 KILL DVBAORG
- +14 IF $DATA(KDFN)
- KILL KDFN,DFN
- +15 DO KVARS^DVBCMKLK
- +16 QUIT
- +17 ;
- +18 ;from DVBCMKLK
- EN1 ;** Link C&P appointment to 2507
- +1 NEW DVBADFN,DVBASDPR,DVBASTAT
- +2 NEW SDI,SDJ,DVBADA,SDL,SDLINKS,SDM,SDTMP,TMP,TMP1
- +3 ;**DVBASTAT used in REQARY^DVBCUTL5
- SET DVBADFN=DFN
- SET DVBASTAT="P"
- +4 ;
- +5 ;**If user entered from AMIE Scheduling, only prompted if enhanced
- +6 ;** dialogue turned on and is needed
- +7 ;** QUIT on next line if from DVBCSCHD
- +8 ;I $D(DVBASDRT) S DVBADA=REQDA D LINKAPPT^DVBCMKL2,KVARS QUIT ;*DVBCSCHD
- +9 SET (DVBADA,DVBASDPR)=""
- +10 ;**Set up ^TMP of AMIE 2507's
- DO REQARY^DVBCUTL5
- +11 ;^TMP("DVBC",8945,6889775.889799,3110224.1102,34231)=""
- +12 ; Inverse REQUEST DATE, REQUEST DATE, IEN)
- +13 SET SDI=""
- FOR
- SET SDI=$ORDER(^TMP("DVBC",$JOB,SDI))
- if SDI=""
- QUIT
- Begin DoDot:1
- +14 SET SDJ=""
- FOR
- SET SDJ=$ORDER(^TMP("DVBC",$JOB,SDI,SDJ))
- if SDJ=""
- QUIT
- Begin DoDot:2
- +15 SET DVBADA=""
- FOR
- SET DVBADA=$ORDER(^TMP("DVBC",$JOB,SDI,SDJ,DVBADA))
- if DVBADA=""
- QUIT
- Begin DoDot:3
- +16 ;2507 REQUEST id
- SET $PIECE(SDTMP,U,1)=DVBADA
- +17 SET $PIECE(SDTMP,U,2)=DFN
- +18 SET $PIECE(SDTMP,U,3)=$$GET1^DIQ(2,DFN_",",.01)
- +19 ;
- +20 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
- +21 ;
- +22 ;
- SET $PIECE(SDTMP,U,4)=$$FMTONET^SDECDATE(SDJ)
- +23 ;S $P(SDTMP,U,4)=$$FMTE^XLFDT(SDJ)
- +24 SET $PIECE(SDTMP,U,5)=+$EXTRACT($DATA(^DVB(396.95,"AR",+DVBADA)),1)
- +25 Begin DoDot:4
- +26 KILL TMP("DVBC LINK")
- +27 ;SDLINKS | ~
- SET SDLINKS=""
- +28 DO LNKARY^DVBCUTA3(DVBADA,DFN)
- +29 SET SDL=""
- FOR
- SET SDL=$ORDER(TMP("DVBC LINK",SDL))
- if SDL=""
- QUIT
- Begin DoDot:5
- +30 SET SDM=""
- FOR
- SET SDM=$ORDER(TMP("DVBC LINK",SDL,SDM))
- if SDM=""
- QUIT
- Begin DoDot:6
- +31 SET TMP1=SDM_"~"_$TRANSLATE(TMP("DVBC LINK",SDL,SDM),"^","~")
- +32 SET SDLINKS=SDLINKS_$SELECT(SDLINKS'="":"|",1:"")_TMP1
- End DoDot:6
- End DoDot:5
- End DoDot:4
- +33 SET $PIECE(SDTMP,U,6)=SDLINKS
- +34 SET SDECI=SDECI+1
- SET @SDECY@(SDECI)=SDTMP_$CHAR(30)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +35 KILL ^TMP("DVBC LINK")
- +36 QUIT
- +37 ;
- +38 ;
- SET(SDECY,REQIEN,APPTLNK,VETREQ,SDCL,SDT) ;SET entries to AMIE C&P EXAM TRACKING file 396.95 and update file 396.3
- +1 ;INPUT:
- +2 ; 1. REQIEN - (required) 2507 REQUEST id pointer to 2507 REQUEST file 396.3
- +3 ; 2. APPTLNK - (optional) Appointment Link with the following ~ pieces: (a new link will be made if this is null)
- +4 ; 1. Link ID - Pointer to AMIE C&P EXAM TRACKING file 396.95
- +5 ; 2. Initial Appt - Date/time in external format
- +6 ; 3. Clock Stop Appt - Date/time in external format
- +7 ; 4. Current Appt - Date/time in external format
- +8 ; 5. Clinic Name - Name from HOSPITAL LOCATION
- +9 ; 3. VETREQ - (optional) Veteran Request flag - (field .04 in file 396.95)
- +10 ; "Is this appointment due to a veteran requested cancellation or 'No Show'"
- +11 ; 0=NO; 1=YES
- +12 ; 4. SDCL - (required) pointer to HOSPITAL LOCATION file 44
- +13 ; 5. SDT - (required) Appointment date/time in external format
- +14 ;RETURN:
- +15 ; CODE ^ MESSAGE
- +16 NEW DFN,DVBADA,DVBALKRC,DVBAVTRQ
- +17 NEW SDDA,SDECI
- +18 SET SDECI=0
- +19 SET SDECY="^TMP(""SDECCAP"","_$JOB_",""CAPSET"")"
- +20 KILL @SDECY
- +21 SET @SDECY@(SDECI)="T00030CODE^T00250MESSAGE"_$CHAR(30)
- +22 ;validate REQIEN
- +23 SET (REQIEN,DVBADA)=$GET(REQIEN)
- +24 IF '+REQIEN
- SET @SDECY@(1)="-1^Invalid 2507 REQUEST id."_$CHAR(30,31)
- QUIT
- +25 IF '$DATA(^DVB(396.3,+REQIEN,0))
- SET @SDECY@(1)="-1^Invalid 2507 REQUEST id."_$CHAR(30,31)
- QUIT
- +26 SET DFN=$$GET1^DIQ(396.3,REQIEN_",",.01,"I")
- +27 ;validate APPTLNK
- +28 SET APPTLNK=$GET(APPTLNK)
- +29 ;validate VETREQ
- +30 SET VETREQ=$GET(VETREQ)
- +31 IF VETREQ'=1
- IF VETREQ'=2
- SET VETREQ=""
- +32 ;validate SDCL
- +33 SET SDCL=$GET(SDCL)
- +34 IF ('+SDCL)!('$DATA(^SC(+SDCL,0)))
- SET @SDECY@(1)="-1^Invalid clinic ID."_$CHAR(30,31)
- QUIT
- +35 ;validate SDT
- +36 SET SDT=$GET(SDT)
- +37 SET %DT="RXT"
- SET X=SDT
- DO ^%DT
- SET SDT=Y
- +38 IF SDT=-1
- SET @SDECY@(1)="-1^Invalid appointment date/time."_$CHAR(30,31)
- QUIT
- +39 SET SDDA=0
- FOR
- SET SDDA=$ORDER(^SC(SDCL,"S",SDT,1,SDDA))
- if SDDA'>0
- QUIT
- if $PIECE($GET(^SC(SDCL,"S",SDT,1,SDDA,0)),U,1)=DFN
- QUIT
- +40 IF SDDA=""
- SET @SDECY@(1)="-1^Appointment not found."_$CHAR(30,31)
- QUIT
- +41 ;
- +42 ;from MAKE^SDAMEVT
- +43 ;K ^TMP("SDAMEVT",$J)
- +44 ;S SDMKHDL=$$HANDLE^SDAMEVT(1)
- +45 ;S (^TMP("SDAMEVT",$J,"BEFORE","DPT"),^TMP("SDAMEVT",$J,"BEFORE","SC"),^TMP("SDAMEVT",$J,"BEFORE","STATUS"))=""
- +46 ;S SDATA("BEFORE","STATUS")=""
- +47 ;S (^TMP("SDEVT",$J,SDMKHDL,1,"DPT",0,"BEFORE"),^TMP("SDEVT",$J,SDMKHDL,1,"SC",0,"BEFORE"))=""
- +48 ;S (^TMP("SDEVT",$J,SDHDL,1,"DPT",0,"AFTER"),^TMP("SDEVT",$J,SDHDL,1,"SC",0,"AFTER"))=""
- +49 ; ;D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMKHDL)
- +50 SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
- +51 IF APPTLNK=""
- DO CRTREC
- SET @SDECY@(1)=+Y_U_"AMIE C&P EXAM TRACKING record added"_$CHAR(30,31)
- GOTO SETX
- +52 IF APPTLNK'=""
- SET DVBALKRC=$PIECE(APPTLNK,"~",1)
- SET DVBAVTRQ=VETREQ
- DO UPDTLK
- SET @SDECY@(1)=DVBALKRC_U_"AMIE C&P EXAM TRACKING record updated"_$CHAR(30,31)
- GOTO SETX
- +53 SET @SDECY@(1)="-1^No updates made"_$CHAR(30,31)
- SETX ;
- +1 QUIT
- CRTREC ;** Add a record to file 396.95 (Appt Tracking)
- +1 NEW DIC,DD,DLAYGO,DO,DVBAADT,X
- +2 SET DVBAADT=$PIECE(SDATA,U,3)
- +3 SET DIC="^DVB(396.95,"
- SET X=DVBAADT
- SET DIC(0)="LX"
- SET DLAYGO="396.95"
- +4 SET DIC("DR")=".02////^S X=DVBAADT;.03////^S X=DVBAADT;"
- +5 SET DIC("DR")=DIC("DR")_".04////^S X=0;.06////^S X=DVBADA;"
- +6 SET DIC("DR")=DIC("DR")_".07////^S X=1"
- +7 DO FILE^DICN
- KILL DIC,X,DLAYGO,DVBAADT
- +8 QUIT
- UPDTLK ;** Update selected 396.95 link
- +1 NEW DVBARSAP
- +2 SET DVBARSAP=$PIECE(^DVB(396.95,DVBALKRC,0),U,3)
- +3 KILL Y,DIR
- DO RSCHAPT(DVBALKRC,$PIECE(SDATA,U,3))
- +4 KILL DVBAVTRQ
- +5 NEW DVBAAPST
- +6 SET DVBAAPST=$PIECE(^DPT(DFN,"S",SDT,0),U,2)
- +7 QUIT
- RSCHAPT(LKDA,RSCHDT) ;** Update Appt record with reschedule data ;from DVBCMKLK
- +1 NEW DA,DIE,DR
- +2 SET DA=+LKDA
- SET DIE="^DVB(396.95,"
- SET DR=".03////^S X=RSCHDT;.07////1"
- +3 if (+$PIECE(^DVB(396.95,DA,0),U,4)=0&('$DATA(DVBAVTRQ)))
- SET DR=".02////^S X=RSCHDT;"_DR
- +4 if ($DATA(DVBAVTRQ))
- SET DR=".04////^S X=1;.05////^S X=RSCHDT;"_DR
- +5 DO ^DIE
- KILL DA,DIE,DR
- +6 QUIT
- +7 ;
- CAN(SDECY,DFN,SDCL,SDT) ;SET AMIE C&P EXAM TRACKING as cancel
- +1 ;INPUT:
- +2 ; DFN - (required) Patient ID pointer to PATIENT file 2
- +3 ; SDCL - (required) Clinic ID pointer to HOSPITAL LOCATION file 44
- +4 ; SDT - (required) Appointment Date/Time in external format
- +5 ;RETURN:
- +6 ; an array of codes and messages:
- +7 ; code ^ message
- +8 ; code - -1=error -2=message to be displayed to the user
- +9 NEW SDAMEVT,SDATA,SDCPHDL,SDECI,SDHDL
- +10 NEW ZTQUEUED
- +11 SET ZTQUEUED=1
- +12 SET SDAMEVT=2
- +13 SET SDECI=0
- +14 SET SDECY="^TMP(""SDECCAP"","_$JOB_",""CAPSET"")"
- +15 KILL @SDECY
- +16 SET @SDECY@(SDECI)="T00030REQIEN^T00030IEN^T00030NAME^T00030DATE^T00030EXISTS_T00250APPT_LINKS"_$CHAR(30)
- +17 ;validate DFN
- +18 SET DFN=$GET(DFN)
- +19 IF ('+DFN)!('$DATA(^DPT(+DFN,0)))
- SET @SDECY@(1)="-1^Invalid patient ID."_$CHAR(30,31)
- QUIT
- +20 ;validate SDCL
- +21 SET SDCL=$GET(SDCL)
- +22 IF ('+SDCL)!('$DATA(^SC(+SDCL,0)))
- SET @SDECY@(1)="-1^Invalid clinic ID."_$CHAR(30,31)
- QUIT
- +23 ;validate SDT
- +24 SET SDT=$GET(SDT)
- +25 SET %DT="RXT"
- SET X=SDT
- DO ^%DT
- SET SDT=Y
- +26 IF SDT=-1
- SET @SDECY@(1)="-1^Invalid appointment date/time."_$CHAR(30,31)
- QUIT
- +27 SET SDDA=0
- FOR
- SET SDDA=$ORDER(^SC(SDCL,"S",SDT,1,SDDA))
- if SDDA'>0
- QUIT
- if $PIECE($GET(^SC(SDCL,"S",SDT,1,SDDA,0)),U,1)=DFN
- QUIT
- +28 IF SDDA=""
- SET @SDECY@(1)="-1^Appointment not found."_$CHAR(30,31)
- QUIT
- +29 ;CAN^SDCNP0
- SET (SDHDL,SDCPHDL)=$$HANDLE^SDAMEVT(1)
- DO BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,"",SDCPHDL)
- +30 ;D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,0,SDCPHDL) ;EVT^SDCNP0
- +31 ;CANCEL^SDAMEVT
- DO AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
- +32 SET SDATA=SDDA_U_DFN_U_SDT_U_SDCL
- +33 DO EVT(.SDATA,SDAMEVT,0,SDCPHDL)
- +34 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
- +35 QUIT
- +36 ;
- ENCAN ;from DVBCCNNS
- +1 NEW DVBAAPDA,DVBAAUTO,DVBACURA,DVBAFND,DVBALKDA,DVBARQDA,DVBASTAT,DVBAUPDT
- +2 NEW LNKCNT
- +3 SET DVBASTAT=$$SDEVTSPC^DVBCUTL5(2)
- +4 ;**Get the date being canceled
- SET DVBACURA=$PIECE(SDATA,U,3)
- +5 SET (DVBAAPDA,DVBALKDA)=""
- +6 SET DVBAUPDT=0
- +7 KILL DVBAFND
- +8 SET LNKCNT=0
- +9 FOR
- SET DVBAAPDA=$ORDER(^DVB(396.95,"CD",DVBACURA,DVBAAPDA))
- if (DVBAAPDA="")
- QUIT
- Begin DoDot:1
- +10 SET DVBARQDA=$PIECE(^DVB(396.95,DVBAAPDA,0),U,6)
- +11 IF ($PIECE(^DVB(396.3,DVBARQDA,0),U,1)=DFN)
- Begin DoDot:2
- +12 SET LNKCNT=LNKCNT+1
- +13 if (+$PIECE(^DVB(396.95,DVBAAPDA,0),U,7)=1)
- SET DVBAFND=""
- SET DVBALKDA=DVBAAPDA
- +14 IF '$DATA(DVBAFND)
- IF ($PIECE(^DVB(396.95,DVBAAPDA,0),U,8)>DVBAUPDT)
- Begin DoDot:3
- +15 ;**Keep latest cancel dte
- SET DVBAUPDT=$PIECE(^DVB(396.95,DVBAAPDA,0),U,8)
- +16 ;**Keep DA of rec last cancelled
- SET DVBALKDA=DVBAAPDA
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +17 IF (DVBASTAT="PCA")!((DVBASTAT="NA")!(DVBASTAT="CA"))
- SET DVBAAUTO=""
- +18 ;
- +19 ;** Appt not linked, enhnc dilog on, not processing in background
- +20 IF LNKCNT=0
- Begin DoDot:1
- +21 NEW DVBACROT,Y
- +22 ;
- +23 ; Change date/time conversion so midnight is handled properly. wtc 694 5/17/18
- +24 ;
- +25 ;
- SET DVBACROT=$$FMTONET^SDECDATE(DVBACURA)
- +26 ;S Y=DVBACURA X ^DD("DD") S DVBACROT=Y K Y
- +27 SET SDECI=SDECI+1
- SET @SDECY@(SDECI)="-2^Appointment "_DVBACROT_" was not linked to a 2507 request or was"
- +28 SET SDECI=SDECI+1
- SET @SDECY@(SDECI)=" manually rebooked and linked to another appointment."
- +29 SET SDECI=SDECI+1
- SET @SDECY@(SDECI)=" (If the appointment was manually rebooked, you do not want to auto-rebook.)"
- +30 SET SDECI=SDECI+1
- SET @SDECY@(SDECI)="If the appointment was not properly linked, it will need to be linked with the"
- +31 SET SDECI=SDECI+1
- SET @SDECY@(SDECI)=" AMIE/C&P appointment link management option."_$CHAR(30)
- End DoDot:1
- +32 ;I $D(DVBAAUTO),($D(DVBAFND)!('$D(DVBAFND)&(+LNKCNT>0))) DO ;**Auto-rbk
- +33 ;.S:(+$$SDEVTXST^DVBCUTL5=1) DVBAAPDT=$$SDEVTSPC^DVBCUTL5(10)
- +34 ;.K DVBAVTRQ ;**Set if appointment canceled by vet
- +35 ;.S:(DVBASTAT["P"!(DVBASTAT["N"&(DVBASTAT'="NT"))) DVBAVTRQ=""
- +36 ;.D RSCHAPT^DVBCMKLK(DVBALKDA,DVBAAPDT)
- +37 ;.D:((+$$ENHNC^DVBCUTA4=1)&('$D(ZTQUEUED))) CNCMSG
- +38 ;**Appt linked, not Auto
- IF '$DATA(DVBAAUTO)
- IF ($DATA(DVBAFND))
- Begin DoDot:1
- +39 DO CANCEL^DVBCCNNS
- +40 SET SDECI=SDECI+1
- SET @SDECY@(SDECI)="-2^The link has been updated."_$CHAR(30)
- +41 ;D:((+$$ENHNC^DVBCUTA4=1)&('$D(ZTQUEUED))) CNCMSG
- End DoDot:1
- +42 IF +LNKCNT>1
- Begin DoDot:1
- +43 SET SDECI=SDECI+1
- SET @SDECY@(SDECI)="-2^This C&P appointment has multiple links with the same Current Appt Date."
- +44 SET SDECI=SDECI+1
- SET @SDECY@(SDECI)=" Use the AMIE/C&P Appointment Link Management option to review and delete"
- +45 SET SDECI=SDECI+1
- SET @SDECY@(SDECI)=" any duplicate links."_$CHAR(30)
- End DoDot:1
- +46 DO KVARS^DVBCCNNS
- +47 QUIT