source: FOIAVistA/tag/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCUTL8.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.0 KB
Line 
1DVBCUTL8 ;ALB/GTS-AMIE C&P APPT LINK FILE MNT RTNS 2 ; 10/20/94 3: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 ;
11FIXLK ;** Re-attach unlinked appt to new appt
12 ;
13 ;** ^TMP("DVBC",$J,) must have nodes:
14 ;** ORIGINAL APPT DATE, CURRENT APPT DATE, VETERAN CANCELLATION,
15 ;** VETERAN REQ APPT DATE, APPOINTMENT STATUS = appt to be linked
16 ;
17 N REQDT,SAVY
18 S:$D(Y) SAVY=Y
19 S REQDT=$$GETDTE^DVBCMKLK(DVBADA) ;**Set REQDT
20 S:$D(SAVY) Y=SAVY
21 S DIR("A",1)="Adjusting C&P appointment link for 2507 request dated "_REQDT_"."
22 S DIR("A",2)=" "
23 S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue." D ^DIR K DIR,X,Y
24 N ORIGAPPT,CURRAPPT,VETCANC,APPTSTAT,APPTNODE,VETDTE,INITAPPT
25 S VETDTE=""
26 S ORIGAPPT=^TMP("DVBC",$J,"ORIGINAL APPT DATE")
27 S CURRAPPT=^TMP("DVBC",$J,"CURRENT APPT DATE")
28 S VETCANC=^TMP("DVBC",$J,"VETERAN CANCELLATION")
29 S:$D(^TMP("DVBC",$J,"VETERAN REQ APPT DATE")) VETDTE=^TMP("DVBC",$J,"VETERAN REQ APPT DATE")
30 S APPTSTAT=^TMP("DVBC",$J,"APPOINTMENT STATUS")
31 K DA,DIE,DR
32 ;
33 ;** Only one current appt date/time for vet can exist in 396.95
34 S DA="" S DA=DVBAOLDA
35 S APPTNODE=^DVB(396.95,DA,0) ;**APPTNODE 396.95 rec before mods
36 S DIE="^DVB(396.95,",DR=""
37 ;
38 ;** If 396.95 initial appt lost, set to original appt
39 I $P(APPTNODE,U,1)="",($P(APPTNODE,U,2)'="") S INITAPPT=$P(APPTNODE,U,2)
40 I $P(APPTNODE,U,1)="" S DR=".01////^S X=INITAPPT;"
41 I $P(APPTNODE,U,4)'=1 S DR=DR_".02////^S X=ORIGAPPT;"
42 S DR=DR_".03////^S X=CURRAPPT;"
43 I $P(APPTNODE,U,4)'=1 S DR=DR_".04////^S X=VETCANC;"
44 I VETCANC=1 S DR=DR_".05////^S X=VETDTE;" ;**Update last vet req date
45 S DR=DR_".07////^S X=APPTSTAT"
46 D ^DIE K DIE,DA,DR
47 Q
48 ;
49ADDLK ;** Add link from 2507 to appt
50 ;
51 ;** ^TMP("DVBC",$J,) nodes:
52 ;** ORIGINAL APPT DATE, CURRENT APPT DATE, VETERAN CANCELLATION,
53 ;** VETERAN REQ APPT DATE, APPOINTMENT STATUS = appt to be linked
54 ;
55 N REQDT,SAVY
56 S:$D(Y) SAVY=Y
57 S REQDT=$$GETDTE^DVBCMKLK(DVBADA) ;**Set REQDT
58 S:$D(SAVY) Y=SAVY
59 S DIR("A",1)="Adding new C&P appointment link for 2507 request dated "_REQDT_"."
60 S DIR("A",2)=" "
61 S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue." D ^DIR K DIR,X,Y
62 N ORIGAPPT,CURRAPPT,VETCANC,APPTSTAT,APPTNODE,VETDTE
63 S VETDTE=""
64 S ORIGAPPT=^TMP("DVBC",$J,"ORIGINAL APPT DATE")
65 S CURRAPPT=^TMP("DVBC",$J,"CURRENT APPT DATE")
66 S VETCANC=^TMP("DVBC",$J,"VETERAN CANCELLATION")
67 S:$D(^TMP("DVBC",$J,"VETERAN REQ APPT DATE")) VETDTE=^TMP("DVBC",$J,"VETERAN REQ APPT DATE")
68 S APPTSTAT=^TMP("DVBC",$J,"APPOINTMENT STATUS")
69 K DA,DIC,X,DD,DO
70 S X=^TMP("DVBC",$J,"INITIAL APPT DATE")
71 S DIC="^DVB(396.95,",DIC(0)="L",DIC("DR")=""
72 S DIC("DR")=DIC("DR")_".02////^S X=ORIGAPPT;.03////^S X=CURRAPPT;"
73 S DIC("DR")=DIC("DR")_".04////^S X=VETCANC;.05////^S X=VETDTE;"
74 S DIC("DR")=DIC("DR")_".06////^S X=DVBADA;.07////^S X=APPTSTAT"
75 D FILE^DICN
76 I +Y'>0 DO
77 .S DIR("A",1)="The C&P appointment link was not properly added. Please investigate the"
78 .S DIR("A",2)="appointment scheduled for "_ORIGAPPT_" for "_$P(^DPT(DVBADFN,0),U,1)
79 .S DIR("A",3)=" "
80 .S DIR(0)="FAO^1:1",DIR("A")="Hit Return to continue." D ^DIR K DIR,X,Y
81 K DIC,DA,X,Y
82 Q
83 ;
84STYLE(REQDA) ;** Return indication of 2507 status matching integ report type
85 N STATIND,REQSTAT,STYLEIND,PARAMDA
86 S STATIND=0 ;**Leave set to zero if STYLEIND=4
87 S REQSTAT=$P(^DVB(396.3,REQDA,0),U,18)
88 S PARAMDA=0
89 S PARAMDA=$O(^DVB(396.1,PARAMDA))
90 S STYLEIND=$P(^DVB(396.1,PARAMDA,0),U,15)
91 I STYLEIND="1" S:"P^S"[REQSTAT STATIND=1
92 I STYLEIND="2" S:"R^C"[REQSTAT STATIND=1
93 I STYLEIND="3" S STATIND=1
94 Q +STATIND
95 ;
96SELLNK(REQDA) ;** Return IEN from 396.95 for link to modify
97 N SELDA
98 D LNKARY^DVBCUTA3(REQDA,DVBADFN) ;**Set up link array
99 I '$D(TMP("DVBC LINK")) DO
100 .S SELDA=0,DVBANOLK=""
101 .D NOLNK^DVBCLKT2
102 I $D(TMP("DVBC LINK")) DO
103 .I '$D(DVBAAPT) DO
104 ..S Y=$P(SDATA,U,3)
105 ..X ^DD("DD")
106 ..S DVBAAPT=Y
107 ..S DVBAAPST=""
108 .D LINKDISP^DVBCUTA1
109 .I $D(DVBAAPST) K DVBAAPT,DVBAAPST
110 K Y
111 Q +SELDA
Note: See TracBrowser for help on using the repository browser.