VistA-WorldVistAEHR/r/INCOME_VERIFICATION_MATCH-IVM/IVMRMCR1.m

95 lines
5.6 KiB
Mathematica

IVMRMCR1 ;ALB/ESD/CKN - Means Test Comparison Report ; 3 May 93 ; 07/22/02 9:40am
;;2.0;INCOME VERIFICATION MATCH ;**62**; 21-OCT-94
;
; This processing routine (part of IVMRMCR) will create the ^Tmp
; global with patient data, total summary statistics for each year, and
; print patient data (if requested by user) and summary.
;
EN ; Create ^Tmp global containing SSN, MT Copay Exempt, MT Copay Required
; GMT Copay Required, and date of means tests for years 1 and 2.
S IVMDT="",U="^" K ^TMP("IVMMT",$J)
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
.S IVMABDT=-IVMDT,IVMDTYR=$E(IVMABDT,1,3)
.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
..S IVMNM=$P($G(^DPT(DFN,0)),U) S:IVMNM="" IVMNM="NAME UNKNOWN"
..D PID^VADPT6
..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
..S ^TMP("IVMMT",$J,IVMNM_"@@"_VA("PID"))=U_$S(IVMDTYR=IVMENDYR:U_U,1:"")_IVMABDT_U_IVMCAT
;
; Initialize report variables and print header(s).
S (IVMPAG,IVMQUIT)=0 D HDR,HDRPAT:IVMPFLAG
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
;
; Calculate totals for summary portion of report and print patient data if IVMPFLAG is true.
S (IVMAYR1,IVMAYR2,IVMCYR1,IVMCYR2,IVMACTOT,IVMCATOT,IVMNONRT,IVMNEWMT,IVMGYR1,IVMGYR2,IVMAGTOT,IVMCGTOT,IVMGATOT,IVMGCTOT)=0
S IVMPDAT="" F S IVMPDAT=$O(^TMP("IVMMT",$J,IVMPDAT)) Q:IVMPDAT="" S IVMSCR=$G(^(IVMPDAT)) D G:IVMQUIT ENQ
. S IVMY1=$E($P(IVMSCR,U,2),1,3) D:IVMY1]"" TOTY1
. S IVMY2=$E($P(IVMSCR,U,4),1,3) D:IVMY2]"" TOTY2
. I $P(IVMSCR,U,4)="",((IVMCURDT-IVMABDT)>10000) S IVMNONRT=IVMNONRT+1
. I $P(IVMSCR,U,2)="" S IVMNEWMT=IVMNEWMT+1
. I $Y>(IOSL-5) D PAUSE^IVMRUTL Q:IVMQUIT D HDR,HDRPAT:IVMPFLAG
. W:IVMPFLAG !,$P(IVMPDAT,"@@"),?26,$P(IVMPDAT,"@@",2),?40,$$DSP($P(IVMSCR,U,3))
. I $P(IVMSCR,U,4)]"" D
.. W:IVMPFLAG ?60,$$DSP($P(IVMSCR,U,5))
.. S:$P(IVMSCR,U,3)=4&($P(IVMSCR,U,5)=6) IVMACTOT=IVMACTOT+1
.. S:$P(IVMSCR,U,3)=6&($P(IVMSCR,U,5)=4) IVMCATOT=IVMCATOT+1
.. S:$P(IVMSCR,U,3)=4&($P(IVMSCR,U,5)=16) IVMAGTOT=IVMAGTOT+1
.. S:$P(IVMSCR,U,3)=6&($P(IVMSCR,U,5)=16) IVMCGTOT=IVMCGTOT+1
.. S:$P(IVMSCR,U,3)=16&($P(IVMSCR,U,5)=6) IVMGCTOT=IVMGCTOT+1
.. S:$P(IVMSCR,U,3)=16&($P(IVMSCR,U,5)=4) IVMGATOT=IVMGATOT+1
;
; Print summary totals.
I IVMPFLAG!($Y>(IOSL-5)) D PAUSE^IVMRUTL G:IVMQUIT ENQ D HDR
W !,"SUMMARY OF MEANS TESTS FOR YEAR "_(IVMBEGYR+1700),!,$TR($J(" ",36)," ","=")
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)
W !!,"SUMMARY OF MEANS TESTS FOR YEAR "_(IVMENDYR+1700),!,$TR($J(" ",36)," ","=")
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),!
W !!?9,"TOTAL NON-RETURNS FROM "_(IVMBEGYR+1700)_" TO "_(IVMENDYR+1700)_":",$J(IVMNONRT,5)
W !?5,"TOTAL NEW MEANS TESTS FROM "_(IVMBEGYR+1700)_" TO "_(IVMENDYR+1700)_":",$J(IVMNEWMT,5)
W !!?5,"TOTAL PATIENTS WHOSE CATEGORY CHANGED FROM:",!
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)
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)
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)
;
ENQ1 D PAUSE^IVMRUTL
;
ENQ ; Clean up and exit.
K ^TMP("IVMMT",$J)
I $D(ZTQUEUED) S ZTREQ="@"
K IVMI,IVMS,IVMSCR,IVMPDAT,IVMCAT,IVMDT,IVMABDT,IVMDTYR,IVMACTOT,IVMCATOT,IVMAYR1,IVMAYR2,IVMCYR1,IVMCYR2,IVMDA
K DFN,IVMNM,IVMQUIT,IVMY1,IVMY2,IVMNONRT,IVMNEWMT,IVMAYR1,IVMDTYR,IVMPAG,IVMCATY1,IVMCATY2,VA("BID"),VA("PID"),X,Y
K IVMGYR1,IVMGYR2,IVMGATOT,IVMGCTOT,IVMAGTOT,IVMCGTOT
Q
;
TOTY1 ; Sum total MT COPAY EXTMPT's, MT COPAY REQUIRED's and GMT COPAY REQUIRED's for year 1.
S IVMCATY1=$P(IVMSCR,U,3)
S:IVMCATY1=4&(IVMY1=IVMBEGYR) IVMAYR1=IVMAYR1+1
S:IVMCATY1=6&(IVMY1=IVMBEGYR) IVMCYR1=IVMCYR1+1
S:IVMCATY1=16&(IVMY1=IVMBEGYR) IVMGYR1=IVMGYR1+1
S:IVMCATY1=4&(IVMY1=IVMENDYR) IVMAYR2=IVMAYR2+1
S:IVMCATY1=6&(IVMY1=IVMENDYR) IVMCYR2=IVMCYR2+1
S:IVMCATY1=16&(IVMY1=IVMENDYR) IVMGYR2=IVMGYR2+1
Q
;
TOTY2 ; Sum total Cat A's and C's for year 2.
S IVMCATY2=$P(IVMSCR,U,5)
S:IVMCATY2=4&(IVMY2=IVMENDYR) IVMAYR2=IVMAYR2+1
S:IVMCATY2=6&(IVMY2=IVMENDYR) IVMCYR2=IVMCYR2+1
S:IVMCATY2=16&(IVMY2=IVMENDYR) IVMGYR2=IVMGYR2+1
Q
;
HDR ; Report heading.
I $E(IOST,1,2)["C-"!(IVMPAG) W @IOF ; init form feed to CRT, subsequent form feeds to all other devices
S IVMPAG=IVMPAG+1,Y=IVMCURDT X ^DD("DD")
W !?3,Y,?66,"PAGE: ",IVMPAG
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"
W !?28,"FOR YEARS: "_(IVMBEGYR+1700)_" AND "_(IVMENDYR+1700),!,$TR($J(" ",79)," ","="),!!
Q
;
HDRPAT ; Column headings for patient data.
W !?5,"PATIENT",?30,"SSN",?42,"MEANS TEST",?64,"MEANS TEST",!?43,"CATEGORY",?65,"CATEGORY",!?45,(IVMBEGYR+1700),?67,(IVMENDYR+1700),!!
Q
;
DSP(X) ; Return the MT category corresponding to the internal number.
Q $S(X=4:"MT COPAY EXEMPT",X=6:"MT COPAY REQUIRED",X=16:"GMT COPAY REQUIRED",1:"")