source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMRNQ.m

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1IVMRNQ ;ALB/CPM - IVM CASE INQUIRY ; 14-JUN-94
2 ;;2.0; INCOME VERIFICATION MATCH ;**12,17**; 21-OCT-94
3 ;
4EN ; Main loop for the IVM Case Inquiry.
5 S IVMSTOP=0 F D PAT Q:IVMSTOP W !!
6 K IVMSTOP
7 Q
8 ;
9 ;
10PAT ; Run inquiry for a single patient.
11 S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC K DIC I Y<1 S IVMSTOP=1 G END
12 S DFN=+Y,IVMDA=$O(^IVM(301.5,"B",DFN,0))
13 I 'IVMDA W !!,"This patient has had no Means/Copay Tests transmitted to HEC.",! G PAT
14 I '$O(^IVM(301.5,"B",DFN,IVMDA)) D G DEV
15 .S IVMYR=$P($G(^IVM(301.5,IVMDA,0)),"^",2)
16 .W !!," >>>> Case Record is for Income Year ",1700+$E(IVMYR,1,3)," <<<<",!
17 ;
18YR ; Get income year to select record.
19 N ENODE
20 S DIR("A")="Select INCOME YEAR: ",DIR(0)="DA^2901231::E",DIR("?")="^D HLP^IVMRNQ"
21 D ^DIR K DIR G:$D(DIRUT)!('Y) END
22 S IVMYR=$E(Y,1,3)_"0000",IVMDA=$O(^IVM(301.5,"APT",DFN,IVMYR,0))
23 I 'IVMDA W !!,"This patient did not have a Means/Copay Test referred to HEC for income year ",1700+$E(IVMYR,1,3),".",! G YR
24 S ENODE=$G(^IVM(301.5,IVMDA,"E"))
25 I (ENODE'=""),'(+$P(ENODE,"^")) W !!,"This patient did not have a Means/Copay Test referred to HEC for income year ",1700+$E(IVMYR,1,3),".",! G YR
26 ;
27DEV ; Select an output device.
28 S %ZIS="QM" D ^%ZIS G:POP END
29 I $D(IO("Q")) D D ^%ZTLOAD K IO("Q") D HOME^%ZIS,END G END
30 .S ZTRTN="DQ^IVMRNQ",ZTDESC="IVM - CASE INQUIRY"
31 .S (ZTSAVE("IVMYR"),ZTSAVE("IVMDA"),ZTSAVE("DFN"))=""
32 ;
33 U IO
34 ;
35DQ ; Tasked entry point.
36 S IVMPAG=0,IVMNAM=$$PT^IVMUFNC4(DFN),IVM0=$G(^IVM(301.5,IVMDA,0)),IVM1=$G(^(1))
37 D NOW^%DTC S IVMDAT=$$FMTE^XLFDT(%),IVMQUIT=0
38 S IVMMT=$$LST^DGMTU(DFN,$E(IVMYR,1,3)+1_1231)
39 D HDR^IVMRNQ1
40 ;
41 ; - list transmission history
42 I $Y>(IOSL-6) D PAUSE^IVMRUTL G:IVMQUIT END D HDR^IVMRNQ1
43 D THDR^IVMRNQ1
44 S IVMTR=0 F S IVMTR=$O(^IVM(301.6,"B",IVMDA,IVMTR)) Q:'IVMTR D G:IVMQUIT END
45 .S IVMTR0=$G(^IVM(301.6,IVMTR,0)),IVMTR1=$G(^(1))
46 .I $Y>(IOSL-3) D PAUSE^IVMRUTL Q:IVMQUIT D HDR^IVMRNQ1,THDR^IVMRNQ1
47 .W !?2,$$FMTE^XLFDT($P(IVMTR0,"^",2))
48 .W ?25,$$EXPAND^IVMUFNC(301.6,.03,$P(IVMTR0,"^",3))
49 .W ?53,$S(IVMTR1:$E($P($$MTS^DGMTU("",+IVMTR1),"^"),1,13),1:"UNKNOWN")
50 .W ?67,$S($P(IVMTR1,"^",2):"YES",1:"NO")
51 .I $P(IVMTR0,"^",4)]"" D
52 ..I $Y>(IOSL-3) D PAUSE^IVMRUTL Q:IVMQUIT D HDR^IVMRNQ1,THDR^IVMRNQ1
53 ..W !?4,"Error: ",$E($P(IVMTR0,"^",4),1,70)
54 ;
55 ; - list billing history
56 I '$O(^IVM(301.61,"C",DFN,0)) G UPL
57 I $Y>(IOSL-6) D PAUSE^IVMRUTL G:IVMQUIT END D HDR^IVMRNQ1
58 D BHDR^IVMRNQ1
59 S IVMTR=0 F S IVMTR=$O(^IVM(301.61,"C",DFN,IVMTR)) Q:'IVMTR D G:IVMQUIT END
60 .S IVMTR0=$G(^IVM(301.61,IVMTR,0))
61 .I $Y>(IOSL-3) D PAUSE^IVMRUTL Q:IVMQUIT D HDR^IVMRNQ1,BHDR^IVMRNQ1
62 .W !?2,$$EXPAND^IVMUFNC(301.61,.04,$P(IVMTR0,"^",4))
63 .W ?14,$$DAT1^IVMUFNC4($P(IVMTR0,"^",5))
64 .W ?24,$$DAT1^IVMUFNC4($P(IVMTR0,"^",6))
65 .W ?34,$J($P(IVMTR0,"^",8),8,2)
66 .W ?44,$S($P(IVMTR0,"^",4)>1:" N/A",1:$J($P(IVMTR0,"^",9),8,2))
67 .W ?55,$S($P(IVMTR0,"^",11):"YES",1:"NO")
68 .W ?63,$S($P(IVMTR0,"^",10):"YES",1:"NO")
69 .W ?70,$S($P(IVMTR0,"^",13):$$DAT1^IVMUFNC4($P(IVMTR0,"^",13)),1:"Not Sent")
70 ;
71UPL ; - check for upload information
72 D CKUPL^IVMRNQ1 I '$D(IVMTXT) G END1
73 I $Y>(IOSL-6) D PAUSE^IVMRUTL G:IVMQUIT END D HDR^IVMRNQ1
74 ;
75 W !
76 F IVMS=1,2,3 I $D(IVMTXT(IVMS)) W !,$P($T(UPTXT+IVMS^IVMRNQ1),";;",2)
77 S IVMS=0 F S IVMS=$O(IVMTXT(4,IVMS)) Q:'IVMS S IVMX=IVMTXT(4,IVMS) D
78 .I $P(IVMX,"^",5) W !,"Insurance data was uploaded on ",$$DAT1^IVMUFNC4($P(IVMX,"^",5),1),"."
79 .I $P(IVMX,"^",8) W !,"Insurance data for this patient was rejected: ",$P($G(^IVM(301.91,$P(IVMX,"^",8),0)),"^",2)
80 ;
81END1 D PAUSE^IVMRUTL
82 ;
83END I $D(ZTQUEUED) S ZTREQ="@" Q
84 D ^%ZISC
85 K %DT,DFN,IVMYR,IVMDA,IVMPAG,IVMNAM,IVM0,IVM1,IVMDAT,IVMMT,X,Y,ZTSK
86 K IVMTR,IVMTR0,IVMTR1,IVMI,IVMX,DIRUT,DUOUT,DTOUT,IVMS,IVMTXT
87 Q
88 ;
89HLP ; Help to select Income Year.
90 N I
91 W !!,"Please select one of the following Income Years:",!
92 S I=0 F S I=$O(^IVM(301.5,"APT",DFN,I)) Q:'I I I>2900000 W !?4,$E(I,1,3)+1700
93 Q
Note: See TracBrowser for help on using the repository browser.