source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCUTL7.m@ 1384

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

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1DVBCUTL7 ;ALB/GTS-AMIE C&P APPT LINK FILE MAINT RTNS ; 10/20/94 2: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 ;
11ATRBCK ;** Trace Auto-rbkd appt, result: temporary link record based on trace
12 ;
13 ;** APPTSTAT,APPTNODE must be defined for appt to link before ATRBCK
14 ;** APPTNODE is ^DPT(,'S' node (current appt to be linked)
15 ;** ^TMP("DVBC",$J,'field name') created - temp link record
16 ;** DVBAAPT set by ARYDISP^DVBCUTL6
17 ;** DVBAAPT = appt dte-ext ^ Clinic-ext ^ Status-ext ^ appt dte-int
18 ;
19 N DVBANEWA,NODEDT
20 S ^TMP("DVBC",$J,"INITIAL APPT DATE")=$P(DVBAAPT,U,4)
21 S ^TMP("DVBC",$J,"ORIGINAL APPT DATE")=$P(DVBAAPT,U,4)
22 S:'$D(^TMP("DVBC",$J,"VETERAN CANCELLATION")) ^TMP("DVBC",$J,"VETERAN CANCELLATION")=0
23 S ^TMP("DVBC",$J,"APPOINTMENT STATUS")=1
24 S ^TMP("DVBC",$J,"CURRENT APPT DATE")=$P(APPTNODE,U,10) ;**bullet-proof
25 I APPTSTAT'="NT",(APPTSTAT["N"!(APPTSTAT["P")) DO ;**Vet canceled
26 .S ^TMP("DVBC",$J,"VETERAN CANCELLATION")=1
27 .S ^TMP("DVBC",$J,"VETERAN REQ APPT DATE")=$P(APPTNODE,U,10)
28 ;
29 ;** First run auto-rbk, FOR SET returns DVBANEW'=""
30 F S DVBANEWA=$P(APPTNODE,U,10) Q:DVBANEWA="" DO
31 .I $D(^DPT(DVBADFN,"S",DVBANEWA,0)) DO
32 ..D STATCK(DVBANEWA,DVBADFN) ;**Set APPTNODE,APPTSTAT - DVBANEWA node
33 ..I ^TMP("DVBC",$J,"VETERAN CANCELLATION")'=1 S ^TMP("DVBC",$J,"ORIGINAL APPT DATE")=DVBANEWA
34 ..I APPTSTAT'="NT",(APPTSTAT["N"!(APPTSTAT["P")) DO ;**Vet canc
35 ...S ^TMP("DVBC",$J,"VETERAN CANCELLATION")=1
36 ...I APPTSTAT["A" DO ;**Vet canc,Auto-rbk -O get pce 10
37 ....S ^TMP("DVBC",$J,"VETERAN REQ APPT DATE")=$P(APPTNODE,U,10)
38 ..I APPTSTAT["A" DO ;**Current=auto-rbk appt
39 ...S ^TMP("DVBC",$J,"CURRENT APPT DATE")=$P(APPTNODE,U,10)
40 ..I APPTSTAT["A"!(APPTSTAT="I"!(APPTSTAT=""!(APPTSTAT="NT"))) DO
41 ...S ^TMP("DVBC",$J,"APPOINTMENT STATUS")=1
42 ..I APPTSTAT'["A"&(APPTSTAT'="I"&(APPTSTAT'=""&(APPTSTAT'="NT"))) DO
43 ...S ^TMP("DVBC",$J,"APPOINTMENT STATUS")=0
44 Q
45 ;
46NOAUTO ;** ^TMP("DVBA",$J) prepared for FIXLK/ADDLK, no auto-rbk
47 ;
48 ;** ^TMP("DVBA",$J) KILLed by calling rtn
49 ;** DVBAAPT defined before calling NOAUTO
50 ;** ^TMP is temp link record
51 ;
52 S ^TMP("DVBC",$J,"INITIAL APPT DATE")=$P(DVBAAPT,U,4)
53 S ^TMP("DVBC",$J,"ORIGINAL APPT DATE")=$P(DVBAAPT,U,4)
54 S ^TMP("DVBC",$J,"CURRENT APPT DATE")=$P(DVBAAPT,U,4)
55 S:'$D(^TMP("DVBC",$J,"VETERAN CANCELLATION")) ^TMP("DVBC",$J,"VETERAN CANCELLATION")=0
56 S:(APPTSTAT="N"!(APPTSTAT="PC")) ^TMP("DVBC",$J,"VETERAN CANCELLATION")=1
57 S:'$D(^TMP("DVBC",$J,"VETERAN REQ APPT DATE")) ^TMP("DVBC",$J,"VETERAN REQ APPT DATE")=""
58 S ^TMP("DVBC",$J,"APPOINTMENT STATUS")=0
59 S:APPTSTAT="I"!(APPTSTAT="NT"!(APPTSTAT="")) ^TMP("DVBC",$J,"APPOINTMENT STATUS")=1
60 Q
61 ;
62STATCK(APPTDTIN,DVBADFN) ;** Check current appt status
63 ;** APPTNODE,APPTSTAT KILLed by calling rtn
64 S APPTNODE=^DPT(DVBADFN,"S",APPTDTIN,0)
65 S APPTSTAT=$P(APPTNODE,U,2)
66 Q
Note: See TracBrowser for help on using the repository browser.