source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCIUTL.m@ 1361

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

initial load of WorldVistAEHR

File size: 4.4 KB
RevLine 
[613]1DVBCIUTL ;ALB/GTS-AMIE INSUFFICIENT RPT UTILITY RTN ; 11/14/94 9:15 AM
2 ;;2.7;AMIE;**13,17,19**;Apr 10, 1995
3 ;
4 ;** Version Changes
5 ; 2.7 - New routine (Enhc 15)
6 ;
7DETHD ;** Detailed Report header
8 S:'$D(DVBAPG1) TVAR(1,0)="0,15,0,1,0^Detailed Insufficient Exam Report"
9 S:$D(DVBAPG1) TVAR(1,0)="0,15,0,1,1^Detailed Insufficient Exam Report"
10 S TVAR(2,0)="0,11,0,2,0^For Date Range: "_STRTDT_" to "_LSTDT
11 D WR^DVBAUTL4("TVAR")
12 K TVAR
13 Q
14 ;
15EXMOUT ;** Output exam information for reason/type
16 I $Y>(IOSL-9) DO
17 .I IOST?1"C-".E D TERM^DVBCUTL3
18 .I '$D(GETOUT) DO
19 ..D DETHD
20 ..D RESOUT
21 ..W !
22 ..D TYPEOUT
23 ..S (DVBARSPT,DVBAXMPT)=""
24 I '$D(GETOUT) DO
25 .I '$D(DVBARSPT) DO
26 ..D RESOUT
27 ..S DVBARSPT=""
28 .I '$D(DVBAXMPT) DO
29 ..W !
30 ..D TYPEOUT
31 ..S DVBAXMPT="",(DVBARQDT,DVBAXDT,DVBAXRS)=""
32 .S REQDA=$P(^DVB(396.4,XMDA,0),U,2) ;*REQDA of PRIORITY Insuf 2507
33 .I $D(^DVB(396.4,XMDA,"CAN")) D
34 ..S DVBAXDT=$P(^DVB(396.4,XMDA,"CAN"),U,1),DVBAXRS=$P(^("CAN"),U,3)
35 ..I DVBAXDT S DVBAXDT=$$FMTE^XLFDT(DVBAXDT,"5DZ")
36 ..I DVBAXRS S DVBAXRS=$P(^DVB(396.5,DVBAXRS,0),U,1)
37 .I +REQDA>0 DO ;*Get REQDA of Orig 2507
38 ..S DFN=$P(^DVB(396.3,REQDA,0),U,1),DVBARQDT=$P(^(0),U,2),DVBARQDT=$$FMTE^XLFDT(DVBARQDT,"5DZ")
39 ..I '$D(^DVB(396.3,REQDA,5)) S REQDA=""
40 ..I +REQDA>0,($D(^DVB(396.3,REQDA,5))) S REQDA=$P(^DVB(396.3,REQDA,5),U,1)
41 .S DVBAORXM=""
42 .I +REQDA>0 DO ;*If link to orig 2507
43 ..S DVBAXMTP=$P(^DVB(396.4,XMDA,0),U,3)
44 ..S DVBACMND="F S DVBAORXM=$O(^DVB(396.4,""ARQ"_REQDA_""","_DVBAXMTP_",DVBAORXM)) Q:DVBAORXM="""" Q:$D(^DVB(396.4,""APS"","_DFN_","_DVBAXMTP_",""C"",DVBAORXM))"
45 ..X DVBACMND ;**Return DA of original, insuff exam
46 .S DVBANAME=$P(^DPT(DFN,0),U,1)
47 .S DVBASSN=$P(^DPT(DFN,0),U,9)
48 .S DVBACNUM="" S:$D(^DPT(DFN,.31)) DVBACNUM=$P(^DPT(DFN,.31),U,3)
49 .I DVBAORXM'="",($D(^DVB(396.4,DVBAORXM,0))) S DVBAORDT=$P(^DVB(396.4,DVBAORXM,0),U,6)
50 .I DVBAORXM'="",('$D(^DVB(396.4,DVBAORXM,0))) S (DVBAORDT,DVBADTE)=""
51 .S:DVBAORXM="" (DVBAORDT,DVBADTE)=""
52 .I DVBAORDT'="" DO
53 ..S DVBADTWK=$P(DVBAORDT,".",1)
54 ..S DVBADTE=$$FMTE^XLFDT(DVBADTWK,"5DZ")
55 .S DVBAORPV=$P(^DVB(396.4,XMDA,0),U,12)
56 .S DVBAORP1=$E(DVBAORPV,1,15)
57 .S DVBANAM1=$E(DVBANAME,1,15)
58 .W !,DVBAORP1
59 .W:$L(DVBAORPV)>$L(DVBAORP1) "**" ;**Indicate that Dr.'s Name truncated
60 .W ?20,DVBADTE,?32,DVBANAM1
61 .W:$L(DVBANAME)>$L(DVBANAM1) "**" ;**Indicate that Vet's Name truncated
62 .W ?52,DVBASSN,?66,DVBACNUM
63 .I DVBAXDT]"" D
64 ..W !,"Exam request of "_DVBARQDT_" to correct insufficiency was cancelled on "_DVBAXDT_"."
65 ..W !,"Reason: "_DVBAXRS_"."
66 Q
67 ;
68RESOUT ;** Output the Reason
69 W !!!!!,"Reason: ",$P(^DVB(396.94,$P(^DVB(396.4,XMDA,0),U,11),0),U,3)
70 Q
71 ;
72TYPEOUT ;** Output the Exam
73 W !,"Exam: ",$P(^DVB(396.6,$P(^DVB(396.4,XMDA,0),U,3),0),U,2)
74 W !,"Provider",?20,"Exam Dt",?32,"Patient Name",?52,"SSN",?66,"Claim #"
75 Q
76 ;
77RSEL ;** Select Reasons
78 ;** The selection prompt is defaulted to ALL. If the user selects
79 ;** 'All', only reasons for exams entered on requests with a
80 ;** priority of 'Insufficient' will be reported. Not all reasons.
81 ;
82 W @IOF,!
83 W !,"Insufficient Reason Selection"
84 S DVBCYQ=""
85 N RESANS,DVBAOUT S DVBAOUT="" ;**Pre-read
86 K Y,DTOUT,DUOUT,DVBATSAV
87 F Q:(DVBAOUT=1!(DVBCYQ=1)) DO
88 .W !!," Enter '^' to end Reason Selection"
89 .W !," 'Return' to select all Insufficient Reasons",!
90 .K DIC,DTOUT,DUOUT,Y
91 .W !," Enter Insufficient Reason: ALL//"
92 .R RESANS:DTIME
93 .S:$T DVBATSAV=""
94 .I RESANS=""&($D(DVBATSAV)) S Y=-1 D INREAS^DVBCIUT1
95 .S:('$D(DVBATSAV)!(RESANS["^")) DVBAOUT="1"
96 .I DVBAOUT'=1,('$D(Y)) DO
97 ..I RESANS["?" DO
98 ...N LPDA S LPDA=0
99 ...W !,"CHOOSE FROM:"
100 ...F S LPDA=$O(^DVB(396.94,LPDA)) Q:+LPDA'>0 DO
101 ....W !,?3,$P(^DVB(396.94,LPDA,0),U,1)
102 ...W !
103 ..I RESANS'["?" DO
104 ...S DIC="^DVB(396.94,"
105 ...S DIC(0)="EMQ"
106 ...S X=RESANS
107 ...D ^DIC
108 ...D:+Y>0 INREAS^DVBCIUT1
109 .I RESANS="",($D(Y)&(+Y=-1)) S DVBCYQ=1
110 K DTOUT,DUOUT,Y,DIC,DVBCYQ,DVBATSAV
111 Q
112 ;
113XMSEL ;** Select Exams
114 ;** The selection prompt is defaulted to ALL. If the user selects
115 ;** 'All', only exams entered on requests with a priority of
116 ;** 'Insufficient' will be reported. Not all exams.
117 ;
118 W @IOF,!
119 W !,"AMIE Exam Selection"
120 S DVBCYQ=""
121 K Y,DTOUT,DUOUT
122 F Q:($D(DTOUT)!($D(DUOUT)!(DVBCYQ=1))) DO
123 .W !!," Enter '^' to end Exam Selection"
124 .W !," 'Return' to select all AMIE Exams",!
125 .K DIC,DTOUT,DUOUT
126 .S DIC="^DVB(396.6,"
127 .S DIC(0)="AEMQ"
128 .S DIC("A")=" Enter Exam: ALL//"
129 .;removed screen for inactive exams
130 .D ^DIC
131 .I '$D(DTOUT),('$D(DUOUT)) D EXMTPE^DVBCIUT1
132 .I $D(Y),(+Y=-1) S DVBCYQ=1
133 K DTOUT,DUOUT,Y,DIC,DVBCYQ
134 Q
Note: See TracBrowser for help on using the repository browser.