DVBCUTL7 ;ALB/GTS-AMIE C&P APPT LINK FILE MAINT RTNS ; 10/20/94 2: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)
;
ATRBCK ;** Trace Auto-rbkd appt, result: temporary link record based on trace
;
;** APPTSTAT,APPTNODE must be defined for appt to link before ATRBCK
;** APPTNODE is ^DPT(,'S' node (current appt to be linked)
;** ^TMP("DVBC",$J,'field name') created - temp link record
;** DVBAAPT set by ARYDISP^DVBCUTL6
;** DVBAAPT = appt dte-ext ^ Clinic-ext ^ Status-ext ^ appt dte-int
;
N DVBANEWA,NODEDT
S ^TMP("DVBC",$J,"INITIAL APPT DATE")=$P(DVBAAPT,U,4)
S ^TMP("DVBC",$J,"ORIGINAL APPT DATE")=$P(DVBAAPT,U,4)
S:'$D(^TMP("DVBC",$J,"VETERAN CANCELLATION")) ^TMP("DVBC",$J,"VETERAN CANCELLATION")=0
S ^TMP("DVBC",$J,"APPOINTMENT STATUS")=1
S ^TMP("DVBC",$J,"CURRENT APPT DATE")=$P(APPTNODE,U,10) ;**bullet-proof
I APPTSTAT'="NT",(APPTSTAT["N"!(APPTSTAT["P")) DO ;**Vet canceled
.S ^TMP("DVBC",$J,"VETERAN CANCELLATION")=1
.S ^TMP("DVBC",$J,"VETERAN REQ APPT DATE")=$P(APPTNODE,U,10)
;
;** First run auto-rbk, FOR SET returns DVBANEW'=""
F S DVBANEWA=$P(APPTNODE,U,10) Q:DVBANEWA="" DO
.I $D(^DPT(DVBADFN,"S",DVBANEWA,0)) DO
..D STATCK(DVBANEWA,DVBADFN) ;**Set APPTNODE,APPTSTAT - DVBANEWA node
..I ^TMP("DVBC",$J,"VETERAN CANCELLATION")'=1 S ^TMP("DVBC",$J,"ORIGINAL APPT DATE")=DVBANEWA
..I APPTSTAT'="NT",(APPTSTAT["N"!(APPTSTAT["P")) DO ;**Vet canc
...S ^TMP("DVBC",$J,"VETERAN CANCELLATION")=1
...I APPTSTAT["A" DO ;**Vet canc,Auto-rbk -O get pce 10
....S ^TMP("DVBC",$J,"VETERAN REQ APPT DATE")=$P(APPTNODE,U,10)
..I APPTSTAT["A" DO ;**Current=auto-rbk appt
...S ^TMP("DVBC",$J,"CURRENT APPT DATE")=$P(APPTNODE,U,10)
..I APPTSTAT["A"!(APPTSTAT="I"!(APPTSTAT=""!(APPTSTAT="NT"))) DO
...S ^TMP("DVBC",$J,"APPOINTMENT STATUS")=1
..I APPTSTAT'["A"&(APPTSTAT'="I"&(APPTSTAT'=""&(APPTSTAT'="NT"))) DO
...S ^TMP("DVBC",$J,"APPOINTMENT STATUS")=0
Q
;
NOAUTO ;** ^TMP("DVBA",$J) prepared for FIXLK/ADDLK, no auto-rbk
;
;** ^TMP("DVBA",$J) KILLed by calling rtn
;** DVBAAPT defined before calling NOAUTO
;** ^TMP is temp link record
;
S ^TMP("DVBC",$J,"INITIAL APPT DATE")=$P(DVBAAPT,U,4)
S ^TMP("DVBC",$J,"ORIGINAL APPT DATE")=$P(DVBAAPT,U,4)
S ^TMP("DVBC",$J,"CURRENT APPT DATE")=$P(DVBAAPT,U,4)
S:'$D(^TMP("DVBC",$J,"VETERAN CANCELLATION")) ^TMP("DVBC",$J,"VETERAN CANCELLATION")=0
S:(APPTSTAT="N"!(APPTSTAT="PC")) ^TMP("DVBC",$J,"VETERAN CANCELLATION")=1
S:'$D(^TMP("DVBC",$J,"VETERAN REQ APPT DATE")) ^TMP("DVBC",$J,"VETERAN REQ APPT DATE")=""
S ^TMP("DVBC",$J,"APPOINTMENT STATUS")=0
S:APPTSTAT="I"!(APPTSTAT="NT"!(APPTSTAT="")) ^TMP("DVBC",$J,"APPOINTMENT STATUS")=1
Q
;
STATCK(APPTDTIN,DVBADFN) ;** Check current appt status
;** APPTNODE,APPTSTAT KILLed by calling rtn
S APPTNODE=^DPT(DVBADFN,"S",APPTDTIN,0)
S APPTSTAT=$P(APPTNODE,U,2)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCUTL7 3119 printed Dec 13, 2024@01:49:16 Page 2
DVBCUTL7 ;ALB/GTS-AMIE C&P APPT LINK FILE MAINT RTNS ; 10/20/94 2: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 ;
ATRBCK ;** Trace Auto-rbkd appt, result: temporary link record based on trace
+1 ;
+2 ;** APPTSTAT,APPTNODE must be defined for appt to link before ATRBCK
+3 ;** APPTNODE is ^DPT(,'S' node (current appt to be linked)
+4 ;** ^TMP("DVBC",$J,'field name') created - temp link record
+5 ;** DVBAAPT set by ARYDISP^DVBCUTL6
+6 ;** DVBAAPT = appt dte-ext ^ Clinic-ext ^ Status-ext ^ appt dte-int
+7 ;
+8 NEW DVBANEWA,NODEDT
+9 SET ^TMP("DVBC",$JOB,"INITIAL APPT DATE")=$PIECE(DVBAAPT,U,4)
+10 SET ^TMP("DVBC",$JOB,"ORIGINAL APPT DATE")=$PIECE(DVBAAPT,U,4)
+11 if '$DATA(^TMP("DVBC",$JOB,"VETERAN CANCELLATION"))
SET ^TMP("DVBC",$JOB,"VETERAN CANCELLATION")=0
+12 SET ^TMP("DVBC",$JOB,"APPOINTMENT STATUS")=1
+13 ;**bullet-proof
SET ^TMP("DVBC",$JOB,"CURRENT APPT DATE")=$PIECE(APPTNODE,U,10)
+14 ;**Vet canceled
IF APPTSTAT'="NT"
IF (APPTSTAT["N"!(APPTSTAT["P"))
Begin DoDot:1
+15 SET ^TMP("DVBC",$JOB,"VETERAN CANCELLATION")=1
+16 SET ^TMP("DVBC",$JOB,"VETERAN REQ APPT DATE")=$PIECE(APPTNODE,U,10)
End DoDot:1
+17 ;
+18 ;** First run auto-rbk, FOR SET returns DVBANEW'=""
+19 FOR
SET DVBANEWA=$PIECE(APPTNODE,U,10)
if DVBANEWA=""
QUIT
Begin DoDot:1
+20 IF $DATA(^DPT(DVBADFN,"S",DVBANEWA,0))
Begin DoDot:2
+21 ;**Set APPTNODE,APPTSTAT - DVBANEWA node
DO STATCK(DVBANEWA,DVBADFN)
+22 IF ^TMP("DVBC",$JOB,"VETERAN CANCELLATION")'=1
SET ^TMP("DVBC",$JOB,"ORIGINAL APPT DATE")=DVBANEWA
+23 ;**Vet canc
IF APPTSTAT'="NT"
IF (APPTSTAT["N"!(APPTSTAT["P"))
Begin DoDot:3
+24 SET ^TMP("DVBC",$JOB,"VETERAN CANCELLATION")=1
+25 ;**Vet canc,Auto-rbk -O get pce 10
IF APPTSTAT["A"
Begin DoDot:4
+26 SET ^TMP("DVBC",$JOB,"VETERAN REQ APPT DATE")=$PIECE(APPTNODE,U,10)
End DoDot:4
End DoDot:3
+27 ;**Current=auto-rbk appt
IF APPTSTAT["A"
Begin DoDot:3
+28 SET ^TMP("DVBC",$JOB,"CURRENT APPT DATE")=$PIECE(APPTNODE,U,10)
End DoDot:3
+29 IF APPTSTAT["A"!(APPTSTAT="I"!(APPTSTAT=""!(APPTSTAT="NT")))
Begin DoDot:3
+30 SET ^TMP("DVBC",$JOB,"APPOINTMENT STATUS")=1
End DoDot:3
+31 IF APPTSTAT'["A"&(APPTSTAT'="I"&(APPTSTAT'=""&(APPTSTAT'="NT")))
Begin DoDot:3
+32 SET ^TMP("DVBC",$JOB,"APPOINTMENT STATUS")=0
End DoDot:3
End DoDot:2
End DoDot:1
+33 QUIT
+34 ;
NOAUTO ;** ^TMP("DVBA",$J) prepared for FIXLK/ADDLK, no auto-rbk
+1 ;
+2 ;** ^TMP("DVBA",$J) KILLed by calling rtn
+3 ;** DVBAAPT defined before calling NOAUTO
+4 ;** ^TMP is temp link record
+5 ;
+6 SET ^TMP("DVBC",$JOB,"INITIAL APPT DATE")=$PIECE(DVBAAPT,U,4)
+7 SET ^TMP("DVBC",$JOB,"ORIGINAL APPT DATE")=$PIECE(DVBAAPT,U,4)
+8 SET ^TMP("DVBC",$JOB,"CURRENT APPT DATE")=$PIECE(DVBAAPT,U,4)
+9 if '$DATA(^TMP("DVBC",$JOB,"VETERAN CANCELLATION"))
SET ^TMP("DVBC",$JOB,"VETERAN CANCELLATION")=0
+10 if (APPTSTAT="N"!(APPTSTAT="PC"))
SET ^TMP("DVBC",$JOB,"VETERAN CANCELLATION")=1
+11 if '$DATA(^TMP("DVBC",$JOB,"VETERAN REQ APPT DATE"))
SET ^TMP("DVBC",$JOB,"VETERAN REQ APPT DATE")=""
+12 SET ^TMP("DVBC",$JOB,"APPOINTMENT STATUS")=0
+13 if APPTSTAT="I"!(APPTSTAT="NT"!(APPTSTAT=""))
SET ^TMP("DVBC",$JOB,"APPOINTMENT STATUS")=1
+14 QUIT
+15 ;
STATCK(APPTDTIN,DVBADFN) ;** Check current appt status
+1 ;** APPTNODE,APPTSTAT KILLed by calling rtn
+2 SET APPTNODE=^DPT(DVBADFN,"S",APPTDTIN,0)
+3 SET APPTSTAT=$PIECE(APPTNODE,U,2)
+4 QUIT
