DVBCCNNS ;ALB/GTS-AMIE C&P APPT EVENT DRIVER ; 10/20/94 9:30 PM
;;2.7;AMIE;;Apr 10, 1995
;
;** NOTICE: This routine is part of an implementation of a Nationally
;** Controlled Procedure. Local modifications to this routine
;** are prohibited per VHA Directive 10-93-142
;
;** Version Changes
; 2.7 - New routine (Enhc 13)
;
;** Variable Descriptions
;** DVBAAUTO - prevents AMIE Make Event on an Auto-rebook
;** NOTE: DVBAAUTO killed by ^DVBCSDEV
;** DVBASTAT - Status of appointment being canceled/no showed
;** DVBACURA - Appointment date/time being canceled/no showed
;** DVBAAPDA - IEN of record in file 396.95
;** DVBAFND - Defined if appt canceled/no showed found in 396.95
;** DVBAAPDT - New appt date on auto-rebook
;** DVBAVTRQ - Defined if appt canceled by vet
;** DVBACROT - External value of DVBACURA
;** LNKCNT - # of link records with current date = canceled date
;** DVBAUPDT - Last dte cncl'd - cncled 396.95 recs, Cur Dte=cncl dt
;
EN ;**Find the respective AMIE appointment record
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="") DO
.S DVBARQDA=$P(^DVB(396.95,DVBAAPDA,0),U,6)
.I ($P(^DVB(396.3,DVBARQDA,0),U,1)=DFN) DO
..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) DO
...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)&((+$$ENHNC^DVBCUTA4=1)&('$D(ZTQUEUED))) DO
.N DVBACROT S Y=DVBACURA X ^DD("DD") S DVBACROT=Y K Y
.S DIR("A",1)=" "
.S DIR("A",2)="Appointment "_DVBACROT_" was not linked to a 2507 request or was"
.S DIR("A",3)=" manually rebooked and linked to another appointment."
.S DIR("A",4)=" (If the appointment was manually rebooked, you do not want to auto-rebook.)"
.S DIR("A",5)=" "
.S DIR("A",6)="If the appointment was not properly linked, it will need to be linked with the"
.S DIR("A",7)=" AMIE/C&P appointment link management option."
.S DIR("A",8)=" "
.S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue." D ^DIR K DIR,X,Y
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)) DO ;**Appt linked, not Auto
.D CANCEL
.D:((+$$ENHNC^DVBCUTA4=1)&('$D(ZTQUEUED))) CNCMSG
I +LNKCNT>1 DO
.S DIR("A",1)=" "
.S DIR("A",2)="This C&P appointment has multiple links with the same Current Appt Date."
.S DIR("A",3)="Use the AMIE/C&P Appointment Link Management option to review and delete"
.S DIR("A",4)=" any duplicate links."
.S DIR("A",5)=" "
.S DIR(0)="FAO^1:1",DIR("A")="Hit any key to continue." D ^DIR K DIR,X,Y
D KVARS
Q
;
CNCMSG ;** Write message indicating link updated
N DVBAINIT,DVBACROT,DVBARBDT
K Y S Y=$P(^DVB(396.95,+DVBALKDA,0),U,1)
X ^DD("DD") S DVBAINIT=Y
K Y S Y=DVBACURA
X ^DD("DD") S DVBACROT=Y K Y
I $D(DVBAAUTO) DO
.S Y=DVBAAPDT
.X ^DD("DD") S DVBARBDT=Y K Y
S DIR("A",1)=" "
S DIR("A",2)="AMIE C&P Appt Link update"
S DIR("A",3)="Initial Appt Date: "_DVBAINIT
S DIR("A",4)="Current Appt Date: "_DVBACROT
S:'$D(DVBAAUTO) DIR("A",5)="has been cancelled!"
S:$D(DVBAAUTO) DIR("A",5)="has been cancelled and rebooked for "_DVBARBDT_"!"
S DIR("A",6)=" "
S DIR(0)="FAO^1:1",DIR("A")="Hit any key to continue." D ^DIR K DIR,X,Y
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")) DO
.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
;
KVARS ;
K DVBAAPDA,DVBAFND,DVBCCURA,DVBASTAT,DVBAAPDT,DVBARQDA
K DVBAVTRQ,DVBALKDA,LNKCNT,DVBAUPDT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCCNNS 4437 printed Oct 16, 2024@17:44:38 Page 2
DVBCCNNS ;ALB/GTS-AMIE C&P APPT EVENT DRIVER ; 10/20/94 9:30 PM
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 ;
+3 ;** NOTICE: This routine is part of an implementation of a Nationally
+4 ;** Controlled Procedure. Local modifications to this routine
+5 ;** are prohibited per VHA Directive 10-93-142
+6 ;
+7 ;** Version Changes
+8 ; 2.7 - New routine (Enhc 13)
+9 ;
+10 ;** Variable Descriptions
+11 ;** DVBAAUTO - prevents AMIE Make Event on an Auto-rebook
+12 ;** NOTE: DVBAAUTO killed by ^DVBCSDEV
+13 ;** DVBASTAT - Status of appointment being canceled/no showed
+14 ;** DVBACURA - Appointment date/time being canceled/no showed
+15 ;** DVBAAPDA - IEN of record in file 396.95
+16 ;** DVBAFND - Defined if appt canceled/no showed found in 396.95
+17 ;** DVBAAPDT - New appt date on auto-rebook
+18 ;** DVBAVTRQ - Defined if appt canceled by vet
+19 ;** DVBACROT - External value of DVBACURA
+20 ;** LNKCNT - # of link records with current date = canceled date
+21 ;** DVBAUPDT - Last dte cncl'd - cncled 396.95 recs, Cur Dte=cncl dt
+22 ;
EN ;**Find the respective AMIE appointment record
+1 SET DVBASTAT=$$SDEVTSPC^DVBCUTL5(2)
+2 ;**Get the date being canceled
SET DVBACURA=$PIECE(SDATA,U,3)
+3 SET (DVBAAPDA,DVBALKDA)=""
+4 SET DVBAUPDT=0
+5 KILL DVBAFND
+6 SET LNKCNT=0
+7 FOR
SET DVBAAPDA=$ORDER(^DVB(396.95,"CD",DVBACURA,DVBAAPDA))
if (DVBAAPDA="")
QUIT
Begin DoDot:1
+8 SET DVBARQDA=$PIECE(^DVB(396.95,DVBAAPDA,0),U,6)
+9 IF ($PIECE(^DVB(396.3,DVBARQDA,0),U,1)=DFN)
Begin DoDot:2
+10 SET LNKCNT=LNKCNT+1
+11 if (+$PIECE(^DVB(396.95,DVBAAPDA,0),U,7)=1)
SET DVBAFND=""
SET DVBALKDA=DVBAAPDA
+12 IF '$DATA(DVBAFND)
IF ($PIECE(^DVB(396.95,DVBAAPDA,0),U,8)>DVBAUPDT)
Begin DoDot:3
+13 ;**Keep latest cancel dte
SET DVBAUPDT=$PIECE(^DVB(396.95,DVBAAPDA,0),U,8)
+14 ;**Keep DA of rec last cancelled
SET DVBALKDA=DVBAAPDA
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF (DVBASTAT="PCA")!((DVBASTAT="NA")!(DVBASTAT="CA"))
SET DVBAAUTO=""
+16 ;
+17 ;** Appt not linked, enhnc dilog on, not processing in background
+18 IF (LNKCNT=0)&((+$$ENHNC^DVBCUTA4=1)&('$DATA(ZTQUEUED)))
Begin DoDot:1
+19 NEW DVBACROT
SET Y=DVBACURA
XECUTE ^DD("DD")
SET DVBACROT=Y
KILL Y
+20 SET DIR("A",1)=" "
+21 SET DIR("A",2)="Appointment "_DVBACROT_" was not linked to a 2507 request or was"
+22 SET DIR("A",3)=" manually rebooked and linked to another appointment."
+23 SET DIR("A",4)=" (If the appointment was manually rebooked, you do not want to auto-rebook.)"
+24 SET DIR("A",5)=" "
+25 SET DIR("A",6)="If the appointment was not properly linked, it will need to be linked with the"
+26 SET DIR("A",7)=" AMIE/C&P appointment link management option."
+27 SET DIR("A",8)=" "
+28 SET DIR(0)="FAO^1:1"
SET DIR("A")="Hit Return to continue."
DO ^DIR
KILL DIR,X,Y
End DoDot:1
+29 ;**Auto-rbk
IF $DATA(DVBAAUTO)
IF ($DATA(DVBAFND)!('$DATA(DVBAFND)&(+LNKCNT>0)))
Begin DoDot:1
+30 if (+$$SDEVTXST^DVBCUTL5=1)
SET DVBAAPDT=$$SDEVTSPC^DVBCUTL5(10)
+31 ;**Set if appointment canceled by vet
KILL DVBAVTRQ
+32 if (DVBASTAT["P"!(DVBASTAT["N"&(DVBASTAT'="NT")))
SET DVBAVTRQ=""
+33 DO RSCHAPT^DVBCMKLK(DVBALKDA,DVBAAPDT)
+34 if ((+$$ENHNC^DVBCUTA4=1)&('$DATA(ZTQUEUED)))
DO CNCMSG
End DoDot:1
+35 ;**Appt linked, not Auto
IF '$DATA(DVBAAUTO)
IF ($DATA(DVBAFND))
Begin DoDot:1
+36 DO CANCEL
+37 if ((+$$ENHNC^DVBCUTA4=1)&('$DATA(ZTQUEUED)))
DO CNCMSG
End DoDot:1
+38 IF +LNKCNT>1
Begin DoDot:1
+39 SET DIR("A",1)=" "
+40 SET DIR("A",2)="This C&P appointment has multiple links with the same Current Appt Date."
+41 SET DIR("A",3)="Use the AMIE/C&P Appointment Link Management option to review and delete"
+42 SET DIR("A",4)=" any duplicate links."
+43 SET DIR("A",5)=" "
+44 SET DIR(0)="FAO^1:1"
SET DIR("A")="Hit any key to continue."
DO ^DIR
KILL DIR,X,Y
End DoDot:1
+45 DO KVARS
+46 QUIT
+47 ;
CNCMSG ;** Write message indicating link updated
+1 NEW DVBAINIT,DVBACROT,DVBARBDT
+2 KILL Y
SET Y=$PIECE(^DVB(396.95,+DVBALKDA,0),U,1)
+3 XECUTE ^DD("DD")
SET DVBAINIT=Y
+4 KILL Y
SET Y=DVBACURA
+5 XECUTE ^DD("DD")
SET DVBACROT=Y
KILL Y
+6 IF $DATA(DVBAAUTO)
Begin DoDot:1
+7 SET Y=DVBAAPDT
+8 XECUTE ^DD("DD")
SET DVBARBDT=Y
KILL Y
End DoDot:1
+9 SET DIR("A",1)=" "
+10 SET DIR("A",2)="AMIE C&P Appt Link update"
+11 SET DIR("A",3)="Initial Appt Date: "_DVBAINIT
+12 SET DIR("A",4)="Current Appt Date: "_DVBACROT
+13 if '$DATA(DVBAAUTO)
SET DIR("A",5)="has been cancelled!"
+14 if $DATA(DVBAAUTO)
SET DIR("A",5)="has been cancelled and rebooked for "_DVBARBDT_"!"
+15 SET DIR("A",6)=" "
+16 SET DIR(0)="FAO^1:1"
SET DIR("A")="Hit any key to continue."
DO ^DIR
KILL DIR,X,Y
+17 QUIT
+18 ;
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 ;
KVARS ;
+1 KILL DVBAAPDA,DVBAFND,DVBCCURA,DVBASTAT,DVBAAPDT,DVBARQDA
+2 KILL DVBAVTRQ,DVBALKDA,LNKCNT,DVBAUPDT
+3 QUIT
