source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCCNNS.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1DVBCCNNS ;ALB/GTS-AMIE C&P APPT EVENT DRIVER ; 10/20/94 9:30 PM
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;
4 ;** NOTICE: This routine is part of an implementation of a Nationally
5 ;** Controlled Procedure. Local modifications to this routine
6 ;** are prohibited per VHA Directive 10-93-142
7 ;
8 ;** Version Changes
9 ; 2.7 - New routine (Enhc 13)
10 ;
11 ;** Variable Descriptions
12 ;** DVBAAUTO - prevents AMIE Make Event on an Auto-rebook
13 ;** NOTE: DVBAAUTO killed by ^DVBCSDEV
14 ;** DVBASTAT - Status of appointment being canceled/no showed
15 ;** DVBACURA - Appointment date/time being canceled/no showed
16 ;** DVBAAPDA - IEN of record in file 396.95
17 ;** DVBAFND - Defined if appt canceled/no showed found in 396.95
18 ;** DVBAAPDT - New appt date on auto-rebook
19 ;** DVBAVTRQ - Defined if appt canceled by vet
20 ;** DVBACROT - External value of DVBACURA
21 ;** LNKCNT - # of link records with current date = canceled date
22 ;** DVBAUPDT - Last dte cncl'd - cncled 396.95 recs, Cur Dte=cncl dt
23 ;
24EN ;**Find the respective AMIE appointment record
25 S DVBASTAT=$$SDEVTSPC^DVBCUTL5(2)
26 S DVBACURA=$P(SDATA,U,3) ;**Get the date being canceled
27 S (DVBAAPDA,DVBALKDA)=""
28 S DVBAUPDT=0
29 K DVBAFND
30 S LNKCNT=0
31 F S DVBAAPDA=$O(^DVB(396.95,"CD",DVBACURA,DVBAAPDA)) Q:(DVBAAPDA="") DO
32 .S DVBARQDA=$P(^DVB(396.95,DVBAAPDA,0),U,6)
33 .I ($P(^DVB(396.3,DVBARQDA,0),U,1)=DFN) DO
34 ..S LNKCNT=LNKCNT+1
35 ..S:(+$P(^DVB(396.95,DVBAAPDA,0),U,7)=1) DVBAFND="",DVBALKDA=DVBAAPDA
36 ..I '$D(DVBAFND),($P(^DVB(396.95,DVBAAPDA,0),U,8)>DVBAUPDT) DO
37 ...S DVBAUPDT=$P(^DVB(396.95,DVBAAPDA,0),U,8) ;**Keep latest cancel dte
38 ...S DVBALKDA=DVBAAPDA ;**Keep DA of rec last cancelled
39 I (DVBASTAT="PCA")!((DVBASTAT="NA")!(DVBASTAT="CA")) S DVBAAUTO=""
40 ;
41 ;** Appt not linked, enhnc dilog on, not processing in background
42 I (LNKCNT=0)&((+$$ENHNC^DVBCUTA4=1)&('$D(ZTQUEUED))) DO
43 .N DVBACROT S Y=DVBACURA X ^DD("DD") S DVBACROT=Y K Y
44 .S DIR("A",1)=" "
45 .S DIR("A",2)="Appointment "_DVBACROT_" was not linked to a 2507 request or was"
46 .S DIR("A",3)=" manually rebooked and linked to another appointment."
47 .S DIR("A",4)=" (If the appointment was manually rebooked, you do not want to auto-rebook.)"
48 .S DIR("A",5)=" "
49 .S DIR("A",6)="If the appointment was not properly linked, it will need to be linked with the"
50 .S DIR("A",7)=" AMIE/C&P appointment link management option."
51 .S DIR("A",8)=" "
52 .S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue." D ^DIR K DIR,X,Y
53 I $D(DVBAAUTO),($D(DVBAFND)!('$D(DVBAFND)&(+LNKCNT>0))) DO ;**Auto-rbk
54 .S:(+$$SDEVTXST^DVBCUTL5=1) DVBAAPDT=$$SDEVTSPC^DVBCUTL5(10)
55 .K DVBAVTRQ ;**Set if appointment canceled by vet
56 .S:(DVBASTAT["P"!(DVBASTAT["N"&(DVBASTAT'="NT"))) DVBAVTRQ=""
57 .D RSCHAPT^DVBCMKLK(DVBALKDA,DVBAAPDT)
58 .D:((+$$ENHNC^DVBCUTA4=1)&('$D(ZTQUEUED))) CNCMSG
59 I '$D(DVBAAUTO),($D(DVBAFND)) DO ;**Appt linked, not Auto
60 .D CANCEL
61 .D:((+$$ENHNC^DVBCUTA4=1)&('$D(ZTQUEUED))) CNCMSG
62 I +LNKCNT>1 DO
63 .S DIR("A",1)=" "
64 .S DIR("A",2)="This C&P appointment has multiple links with the same Current Appt Date."
65 .S DIR("A",3)="Use the AMIE/C&P Appointment Link Management option to review and delete"
66 .S DIR("A",4)=" any duplicate links."
67 .S DIR("A",5)=" "
68 .S DIR(0)="FAO^1:1",DIR("A")="Hit any key to continue." D ^DIR K DIR,X,Y
69 D KVARS
70 Q
71 ;
72CNCMSG ;** Write message indicating link updated
73 N DVBAINIT,DVBACROT,DVBARBDT
74 K Y S Y=$P(^DVB(396.95,+DVBALKDA,0),U,1)
75 X ^DD("DD") S DVBAINIT=Y
76 K Y S Y=DVBACURA
77 X ^DD("DD") S DVBACROT=Y K Y
78 I $D(DVBAAUTO) DO
79 .S Y=DVBAAPDT
80 .X ^DD("DD") S DVBARBDT=Y K Y
81 S DIR("A",1)=" "
82 S DIR("A",2)="AMIE C&P Appt Link update"
83 S DIR("A",3)="Initial Appt Date: "_DVBAINIT
84 S DIR("A",4)="Current Appt Date: "_DVBACROT
85 S:'$D(DVBAAUTO) DIR("A",5)="has been cancelled!"
86 S:$D(DVBAAUTO) DIR("A",5)="has been cancelled and rebooked for "_DVBARBDT_"!"
87 S DIR("A",6)=" "
88 S DIR(0)="FAO^1:1",DIR("A")="Hit any key to continue." D ^DIR K DIR,X,Y
89 Q
90 ;
91CANCEL ;** Cancel C&P Appt
92 N DVBCUPDT
93 D NOW^%DTC
94 S DVBCUPDT=%
95 K %,X
96 S DA=+DVBALKDA,DIE="^DVB(396.95,",DR=""
97 I DVBASTAT["PC"!(DVBASTAT["N"&(DVBASTAT'="NT")) DO
98 .S DR=".04////^S X=1;" ;** Set .04 if vet cancel
99 S DR=DR_".07////^S X=0;.08////^S X=DVBCUPDT"
100 D ^DIE K DA,DIE,DR
101 Q
102 ;
103KVARS ;
104 K DVBAAPDA,DVBAFND,DVBCCURA,DVBASTAT,DVBAAPDT,DVBARQDA
105 K DVBAVTRQ,DVBALKDA,LNKCNT,DVBAUPDT
106 Q
Note: See TracBrowser for help on using the repository browser.