SDEC58 ;ALB/SAT - VISTA SCHEDULING RPCS ;APR 08, 2016
;;5.3;Scheduling;**627,642**;Aug 13, 1993;Build 23
;
Q
;
;Compensation & Pension Appointments RPC
;SDECY = global variable return
;DFN = patient IEN (required)
;SDAMEVT = event type (1=make appt,2=cancel,3=no show) (required)
;SDT = original appt date/time (required)
;SDAUTORB = set to 1 if auto rebook (optional)
;SDCANVET = set to 1 if appt cancelled by VET (optional)
CAP(SDECY,DFN,SDAMEVT,SDT,SDAUTORB,SDCANVET) ;
;** Variable Descriptions
;** SDAMEVT = 1 Make appointment event
;** 2 Cancel appointment event
;** 3 No Show appointment event
;** I DVBAAUTO exists, AMIE Make Event is not executed because
;** cancel/no show part of auto-rebook updated 396.95
;** SDT = Time In
EN ;**AMIE Scheduling event driver main entry point
N SDECI,DVBADFN,SDERR
S SDECY="^TMP(""SDEC58"","_$J_",""CAP"")"
K @SDECY
S SDECI=0,SDERR=0
S @SDECY@(SDECI)="T00020RETURNCODE^T00100TEXT"_$C(30)
I $G(DFN)']"" S SDECI=SDECI+1,@SDECY@(SDECI)="-1^Invalid Patient DFN"_$C(30) S SDERR=1 G XIT
I $G(SDT)']"" S SDECI=SDECI+1,@SDECY@(SDECI)="-1^Invalid Original Appt Date and Time"_$C(30) S SDERR=1 G XIT
;auto rebook variable
S:+$G(SDAUTORB) DVBAAUTO=""
;appt cancelled by VET variable
S:+$G(SDCANVET) DVBAVTRQ=""
S DVBATYPE=$P($G(^DPT(DFN,"S",SDT,0)),U,16)
;appt type must be COMPENSATION & PENSION
I +DVBATYPE=1 D
.I +SDAMEVT=1,('$D(DVBAAUTO)) D EN1 ;** Original Make event (SDAMEVT=1)
.I +SDAMEVT=1,($D(DVBAAUTO)) K DVBAAUTO ;** Auto-rebook Make event (SDAMEVT=1)
.I +SDAMEVT=2!(+SDAMEVT=3) D EN2 ;** Cancel/No show event (SDAMEVT=2 or 3)
K DVBATYPE
S:SDERR=0 SDECI=SDECI+1,@SDECY@(SDECI)="0^No Error"_$C(30)
XIT ;
S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)
D KVARS
Q
EN1 ;
S DVBADFN=DFN,DVBASTAT="P" ;DVBASTAT used in REQARY^DVBCUTL5
D GETIEN
Q:SDERR=1
D LINKAPPT
D KVARS
Q
LINKAPPT ;
;**No appointments exist for 2507
I '$D(^DVB(396.95,"AR",DVBADA)) D CRTREC
Q
CRTREC ;
S DVBAADT=SDT
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
KVARS ;** Kill variables used by scheduling protocol
K DVBADA,DVBASTAT,SDAUTORB,SDCANVET,Y
Q
EN2 ;
;**Find the respective AMIE appointment record
S DVBASTAT=$P($G(^DPT(DFN,"S",SDT,0)),U,2)
;**Get the date being canceled
S DVBACURA=SDT
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=""
;
;auto-rbk
I $D(DVBAAUTO),($D(DVBAFND)!('$D(DVBAFND)&(+LNKCNT>0))) D
.S DVBAAPDT=$P($G(^DPT(DFN,"S",SDT,0)),U,10)
.K DVBAVTRQ ;**Set if appointment canceled by vet
.S:(DVBASTAT["P"!(DVBASTAT["N"&(DVBASTAT'="NT"))) DVBAVTRQ=""
.;Update Appt record with reschedule data
.D RSCHAPT(DVBALKDA,DVBAAPDT)
I '$D(DVBAAUTO),$D(DVBAFND) D ;**Appt linked, not Auto
.D CANCEL
I +LNKCNT>1 D
.S SDECI=SDECI+1,@SDECY@(SDECI)="-1^This C&P appointment has multiple links with the same Current Appt Date."_$C(30)
.S SDERR=1
D KVARS2
Q
KVARS2 ;
K DVBAAPDA,DVBAFND,DVBASTAT,DVBAAPDT,DVBARQDA
K DVBAVTRQ,DVBALKDA,LNKCNT,DVBAUPDT,DVBACURA
Q
CANCEL ;** Cancel C&P Appt
N DVBCUPDT
D NOW^%DTC
S DVBCUPDT=%
K %,X
S DA=+DVBALKDA,DIE="^DVB(396.95,",DR=""
I DVBASTAT["PC"!(DVBASTAT["N"&(DVBASTAT'="NT")) D
.S DR=".04////^S X=1;" ;** Set .04 if vet cancel
S DR=DR_".07////^S X=0;.08////^S X=DVBCUPDT"
D ^DIE K DA,DIE,DR
Q
;
RSCHAPT(LKDA,RSCHDT) ;** Update Appt record with reschedule data
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
;
GETIEN ;Get IEN for 2507 REQUEST file
N DVBACNT,DVBADT,DVBAORD,DVBASDPR
K ^TMP("DVBC",$J)
S (DVBADA,DVBASDPR)=""
D REQARY^DVBCUTL5 ;**Set up ^TMP of AMIE 2507's
I +DVBACNT>0 D
.I +DVBACNT=1 D ;**Auto select 2507 if only one exists
..S (DVBADT,DVBADA,DVBAORD)=""
..S DVBAORD=$O(^TMP("DVBC",$J,DVBAORD))
..S DVBADT=$O(^TMP("DVBC",$J,DVBAORD,DVBADT))
..S DVBADA=$O(^TMP("DVBC",$J,DVBAORD,DVBADT,DVBADA))
.I +DVBACNT>1 D ;**If more than one 2507 exists
..S SDECI=SDECI+1,@SDECY@(SDECI)="-1^More than one 2507 request exisits for this patient!"_$C(30)
..S SDERR=1
.K ^TMP("DVBC",$J)
.Q:SDERR=1
.I '$D(^DVB(396.3,+DVBADA,0)),(+$$ENHNC^DVBCUTA4=1) D Q ;**Write warning
..S SDECI=SDECI+1,@SDECY@(SDECI)="-1^You have not selected a 2507 request to link the C&P appointment to."_$C(30)
..S SDECI=SDECI+1,@SDECY@(SDECI)="-1^ The appointment should be linked with the AMIE/C&P Appointment Link"_$C(30)
..S SDECI=SDECI+1,@SDECY@(SDECI)="-1^ Management Option to ensure proper processing time calculation for this 2507"_$C(30)
..S SDECI=SDECI+1,@SDECY@(SDECI)="-1^ in the event of a veteran cancellation."_$C(30)
..S SDERR=1
.I $D(^DVB(396.3,+DVBADA,0)) D LINKAPPT ;**If 2507, link appt
I +DVBACNT'>0,(+$$ENHNC^DVBCUTA4=1) D ;**Write Warning
.S SDECI=SDECI+1,@SDECY@(SDECI)="-1^You have made a C&P appointment for a patient who has no pending 2507 request!"_$C(30)
.S SDERR=1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC58 5840 printed Dec 13, 2024@02:50:58 Page 2
SDEC58 ;ALB/SAT - VISTA SCHEDULING RPCS ;APR 08, 2016
+1 ;;5.3;Scheduling;**627,642**;Aug 13, 1993;Build 23
+2 ;
+3 QUIT
+4 ;
+5 ;Compensation & Pension Appointments RPC
+6 ;SDECY = global variable return
+7 ;DFN = patient IEN (required)
+8 ;SDAMEVT = event type (1=make appt,2=cancel,3=no show) (required)
+9 ;SDT = original appt date/time (required)
+10 ;SDAUTORB = set to 1 if auto rebook (optional)
+11 ;SDCANVET = set to 1 if appt cancelled by VET (optional)
CAP(SDECY,DFN,SDAMEVT,SDT,SDAUTORB,SDCANVET) ;
+1 ;** Variable Descriptions
+2 ;** SDAMEVT = 1 Make appointment event
+3 ;** 2 Cancel appointment event
+4 ;** 3 No Show appointment event
+5 ;** I DVBAAUTO exists, AMIE Make Event is not executed because
+6 ;** cancel/no show part of auto-rebook updated 396.95
+7 ;** SDT = Time In
EN ;**AMIE Scheduling event driver main entry point
+1 NEW SDECI,DVBADFN,SDERR
+2 SET SDECY="^TMP(""SDEC58"","_$JOB_",""CAP"")"
+3 KILL @SDECY
+4 SET SDECI=0
SET SDERR=0
+5 SET @SDECY@(SDECI)="T00020RETURNCODE^T00100TEXT"_$CHAR(30)
+6 IF $GET(DFN)']""
SET SDECI=SDECI+1
SET @SDECY@(SDECI)="-1^Invalid Patient DFN"_$CHAR(30)
SET SDERR=1
GOTO XIT
+7 IF $GET(SDT)']""
SET SDECI=SDECI+1
SET @SDECY@(SDECI)="-1^Invalid Original Appt Date and Time"_$CHAR(30)
SET SDERR=1
GOTO XIT
+8 ;auto rebook variable
+9 if +$GET(SDAUTORB)
SET DVBAAUTO=""
+10 ;appt cancelled by VET variable
+11 if +$GET(SDCANVET)
SET DVBAVTRQ=""
+12 SET DVBATYPE=$PIECE($GET(^DPT(DFN,"S",SDT,0)),U,16)
+13 ;appt type must be COMPENSATION & PENSION
+14 IF +DVBATYPE=1
Begin DoDot:1
+15 ;** Original Make event (SDAMEVT=1)
IF +SDAMEVT=1
IF ('$DATA(DVBAAUTO))
DO EN1
+16 ;** Auto-rebook Make event (SDAMEVT=1)
IF +SDAMEVT=1
IF ($DATA(DVBAAUTO))
KILL DVBAAUTO
+17 ;** Cancel/No show event (SDAMEVT=2 or 3)
IF +SDAMEVT=2!(+SDAMEVT=3)
DO EN2
End DoDot:1
+18 KILL DVBATYPE
+19 if SDERR=0
SET SDECI=SDECI+1
SET @SDECY@(SDECI)="0^No Error"_$CHAR(30)
XIT ;
+1 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)
+2 DO KVARS
+3 QUIT
EN1 ;
+1 ;DVBASTAT used in REQARY^DVBCUTL5
SET DVBADFN=DFN
SET DVBASTAT="P"
+2 DO GETIEN
+3 if SDERR=1
QUIT
+4 DO LINKAPPT
+5 DO KVARS
+6 QUIT
LINKAPPT ;
+1 ;**No appointments exist for 2507
+2 IF '$DATA(^DVB(396.95,"AR",DVBADA))
DO CRTREC
+3 QUIT
CRTREC ;
+1 SET DVBAADT=SDT
+2 SET DIC="^DVB(396.95,"
SET X=DVBAADT
SET DIC(0)="LX"
SET DLAYGO="396.95"
+3 SET DIC("DR")=".02////^S X=DVBAADT;.03////^S X=DVBAADT;"
+4 SET DIC("DR")=DIC("DR")_".04////^S X=0;.06////^S X=DVBADA;"
+5 SET DIC("DR")=DIC("DR")_".07////^S X=1"
+6 DO FILE^DICN
+7 KILL DIC,X,DLAYGO,DVBAADT
+8 QUIT
KVARS ;** Kill variables used by scheduling protocol
+1 KILL DVBADA,DVBASTAT,SDAUTORB,SDCANVET,Y
+2 QUIT
EN2 ;
+1 ;**Find the respective AMIE appointment record
+2 SET DVBASTAT=$PIECE($GET(^DPT(DFN,"S",SDT,0)),U,2)
+3 ;**Get the date being canceled
+4 SET DVBACURA=SDT
+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 ;auto-rbk
+20 IF $DATA(DVBAAUTO)
IF ($DATA(DVBAFND)!('$DATA(DVBAFND)&(+LNKCNT>0)))
Begin DoDot:1
+21 SET DVBAAPDT=$PIECE($GET(^DPT(DFN,"S",SDT,0)),U,10)
+22 ;**Set if appointment canceled by vet
KILL DVBAVTRQ
+23 if (DVBASTAT["P"!(DVBASTAT["N"&(DVBASTAT'="NT")))
SET DVBAVTRQ=""
+24 ;Update Appt record with reschedule data
+25 DO RSCHAPT(DVBALKDA,DVBAAPDT)
End DoDot:1
+26 ;**Appt linked, not Auto
IF '$DATA(DVBAAUTO)
IF $DATA(DVBAFND)
Begin DoDot:1
+27 DO CANCEL
End DoDot:1
+28 IF +LNKCNT>1
Begin DoDot:1
+29 SET SDECI=SDECI+1
SET @SDECY@(SDECI)="-1^This C&P appointment has multiple links with the same Current Appt Date."_$CHAR(30)
+30 SET SDERR=1
End DoDot:1
+31 DO KVARS2
+32 QUIT
KVARS2 ;
+1 KILL DVBAAPDA,DVBAFND,DVBASTAT,DVBAAPDT,DVBARQDA
+2 KILL DVBAVTRQ,DVBALKDA,LNKCNT,DVBAUPDT,DVBACURA
+3 QUIT
CANCEL ;** Cancel C&P Appt
+1 NEW DVBCUPDT
+2 DO NOW^%DTC
+3 SET DVBCUPDT=%
+4 KILL %,X
+5 SET DA=+DVBALKDA
SET DIE="^DVB(396.95,"
SET DR=""
+6 IF DVBASTAT["PC"!(DVBASTAT["N"&(DVBASTAT'="NT"))
Begin DoDot:1
+7 ;** Set .04 if vet cancel
SET DR=".04////^S X=1;"
End DoDot:1
+8 SET DR=DR_".07////^S X=0;.08////^S X=DVBCUPDT"
+9 DO ^DIE
KILL DA,DIE,DR
+10 QUIT
+11 ;
RSCHAPT(LKDA,RSCHDT) ;** Update Appt record with reschedule data
+1 SET DA=+LKDA
SET DIE="^DVB(396.95,"
SET DR=".03////^S X=RSCHDT;.07////1"
+2 if (+$PIECE(^DVB(396.95,DA,0),U,4)=0&('$DATA(DVBAVTRQ)))
SET DR=".02////^S X=RSCHDT;"_DR
+3 if ($DATA(DVBAVTRQ))
SET DR=".04////^S X=1;.05////^S X=RSCHDT;"_DR
+4 DO ^DIE
KILL DA,DIE,DR
+5 QUIT
+6 ;
GETIEN ;Get IEN for 2507 REQUEST file
+1 NEW DVBACNT,DVBADT,DVBAORD,DVBASDPR
+2 KILL ^TMP("DVBC",$JOB)
+3 SET (DVBADA,DVBASDPR)=""
+4 ;**Set up ^TMP of AMIE 2507's
DO REQARY^DVBCUTL5
+5 IF +DVBACNT>0
Begin DoDot:1
+6 ;**Auto select 2507 if only one exists
IF +DVBACNT=1
Begin DoDot:2
+7 SET (DVBADT,DVBADA,DVBAORD)=""
+8 SET DVBAORD=$ORDER(^TMP("DVBC",$JOB,DVBAORD))
+9 SET DVBADT=$ORDER(^TMP("DVBC",$JOB,DVBAORD,DVBADT))
+10 SET DVBADA=$ORDER(^TMP("DVBC",$JOB,DVBAORD,DVBADT,DVBADA))
End DoDot:2
+11 ;**If more than one 2507 exists
IF +DVBACNT>1
Begin DoDot:2
+12 SET SDECI=SDECI+1
SET @SDECY@(SDECI)="-1^More than one 2507 request exisits for this patient!"_$CHAR(30)
+13 SET SDERR=1
End DoDot:2
+14 KILL ^TMP("DVBC",$JOB)
+15 if SDERR=1
QUIT
+16 ;**Write warning
IF '$DATA(^DVB(396.3,+DVBADA,0))
IF (+$$ENHNC^DVBCUTA4=1)
Begin DoDot:2
+17 SET SDECI=SDECI+1
SET @SDECY@(SDECI)="-1^You have not selected a 2507 request to link the C&P appointment to."_$CHAR(30)
+18 SET SDECI=SDECI+1
SET @SDECY@(SDECI)="-1^ The appointment should be linked with the AMIE/C&P Appointment Link"_$CHAR(30)
+19 SET SDECI=SDECI+1
SET @SDECY@(SDECI)="-1^ Management Option to ensure proper processing time calculation for this 2507"_$CHAR(30)
+20 SET SDECI=SDECI+1
SET @SDECY@(SDECI)="-1^ in the event of a veteran cancellation."_$CHAR(30)
+21 SET SDERR=1
End DoDot:2
QUIT
+22 ;**If 2507, link appt
IF $DATA(^DVB(396.3,+DVBADA,0))
DO LINKAPPT
End DoDot:1
+23 ;**Write Warning
IF +DVBACNT'>0
IF (+$$ENHNC^DVBCUTA4=1)
Begin DoDot:1
+24 SET SDECI=SDECI+1
SET @SDECY@(SDECI)="-1^You have made a C&P appointment for a patient who has no pending 2507 request!"_$CHAR(30)
+25 SET SDERR=1
End DoDot:1
+26 QUIT
+27 ;
