source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCUTA1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.7 KB
Line 
1DVBCUTA1 ;ALB/GTS-AMIE C&P UTILITY ROUTINE A-1 ; 11/9/94 11:15 AM
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;
4 ;** Version Changes
5 ; 2.7 - New routine (Enhc 15)
6 ;
7INSXM ;**Update Insuf exam info
8 ;
9 ;** Variable Descriptions
10 ; DVBAXMDA - 396.4 IEN - new Exam Rec
11 ; DVBAXMTP - 396.6 IEN - new exam
12 ; DVBAPROV - Provider on insufficiently completed exam
13 ; DVBAORXM - 396.4 IEN - insufficiently completed exam
14 ; DVBACMND - Local var containing Mumps code
15 ; X DVBACMND returns DVBAORXM
16 ; DVBCADEX - Indicates exam being added to 2507
17 ;
18 I '$D(OUT)&($P(^DVB(396.3,REQDA,0),"^",10)="E") DO
19 .S TVAR(1,0)="0,0,0,2,0^Enter the following information for the "_EXMNM
20 .S TVAR(2,0)="0,0,0,1:1,0^ exam being returned as insufficient."
21 .D WR^DVBAUTL4("TVAR")
22 .K TVAR
23 .N DVBAXMDA,REASON
24 .S DVBAXMDA=+Y
25 .K DIC,Y,DA
26 .S REASON=+$$INRSLK^DVBCUTA3
27 .S:+REASON'>0 DTOUT=""
28 .I +REASON>0 DO
29 ..K DIE,Y,DA,DR
30 ..S DIE="^DVB(396.4,",DR=".11////^S X=REASON;80;S:+$P(^DVB(396.3,REQDA,5),""^"",1)>0 Y="""";.12"
31 ..S DA=DVBAXMDA S DIE("NO^")="" D ^DIE K DIE,DA,DR W !!
32 .I '$D(DTOUT),(+$P(^DVB(396.3,REQDA,5),"^",1)>0) DO
33 ..K DIE,Y,DR,DA ;**2507 Linked
34 ..N DVBAXMTP,DVBAPROV,DVBAORXM,DVBACMND ;**S/W update Original Provider
35 ..S DVBAXMTP=$P(^TMP($J,"NEW",EXMNM),U,1),DVBAORXM="",DVBAPROV=""
36 ..S DVBACMND="S DVBAORXM=$O(^DVB(396.4,""ARQ"_DVBAINDA_""","_DVBAXMTP_",DVBAORXM))"
37 ..N XREF S XREF="ARQ"_DVBAINDA
38 ..I $D(^DVB(396.4,XREF,DVBAXMTP)) X DVBACMND ;**Return insuff exam IEN
39 ..S:+DVBAORXM>0 DVBAPROV=$P(^DVB(396.4,DVBAORXM,0),U,7)
40 ..I '$D(DVBCADEX)&(DVBAPROV="") DO
41 ...S DVBAPROV="Unknown" ;**Bad 'ARQ' X-Ref
42 ..K DVBADMNM
43 ..I +DVBAORXM>0 DO
44 ...I $D(^DVB(396.4,DVBAORXM,"TRAN")),(+$P(^DVB(396.4,DVBAORXM,"TRAN"),U,3)>0) DO
45 ....S DVBADMNM=$P(^DIC(4.2,+$P(^DVB(396.4,DVBAORXM,"TRAN"),U,3),0),U,1)
46 ....S DVBADMNM=$P(DVBADMNM,".",1)
47 ..S:$D(DVBADMNM) DVBAPROV=DVBAPROV_" at "_DVBADMNM
48 ..I $D(DVBCADEX)&(+DVBAORXM'>0) DO
49 ...S DIR(0)="FAO^1:30"
50 ...S DIR("A")="ORIGINAL PROVIDER: "
51 ...S DIR("?",1)="Enter the Original Provider who performed the examination,"
52 ...S DIR("?",2)="if the exam was performed on the original 2507 request."
53 ...S DIR("?")="Include the facility name if the exam was performed at another site." D ^DIR S DVBAPROV=X K DIR,X,Y
54 ..S DIE="^DVB(396.4,",DR=".12////^S X=DVBAPROV",DA=DVBAXMDA
55 ..D ^DIE K DVBADMNM
56 Q
57 ;
58RPTTYPE() ;** Report type - Detailed/Summary
59 ;**RPTTYPE requires an entry. Up-arrow exit allowed.
60 ;** All variables KILLed, EXCEPT DTOUT,DUOUT when user times
61 ;** or Up-Arrows out. DTOUT,DUOUT KILLed by calling rtn.
62 N TYPE
63 S DIR(0)="SO^D:Detailed;S:Summary"
64 S DIR("A",1)=" "
65 S DIR("A")="Report Type"
66 D ^DIR
67 S TYPE=Y
68 K X,Y,DIR
69 Q TYPE
70 ;
71INSFTME(CURIEN) ;** Calc Insuff 2507 total process time
72 ;** Variables
73 ;** CURIEN - 396.3 IEN for 2507 in process
74 ;** PROCTM - Processing time running total
75 ;** LPQUIT - Exit loop indicator
76 ;
77 N PROCTM,LPQUIT
78 S PROCTM=+$$PROCDAY^DVBCUTL2(CURIEN)
79 F Q:$D(LPQUIT) DO
80 .S:'$D(^DVB(396.3,CURIEN,5)) LPQUIT=""
81 .I $D(^DVB(396.3,CURIEN,5)) DO
82 ..I +$P(^DVB(396.3,CURIEN,5),U,1)'>0 DO
83 ...S PROCTM=PROCTM+$P(^DVB(396.3,CURIEN,5),U,2)
84 ...S LPQUIT=""
85 ..I +$P(^DVB(396.3,CURIEN,5),U,1)>0 DO
86 ...S CURIEN=+$P(^DVB(396.3,CURIEN,5),U,1)
87 ...S PROCTM=PROCTM+$$PROCDAY^DVBCUTL2(CURIEN)
88 Q PROCTM
89 ;
90LINKDISP ;** Display Appt Links
91 W @IOF
92 N DVBAMORE
93 W !,"Examination Appointment Links"
94 W !!," Which Current Appt is "_$P(DVBAAPT,U,1)_" a reschedule of?",!
95 W !,?4,"Initial Appt",?23,"Clock Stop Appt",?42,"Current Appt",?61,"Clinic"
96 S ARYDA=""
97 F ARYDA=1:1 Q:'$D(TMP("DVBC LINK",ARYDA)) DO
98 .S SELDA=""
99 .S SELDA=$O(TMP("DVBC LINK",ARYDA,SELDA))
100 .W !,?1,ARYDA,?4,$P(TMP("DVBC LINK",ARYDA,SELDA),U,1)
101 .W ?23,$P(TMP("DVBC LINK",ARYDA,SELDA),U,2),?42,$P(TMP("DVBC LINK",ARYDA,SELDA),U,3)
102 .W ?61,$E($P(TMP("DVBC LINK",ARYDA,SELDA),U,4),1,18)
103 .S DVBAMORE=$O(TMP("DVBC LINK",ARYDA))
104 .I +DVBAMORE'>0 D SELLNK W !
105 .I +DVBAMORE>0,(ARYDA#5=0) D SELLNK W !
106 S SELDA=""
107 I $D(Y) S SELDA=$O(TMP("DVBC LINK",Y,SELDA))
108 K TMP("DVBC LINK")
109 Q
110 ;
111SELLNK ;** Select link to modify
112 W !
113 S DIR("A",1)="ENTER '^' TO STOP OR"
114 S DIR("A")="CHOOSE 1-"_ARYDA_": "
115 S DIR(0)="NOA^1:"_ARYDA_"^I X["".""!('$D(TMP(""DVBC LINK"",+Y))) K X"
116 S DIR("?",1)="Select a link by entering its associated number."
117 S DIR("?",2)=" 'Initial Appt' is the first appointment made to complete the exam."
118 S DIR("?",3)=" 'Clock Stop Appt' is the date the processing clock will be stopped for the"
119 S DIR("?",4)=" series of linked appointments, if the veteran reschedules or no shows."
120 S DIR("?",5)=" 'Current Appt' is the appointment the link shows as currently scheduled"
121 S DIR("?",6)=" to complete the examination."
122 S DIR("?")="Select from the numbers listed."
123 D ^DIR
124 I $D(DTOUT)!($D(DUOUT)) S ARYDA=9999
125 S:+Y>0 ARYDA=9999
126 I +Y'>0 K Y
127 K DIR,DTOUT,DUOUT
128 Q
Note: See TracBrowser for help on using the repository browser.