| [613] | 1 | DVBCMKL2 ;ALB/GTS-AMIE APPT EVENT DRIVER-LINK RTN 2 ; 10/20/94 9:00 PM
|
|---|
| 2 | ;;2.7;AMIE;**17**;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 | LINKAPPT ;** Link C&P appt to 2507
|
|---|
| 12 | ;** Enhanced mode On - user prompted with checks
|
|---|
| 13 | ;** Enhanced mode Off - appointment added as new link
|
|---|
| 14 | I $D(^DVB(396.95,"AR",DVBADA)),(+$$ENHNC^DVBCUTA4=1) DO
|
|---|
| 15 | .S DIR("A",1)=" "
|
|---|
| 16 | .S DIR("A",2)="This 2507 already has appointments."
|
|---|
| 17 | .S DIR("A",3)=" Enter '?' for help"
|
|---|
| 18 | .S DIR("A")="Is this appointment due to a cancellation? "
|
|---|
| 19 | .S DIR("?",1)="Enter NO if the appointment is not a reschedule of another appointment"
|
|---|
| 20 | .S DIR("?",2)=" made previously. Enter YES if the appointment is being scheduled because"
|
|---|
| 21 | .S DIR("?")=" an appointment has been or will be canceled."
|
|---|
| 22 | .S DIR(0)="YA^^"
|
|---|
| 23 | .S DIR("B")="NO"
|
|---|
| 24 | .S Y=""
|
|---|
| 25 | .F Q:(Y=1!(Y=0)!($D(DTOUT))) DO
|
|---|
| 26 | ..D ^DIR
|
|---|
| 27 | ..W:Y="^" *7," '^' NOT ALLOWED"
|
|---|
| 28 | .S DVBAYANS=+Y
|
|---|
| 29 | .K DIR,Y
|
|---|
| 30 | .I +DVBAYANS=1 DO ;**Appt link selection
|
|---|
| 31 | ..S DVBALKRC=$$SELLNK^DVBCUTL8(DVBADA)
|
|---|
| 32 | ..I +DVBALKRC'>0 DO ;**Appt not selected for reschedule
|
|---|
| 33 | ...S DIR("A",1)=" "
|
|---|
| 34 | ...S DIR("A",2)="You have not selected the linked appointment being rescheduled. You may"
|
|---|
| 35 | ...S DIR("A",3)=" need to adjust the link to the appointment with the AMIE link"
|
|---|
| 36 | ...S DIR("A",4)=" management option to ensure proper processing time calculation for this 2507."
|
|---|
| 37 | ...S DIR("A",5)=" "
|
|---|
| 38 | ...S DIR(0)="FAO^1:1",DIR("A")="Hit any key to continue." D ^DIR K DIR,X,Y
|
|---|
| 39 | ..I +DVBALKRC>0 DO ;**Appt selected for reschedule
|
|---|
| 40 | ...I +$P(^DVB(396.95,DVBALKRC,0),U,4)'=1!($P(^DVB(396.95,DVBALKRC,0),U,5)'="") DO
|
|---|
| 41 | ....K DIR,X,Y
|
|---|
| 42 | ....S DIR("?",1)="Enter Yes if the veteran requested a reschedule or 'No Showed' the appointment"
|
|---|
| 43 | ....S DIR("?")="Enter No if the Clinic required a reschedule."
|
|---|
| 44 | ....S DIR("A")="Is this appointment due to a veteran requested cancellation or 'No Show'"
|
|---|
| 45 | ....S DIR(0)="Y^AO" D ^DIR I $D(DTOUT)!($D(DUOUT)) S DVBAGETO=""
|
|---|
| 46 | ....K DIR,DTOUT,DUOUT
|
|---|
| 47 | ....I '$D(DVBAGETO) S:+Y=1 DVBAVTRQ="" DO
|
|---|
| 48 | .....D UPDTLK ;**Reschedule appt
|
|---|
| 49 | ....I $D(DVBAGETO) DO ;**Time or '^' out
|
|---|
| 50 | .....K Y,DIR,DTOUT,DUOUT
|
|---|
| 51 | .....S DIR("A",1)=" "
|
|---|
| 52 | .....S DIR("A",2)="You have not indicated if the reschedule was due to action by the veteran."
|
|---|
| 53 | .....S DIR("A",3)="The new appointment will not be linked. You will need to adjust"
|
|---|
| 54 | .....S DIR("A",4)="the link for this appointment with the AMIE/C&P appointment link management"
|
|---|
| 55 | .....S DIR("A",5)="option to ensure proper processing time calculation for this 2507."
|
|---|
| 56 | .....S DIR("A",6)=" "
|
|---|
| 57 | .....S DIR(0)="FAO^1:1",DIR("A")="Hit any key to continue."
|
|---|
| 58 | .....D ^DIR K DIR,X,Y
|
|---|
| 59 | ....K DVBAGETO
|
|---|
| 60 | ...I +$P(^DVB(396.95,DVBALKRC,0),U,4)=1&($P(^DVB(396.95,DVBALKRC,0),U,5)="") S DVBAVTRQ="" D UPDTLK ;**Vet cancel and no vet req date - reschd appt
|
|---|
| 61 | .I +DVBAYANS'=1 DO CRTREC^DVBCMKLK ;**Create new appt tracking record
|
|---|
| 62 | ;
|
|---|
| 63 | ;**No appointments exist for 2507 or enhanced dialogue Off
|
|---|
| 64 | I '$D(^DVB(396.95,"AR",DVBADA))!(+$$ENHNC^DVBCUTA4'=1) DO CRTREC^DVBCMKLK
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | UPDTLK ;** Update selected 396.95 link
|
|---|
| 68 | S DVBARSAP=$P(^DVB(396.95,DVBALKRC,0),U,3)
|
|---|
| 69 | K Y,DIR D RSCHAPT^DVBCMKLK(DVBALKRC,$P(SDATA,U,3))
|
|---|
| 70 | K DVBAVTRQ
|
|---|
| 71 | N DVBAAPST
|
|---|
| 72 | S DVBAAPST=$P(^DPT(DVBADFN,"S",DVBARSAP,0),U,2)
|
|---|
| 73 | I DVBAAPST="NT"!(DVBAAPST="I"!(DVBAAPST="")) DO
|
|---|
| 74 | .N DVBAAPIN S DVBAAPIN=DVBARSAP
|
|---|
| 75 | .S Y=DVBARSAP X ^DD("DD")
|
|---|
| 76 | .S DVBARSAP=Y K Y
|
|---|
| 77 | .S DIR("A",1)=" "
|
|---|
| 78 | .S DIR("A",2)="Remember to cancel the appointment for "_DVBARSAP
|
|---|
| 79 | .S DIR("A",3)=" and do NOT auto-rebook."
|
|---|
| 80 | .S DIR("A",4)=" "
|
|---|
| 81 | .S DIR("A")="Hit Return to continue"
|
|---|
| 82 | .S DIR(0)="FAO^1:1"
|
|---|
| 83 | .D:$P(SDATA,U,3)'=DVBAAPIN ^DIR
|
|---|
| 84 | .K DIR,Y,DVBARSAP
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | LINKHLP ;** Indentifier info for selected links
|
|---|
| 88 | N DVBACLNC,DVBADTE,DVBATIME,DVBADTWK,DVBAX
|
|---|
| 89 | S DVBACLNC=$P(^DPT(DVBADFN,"S",$P(^DVB(396.95,+Y,0),U,3),0),U,1)
|
|---|
| 90 | S DVBACLNC=$P(^SC(DVBACLNC,0),U,1)
|
|---|
| 91 | S DVBADTWK=$P(^DVB(396.95,+Y,0),U,3) ;**Get current date
|
|---|
| 92 | S DVBATIME=$P(DVBADTWK,".",2)
|
|---|
| 93 | S DVBADTWK=$P(DVBADTWK,".",1)
|
|---|
| 94 | S DVBADTE=$$FMTE^XLFDT(DVBADTWK,"5DZ")
|
|---|
| 95 | F DVBAX=$L(DVBATIME):1:3 S DVBATIME=DVBATIME_"0"
|
|---|
| 96 | S DVBATIME=$E(DVBATIME,1,2)_":"_$E(DVBATIME,3,4)
|
|---|
| 97 | S DVBADTE=DVBADTE_" @ "_DVBATIME
|
|---|
| 98 | W ?23,"Currently: ",DVBADTE,?59,DVBACLNC
|
|---|
| 99 | Q
|
|---|
