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 Dec 13, 2024@02:51:49 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
