95 lines
5.6 KiB
Mathematica
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:"")
|