source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCUTL6.m

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

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1DVBCUTL6 ;ALB/GTS-AMIE C&P APPT LINK DISPLAY SUBRTNS ; 10/20/94 1:45 PM
2 ;;2.7;AMIE;**1**;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 ;
11LKHDOUT ;** Link MGNT screen hdr
12 W @IOF
13 W "AMIE/C&P Appointment Link Management",!!,"Current appointment links"
14 W !,"Clinic",?32,"Date/Time",?51,"Status",!
15 Q
16 ;
17EXMOUT(LPDA) ;** Output exam
18 W !!,"Exam: ",$P(^DVB(396.6,$P(^DVB(396.4,LPDA,0),U,3),0),U,2)
19 W !,"Clinic",?32,"Date/Time",?49,"Status"
20 Q
21 ;
22EXMDISP(REQDA) ;** Output Open/Completed exams
23 D EXMHD
24 N DVBADA,DVBASTAT
25 S DVBADA=""
26 F S DVBADA=$O(^DVB(396.4,"C",REQDA,DVBADA)) Q:(DVBADA=""!($D(DTOUT)!$D(DUOUT))) DO
27 .I $D(^DVB(396.4,DVBADA,0)) DO
28 ..S DVBASTAT=$P(^DVB(396.4,DVBADA,0),U,4)
29 ..D EXAMLST^DVBCUTA4(DVBADA,DVBASTAT)
30 Q
31 ;
32EXMHD ;** Exam header
33 W @IOF
34 N DVBALN
35 S Y=$P(^DVB(396.3,REQDA,0),U,5)
36 X ^DD("DD")
37 W !!,"AMIE exams on 2507 request for: ",$P(^DPT($P(^DVB(396.3,REQDA,0),U,1),0),U,1)
38 W !,"2507 Request Date Reported to MAS: ",Y
39 S $P(DVBALN,"-",80)=""
40 W !,DVBALN
41 W !!,"Exam:",?40,"Status:"
42 K Y
43 Q
44 ;
45APPTSEL(DVBADFN,APPTTYPE,REQDA,STRTDT,ENDDT) ;Select appt
46 ;** APPTTYPE = appt type to select
47 ;** STRTDT,ENDDT = selected date range
48 ;
49 ;** APPTSEL creates ^TMP = appt's of APPTTYPE in date range
50 ;** ^TMP=appt dte-ext ^ Clinic-ext ^ Status-ext ^ appt dte-int
51 W @IOF
52 N TMPDA
53 S STRTDT=STRTDT-.1,TMPDA=1
54 S:+STRTDT<0 STRTDT=0
55 S:'$D(ENDDT) ENDDT=""
56 S:ENDDT="" ENDDT=9999999
57 K STATUS,STATVAR
58 I $D(^DPT(DVBADFN,"S")) DO
59 .F S STRTDT=$O(^DPT(DVBADFN,"S",STRTDT)) Q:(STRTDT=""!(STRTDT>ENDDT)) DO
60 ..I $P(^DPT(DVBADFN,"S",STRTDT,0),U,16)=APPTTYPE DO
61 ...S TMPDA=TMPDA+1
62 ...S DA=DVBADFN,DA(2.98)=STRTDT,DR="1900",DR(2.98)=".01",DIC=2
63 ...S DIQ="DVBAARY" K ^UTILITY("DIQ",$J)
64 ...D EN^DIQ1 K ^UTILITY("DIQ",$J)
65 ...S Y=STRTDT X ^DD("DD")
66 ...S STATVAR=$$STATUS^SDAM1(DVBADFN,STRTDT,$P(^DPT(DVBADFN,"S",STRTDT,0),U,1),^DPT(DVBADFN,"S",STRTDT,0))
67 ...S STATUS=$P(STATVAR,";",3)
68 ...S ^TMP("DVBC",$J,TMPDA)=Y_"^"_DVBAARY(2.98,STRTDT,.01)_"^"_STATUS_"^"_STRTDT
69 ...K DVBAARY(2.98),Y,STATUS,STATVAR
70 D ARYDISP
71 Q
72 ;
73ARYDISP ;** Display appts for selection
74 ;** run APPTSEL before ARYDISP
75 ;
76 ;** DVBAAPT returned (= selected ^TMP node)
77 ;
78 K DA,DR,DIC,DIQ
79 I '$D(DVBAMORE) N DVBAMORE
80 I '$D(TMPDA) N TMPDA
81 W !!!,"Select an appointment to link to the 2507 request",!
82 W !,?1,"1",?4,"Display Current C&P Appointment Links"
83 S ^TMP("DVBC",$J,1)=""
84 F TMPDA=2:1 Q:'$D(^TMP("DVBC",$J,TMPDA)) DO
85 .W !,?1,TMPDA,?4,$P(^TMP("DVBC",$J,TMPDA),U,1)
86 .W ?23,$E($P(^TMP("DVBC",$J,TMPDA),U,2),1,22)
87 .W:$D(^DVB(396.95,"AB",REQDA,$P(^TMP("DVBC",$J,TMPDA),U,4))) ?47,"*CL"
88 .W ?51,$E($P(^TMP("DVBC",$J,TMPDA),U,3),1,27)
89 .S DVBAMORE=$O(^TMP("DVBC",$J,TMPDA))
90 .I +DVBAMORE'>0 D SELAPT
91 .I (+DVBAMORE>0)&(TMPDA#5=0) D SELAPT
92 S DVBAAPT=""
93 I $D(Y) DO
94 .S DVBAAPT=^TMP("DVBC",$J,+Y)
95 .K ^TMP("DVBC",$J,+Y)
96 Q
97 ;
98SELAPT ;** Select Appt
99 W !
100 S DIR("A",1)="ENTER '^' TO STOP, OR"
101 S DIR("A")="CHOOSE 1-"_TMPDA_": "
102 S DIR(0)="NOA^1:"_TMPDA_"^I X["".""!('$D(^TMP(""DVBC"",$J,+Y))) K X"
103 S DIR("?",1)="Select an appointment by entering its associated number."
104 S DIR("?",2)=" *CL following Clinic means the appointment date is the"
105 S DIR("?",2)=DIR("?",2)_" Current Date for"
106 S DIR("?",3)=" an existing link."
107 S DIR("?",4)="Enter '1' to see the current links to this 2507."
108 S DIR("?")="Select from the numbers listed."
109 D ^DIR
110 I $D(DTOUT)!($D(DUOUT)) S TMPDA=9999,DVBAOUT=""
111 S:+Y>1 TMPDA=9999
112 W:+Y'>0 !
113 I +Y=1 DO
114 .W @IOF
115 .D LNKARY^DVBCUTA3(REQDA,DVBADFN)
116 .D LNKLIST^DVBCUTA3
117 .S:TMPDA'>5 TMPDA=TMPDA-1
118 .S:(TMPDA>5&(TMPDA#5=0)) TMPDA=TMPDA-5
119 .S:(TMPDA>5&(TMPDA#5'=0)) TMPDA=TMPDA-1
120 .D REFRSH^DVBCUTA4(TMPDA)
121 .K Y
122 I $D(Y),(+Y'>0) K Y
123 K DIR,DTOUT,DUOUT
124 Q
125 ;
126LINKINF(REQDA,CURRAPT) ;** Display Link info
127 N LINKNODE,LINKDA,INITDTE,ORIGDTE,VETDTE
128 S LINKDA=""
129 S LINKDA=$O(^DVB(396.95,"AB",REQDA,CURRAPT,LINKDA))
130 S LINKNODE=^DVB(396.95,LINKDA,0)
131 S INITDTE=$P(LINKNODE,U,1)
132 S ORIGDTE=$P(LINKNODE,U,2)
133 S VETDTE=$P(LINKNODE,U,5)
134 I INITDTE'=CURRAPT DO
135 .K Y
136 .S Y=INITDTE
137 .X ^DD("DD")
138 .W !,"Initial Appt: ",?36,Y
139 I ORIGDTE'=CURRAPT DO
140 .K Y
141 .S Y=ORIGDTE
142 .X ^DD("DD")
143 .W !,"Clock Stop Appt: ",?36,Y
144 I VETDTE'=""&(VETDTE'=CURRAPT) DO
145 .K Y
146 .S Y=VETDTE
147 .X ^DD("DD")
148 .W !,"Last Veteran requested Appointment: ",?36,Y
149 K Y
150 S Y=CURRAPT
151 X ^DD("DD")
152 W !,"Current Appt: ",?36,Y
153 K Y
154 Q
Note: See TracBrowser for help on using the repository browser.