source: FOIAVistA/tag/r/INCOME_VERIFICATION_MATCH-IVM/IVMRMCR1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.6 KB
Line 
1IVMRMCR1 ;ALB/ESD/CKN - Means Test Comparison Report ; 3 May 93 ; 07/22/02 9:40am
2 ;;2.0;INCOME VERIFICATION MATCH ;**62**; 21-OCT-94
3 ;
4 ; This processing routine (part of IVMRMCR) will create the ^Tmp
5 ; global with patient data, total summary statistics for each year, and
6 ; print patient data (if requested by user) and summary.
7 ;
8EN ; Create ^Tmp global containing SSN, MT Copay Exempt, MT Copay Required
9 ; GMT Copay Required, and date of means tests for years 1 and 2.
10 S IVMDT="",U="^" K ^TMP("IVMMT",$J)
11 F IVMCAT=4,6,16 S IVMDT=-IVMENDYR_9999 F S IVMDT=$O(^DGMT(408.31,"AS",1,IVMCAT,IVMDT)) Q:'IVMDT!(-IVMDT<(IVMBEGYR_"0000")) D
12 .S IVMABDT=-IVMDT,IVMDTYR=$E(IVMABDT,1,3)
13 .S DFN=0 F S DFN=$O(^DGMT(408.31,"AS",1,IVMCAT,IVMDT,DFN)) Q:'DFN S IVMDA=$O(^(DFN,0)) I $G(^DGMT(408.31,+IVMDA,"PRIM")) D
14 ..S IVMNM=$P($G(^DPT(DFN,0)),U) S:IVMNM="" IVMNM="NAME UNKNOWN"
15 ..D PID^VADPT6
16 ..I $D(^TMP("IVMMT",$J,IVMNM_"@@"_VA("PID"))) S IVMS=^(IVMNM_"@@"_VA("PID")),$P(IVMS,U,$S(IVMDTYR=IVMBEGYR:2,1:4),$S(IVMDTYR=IVMBEGYR:3,1:5))=IVMABDT_U_IVMCAT,^(IVMNM_"@@"_VA("PID"))=IVMS Q
17 ..S ^TMP("IVMMT",$J,IVMNM_"@@"_VA("PID"))=U_$S(IVMDTYR=IVMENDYR:U_U,1:"")_IVMABDT_U_IVMCAT
18 ;
19 ; Initialize report variables and print header(s).
20 S (IVMPAG,IVMQUIT)=0 D HDR,HDRPAT:IVMPFLAG
21 I '$D(^TMP("IVMMT",$J)) W !?5,"No MT Copay Exempt or MT Copay Required or GMT Copay Required patients exist for years selected." G ENQ1
22 ;
23 ; Calculate totals for summary portion of report and print patient data if IVMPFLAG is true.
24 S (IVMAYR1,IVMAYR2,IVMCYR1,IVMCYR2,IVMACTOT,IVMCATOT,IVMNONRT,IVMNEWMT,IVMGYR1,IVMGYR2,IVMAGTOT,IVMCGTOT,IVMGATOT,IVMGCTOT)=0
25 S IVMPDAT="" F S IVMPDAT=$O(^TMP("IVMMT",$J,IVMPDAT)) Q:IVMPDAT="" S IVMSCR=$G(^(IVMPDAT)) D G:IVMQUIT ENQ
26 . S IVMY1=$E($P(IVMSCR,U,2),1,3) D:IVMY1]"" TOTY1
27 . S IVMY2=$E($P(IVMSCR,U,4),1,3) D:IVMY2]"" TOTY2
28 . I $P(IVMSCR,U,4)="",((IVMCURDT-IVMABDT)>10000) S IVMNONRT=IVMNONRT+1
29 . I $P(IVMSCR,U,2)="" S IVMNEWMT=IVMNEWMT+1
30 . I $Y>(IOSL-5) D PAUSE^IVMRUTL Q:IVMQUIT D HDR,HDRPAT:IVMPFLAG
31 . W:IVMPFLAG !,$P(IVMPDAT,"@@"),?26,$P(IVMPDAT,"@@",2),?40,$$DSP($P(IVMSCR,U,3))
32 . I $P(IVMSCR,U,4)]"" D
33 .. W:IVMPFLAG ?60,$$DSP($P(IVMSCR,U,5))
34 .. S:$P(IVMSCR,U,3)=4&($P(IVMSCR,U,5)=6) IVMACTOT=IVMACTOT+1
35 .. S:$P(IVMSCR,U,3)=6&($P(IVMSCR,U,5)=4) IVMCATOT=IVMCATOT+1
36 .. S:$P(IVMSCR,U,3)=4&($P(IVMSCR,U,5)=16) IVMAGTOT=IVMAGTOT+1
37 .. S:$P(IVMSCR,U,3)=6&($P(IVMSCR,U,5)=16) IVMCGTOT=IVMCGTOT+1
38 .. S:$P(IVMSCR,U,3)=16&($P(IVMSCR,U,5)=6) IVMGCTOT=IVMGCTOT+1
39 .. S:$P(IVMSCR,U,3)=16&($P(IVMSCR,U,5)=4) IVMGATOT=IVMGATOT+1
40 ;
41 ; Print summary totals.
42 I IVMPFLAG!($Y>(IOSL-5)) D PAUSE^IVMRUTL G:IVMQUIT ENQ D HDR
43 W !,"SUMMARY OF MEANS TESTS FOR YEAR "_(IVMBEGYR+1700),!,$TR($J(" ",36)," ","=")
44 W !?11,"TOTAL MT COPAY EXEMPT :",$J(IVMAYR1,5),!?11,"TOTAL MT COPAY REQUIRED :",$J(IVMCYR1,5),!?11,"TOTAL GMT COPAY REQUIRED:",$J(IVMGYR1,5),!?5,"TOTAL MEANS TESTS:",$J(IVMAYR1+IVMCYR1+IVMGYR1,5)
45 W !!,"SUMMARY OF MEANS TESTS FOR YEAR "_(IVMENDYR+1700),!,$TR($J(" ",36)," ","=")
46 W !?11,"TOTAL MT COPAY EXEMPT :",$J(IVMAYR2,5),!?11,"TOTAL MT COPAY REQUIRED :",$J(IVMCYR2,5),!?11,"TOTAL GMT COPAY REQUIRED:",$J(IVMGYR2,5),!?5,"TOTAL MEANS TESTS:",$J(IVMAYR2+IVMCYR2+IVMGYR2,5),!
47 W !!?9,"TOTAL NON-RETURNS FROM "_(IVMBEGYR+1700)_" TO "_(IVMENDYR+1700)_":",$J(IVMNONRT,5)
48 W !?5,"TOTAL NEW MEANS TESTS FROM "_(IVMBEGYR+1700)_" TO "_(IVMENDYR+1700)_":",$J(IVMNEWMT,5)
49 W !!?5,"TOTAL PATIENTS WHOSE CATEGORY CHANGED FROM:",!
50 W !?5,"MT COPAY EXEMPT",?27,"TO",?32,"MT COPAY REQUIRED",?52,":",?55,$J(IVMACTOT,5),!?5,"MT COPAY REQUIRED",?27,"TO",?32,"MT COPAY EXEMPT",?52,":",?55,$J(IVMCATOT,5)
51 W !?5,"MT COPAY EXEMPT",?27,"TO",?32,"GMT COPAY REQUIRED",?52,":",?55,$J(IVMAGTOT,5),!?5,"MT COPAY REQUIRED",?27,"TO",?32,"GMT COPAY REQUIRED",?52,":",?55,$J(IVMCGTOT,5)
52 W !?5,"GMT COPAY REQUIRED",?27,"TO",?32,"MT COPAY REQUIRED",?52,":",?55,$J(IVMGCTOT,5),!?5,"GMT COPAY REQUIRED",?27,"TO",?32,"MT COPAY EXEMPT",?52,":",?55,$J(IVMGATOT,5)
53 ;
54ENQ1 D PAUSE^IVMRUTL
55 ;
56ENQ ; Clean up and exit.
57 K ^TMP("IVMMT",$J)
58 I $D(ZTQUEUED) S ZTREQ="@"
59 K IVMI,IVMS,IVMSCR,IVMPDAT,IVMCAT,IVMDT,IVMABDT,IVMDTYR,IVMACTOT,IVMCATOT,IVMAYR1,IVMAYR2,IVMCYR1,IVMCYR2,IVMDA
60 K DFN,IVMNM,IVMQUIT,IVMY1,IVMY2,IVMNONRT,IVMNEWMT,IVMAYR1,IVMDTYR,IVMPAG,IVMCATY1,IVMCATY2,VA("BID"),VA("PID"),X,Y
61 K IVMGYR1,IVMGYR2,IVMGATOT,IVMGCTOT,IVMAGTOT,IVMCGTOT
62 Q
63 ;
64TOTY1 ; Sum total MT COPAY EXTMPT's, MT COPAY REQUIRED's and GMT COPAY REQUIRED's for year 1.
65 S IVMCATY1=$P(IVMSCR,U,3)
66 S:IVMCATY1=4&(IVMY1=IVMBEGYR) IVMAYR1=IVMAYR1+1
67 S:IVMCATY1=6&(IVMY1=IVMBEGYR) IVMCYR1=IVMCYR1+1
68 S:IVMCATY1=16&(IVMY1=IVMBEGYR) IVMGYR1=IVMGYR1+1
69 S:IVMCATY1=4&(IVMY1=IVMENDYR) IVMAYR2=IVMAYR2+1
70 S:IVMCATY1=6&(IVMY1=IVMENDYR) IVMCYR2=IVMCYR2+1
71 S:IVMCATY1=16&(IVMY1=IVMENDYR) IVMGYR2=IVMGYR2+1
72 Q
73 ;
74TOTY2 ; Sum total Cat A's and C's for year 2.
75 S IVMCATY2=$P(IVMSCR,U,5)
76 S:IVMCATY2=4&(IVMY2=IVMENDYR) IVMAYR2=IVMAYR2+1
77 S:IVMCATY2=6&(IVMY2=IVMENDYR) IVMCYR2=IVMCYR2+1
78 S:IVMCATY2=16&(IVMY2=IVMENDYR) IVMGYR2=IVMGYR2+1
79 Q
80 ;
81HDR ; Report heading.
82 I $E(IOST,1,2)["C-"!(IVMPAG) W @IOF ; init form feed to CRT, subsequent form feeds to all other devices
83 S IVMPAG=IVMPAG+1,Y=IVMCURDT X ^DD("DD")
84 W !?3,Y,?66,"PAGE: ",IVMPAG
85 W !?14,"M E A N S T E S T C O M P A R I S O N R E P O R T"
86 W !?28,"FOR YEARS: "_(IVMBEGYR+1700)_" AND "_(IVMENDYR+1700),!,$TR($J(" ",79)," ","="),!!
87 Q
88 ;
89HDRPAT ; Column headings for patient data.
90 W !?5,"PATIENT",?30,"SSN",?42,"MEANS TEST",?64,"MEANS TEST",!?43,"CATEGORY",?65,"CATEGORY",!?45,(IVMBEGYR+1700),?67,(IVMENDYR+1700),!!
91 Q
92 ;
93DSP(X) ; Return the MT category corresponding to the internal number.
94 Q $S(X=4:"MT COPAY EXEMPT",X=6:"MT COPAY REQUIRED",X=16:"GMT COPAY REQUIRED",1:"")
Note: See TracBrowser for help on using the repository browser.