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:"")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMRMCR1 5795 printed Dec 13, 2024@02:02:37 Page 2
IVMRMCR1 ;ALB/ESD/CKN - Means Test Comparison Report ; 3 May 93 ; 07/22/02 9:40am
+1 ;;2.0;INCOME VERIFICATION MATCH ;**62**; 21-OCT-94
+2 ;
+3 ; This processing routine (part of IVMRMCR) will create the ^Tmp
+4 ; global with patient data, total summary statistics for each year, and
+5 ; print patient data (if requested by user) and summary.
+6 ;
EN ; Create ^Tmp global containing SSN, MT Copay Exempt, MT Copay Required
+1 ; GMT Copay Required, and date of means tests for years 1 and 2.
+2 SET IVMDT=""
SET U="^"
KILL ^TMP("IVMMT",$JOB)
+3 FOR IVMCAT=4,6,16
SET IVMDT=-IVMENDYR_9999
FOR
SET IVMDT=$ORDER(^DGMT(408.31,"AS",1,IVMCAT,IVMDT))
if 'IVMDT!(-IVMDT<(IVMBEGYR_"0000"))
QUIT
Begin DoDot:1
+4 SET IVMABDT=-IVMDT
SET IVMDTYR=$EXTRACT(IVMABDT,1,3)
+5 SET DFN=0
FOR
SET DFN=$ORDER(^DGMT(408.31,"AS",1,IVMCAT,IVMDT,DFN))
if 'DFN
QUIT
SET IVMDA=$ORDER(^(DFN,0))
IF $GET(^DGMT(408.31,+IVMDA,"PRIM"))
Begin DoDot:2
+6 SET IVMNM=$PIECE($GET(^DPT(DFN,0)),U)
if IVMNM=""
SET IVMNM="NAME UNKNOWN"
+7 DO PID^VADPT6
+8 IF $DATA(^TMP("IVMMT",$JOB,IVMNM_"@@"_VA("PID")))
SET IVMS=^(IVMNM_"@@"_VA("PID"))
SET $PIECE(IVMS,U,$SELECT(IVMDTYR=IVMBEGYR:2,1:4),$SELECT(IVMDTYR=IVMBEGYR:3,1:5))=IVMABDT_U_IVMCAT
SET ^(IVMNM_"@@"_VA("PID"))=IVMS
QUIT
+9 SET ^TMP("IVMMT",$JOB,IVMNM_"@@"_VA("PID"))=U_$SELECT(IVMDTYR=IVMENDYR:U_U,1:"")_IVMABDT_U_IVMCAT
End DoDot:2
End DoDot:1
+10 ;
+11 ; Initialize report variables and print header(s).
+12 SET (IVMPAG,IVMQUIT)=0
DO HDR
if IVMPFLAG
DO HDRPAT
+13 IF '$DATA(^TMP("IVMMT",$JOB))
WRITE !?5,"No MT Copay Exempt or MT Copay Required or GMT Copay Required patients exist for years selected."
GOTO ENQ1
+14 ;
+15 ; Calculate totals for summary portion of report and print patient data if IVMPFLAG is true.
+16 SET (IVMAYR1,IVMAYR2,IVMCYR1,IVMCYR2,IVMACTOT,IVMCATOT,IVMNONRT,IVMNEWMT,IVMGYR1,IVMGYR2,IVMAGTOT,IVMCGTOT,IVMGATOT,IVMGCTOT)=0
+17 SET IVMPDAT=""
FOR
SET IVMPDAT=$ORDER(^TMP("IVMMT",$JOB,IVMPDAT))
if IVMPDAT=""
QUIT
SET IVMSCR=$GET(^(IVMPDAT))
Begin DoDot:1
+18 SET IVMY1=$EXTRACT($PIECE(IVMSCR,U,2),1,3)
if IVMY1]""
DO TOTY1
+19 SET IVMY2=$EXTRACT($PIECE(IVMSCR,U,4),1,3)
if IVMY2]""
DO TOTY2
+20 IF $PIECE(IVMSCR,U,4)=""
IF ((IVMCURDT-IVMABDT)>10000)
SET IVMNONRT=IVMNONRT+1
+21 IF $PIECE(IVMSCR,U,2)=""
SET IVMNEWMT=IVMNEWMT+1
+22 IF $Y>(IOSL-5)
DO PAUSE^IVMRUTL
if IVMQUIT
QUIT
DO HDR
if IVMPFLAG
DO HDRPAT
+23 if IVMPFLAG
WRITE !,$PIECE(IVMPDAT,"@@"),?26,$PIECE(IVMPDAT,"@@",2),?40,$$DSP($PIECE(IVMSCR,U,3))
+24 IF $PIECE(IVMSCR,U,4)]""
Begin DoDot:2
+25 if IVMPFLAG
WRITE ?60,$$DSP($PIECE(IVMSCR,U,5))
+26 if $PIECE(IVMSCR,U,3)=4&($PIECE(IVMSCR,U,5)=6)
SET IVMACTOT=IVMACTOT+1
+27 if $PIECE(IVMSCR,U,3)=6&($PIECE(IVMSCR,U,5)=4)
SET IVMCATOT=IVMCATOT+1
+28 if $PIECE(IVMSCR,U,3)=4&($PIECE(IVMSCR,U,5)=16)
SET IVMAGTOT=IVMAGTOT+1
+29 if $PIECE(IVMSCR,U,3)=6&($PIECE(IVMSCR,U,5)=16)
SET IVMCGTOT=IVMCGTOT+1
+30 if $PIECE(IVMSCR,U,3)=16&($PIECE(IVMSCR,U,5)=6)
SET IVMGCTOT=IVMGCTOT+1
+31 if $PIECE(IVMSCR,U,3)=16&($PIECE(IVMSCR,U,5)=4)
SET IVMGATOT=IVMGATOT+1
End DoDot:2
End DoDot:1
if IVMQUIT
GOTO ENQ
+32 ;
+33 ; Print summary totals.
+34 IF IVMPFLAG!($Y>(IOSL-5))
DO PAUSE^IVMRUTL
if IVMQUIT
GOTO ENQ
DO HDR
+35 WRITE !,"SUMMARY OF MEANS TESTS FOR YEAR "_(IVMBEGYR+1700),!,$TRANSLATE($JUSTIFY(" ",36)," ","=")
+36 WRITE !?11,"TOTAL MT COPAY EXEMPT :",$JUSTIFY(IVMAYR1,5),!?11,"TOTAL MT COPAY REQUIRED :",$JUSTIFY(IVMCYR1,5),!?11,"TOTAL GMT COPAY REQUIRED:",$JUSTIFY(IVMGYR1,5),!?5,"TOTAL MEANS TESTS:",$JUSTIFY(IVMAYR1+IVMCYR1+IVMGYR1,5)
+37 WRITE !!,"SUMMARY OF MEANS TESTS FOR YEAR "_(IVMENDYR+1700),!,$TRANSLATE($JUSTIFY(" ",36)," ","=")
+38 WRITE !?11,"TOTAL MT COPAY EXEMPT :",$JUSTIFY(IVMAYR2,5),!?11,"TOTAL MT COPAY REQUIRED :",$JUSTIFY(IVMCYR2,5),!?11,"TOTAL GMT COPAY REQUIRED:",$JUSTIFY(IVMGYR2,5),!?5,"TOTAL MEANS TESTS:",$JUSTIFY(IVMAYR2+IVMCYR2+IVMGYR2,5),!
+39 WRITE !!?9,"TOTAL NON-RETURNS FROM "_(IVMBEGYR+1700)_" TO "_(IVMENDYR+1700)_":",$JUSTIFY(IVMNONRT,5)
+40 WRITE !?5,"TOTAL NEW MEANS TESTS FROM "_(IVMBEGYR+1700)_" TO "_(IVMENDYR+1700)_":",$JUSTIFY(IVMNEWMT,5)
+41 WRITE !!?5,"TOTAL PATIENTS WHOSE CATEGORY CHANGED FROM:",!
+42 WRITE !?5,"MT COPAY EXEMPT",?27,"TO",?32,"MT COPAY REQUIRED",?52,":",?55,$JUSTIFY(IVMACTOT,5),!?5,"MT COPAY REQUIRED",?27,"TO",?32,"MT COPAY EXEMPT",?52,":",?55,$JUSTIFY(IVMCATOT,5)
+43 WRITE !?5,"MT COPAY EXEMPT",?27,"TO",?32,"GMT COPAY REQUIRED",?52,":",?55,$JUSTIFY(IVMAGTOT,5),!?5,"MT COPAY REQUIRED",?27,"TO",?32,"GMT COPAY REQUIRED",?52,":",?55,$JUSTIFY(IVMCGTOT,5)
+44 WRITE !?5,"GMT COPAY REQUIRED",?27,"TO",?32,"MT COPAY REQUIRED",?52,":",?55,$JUSTIFY(IVMGCTOT,5),!?5,"GMT COPAY REQUIRED",?27,"TO",?32,"MT COPAY EXEMPT",?52,":",?55,$JUSTIFY(IVMGATOT,5)
+45 ;
ENQ1 DO PAUSE^IVMRUTL
+1 ;
ENQ ; Clean up and exit.
+1 KILL ^TMP("IVMMT",$JOB)
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 KILL IVMI,IVMS,IVMSCR,IVMPDAT,IVMCAT,IVMDT,IVMABDT,IVMDTYR,IVMACTOT,IVMCATOT,IVMAYR1,IVMAYR2,IVMCYR1,IVMCYR2,IVMDA
+4 KILL DFN,IVMNM,IVMQUIT,IVMY1,IVMY2,IVMNONRT,IVMNEWMT,IVMAYR1,IVMDTYR,IVMPAG,IVMCATY1,IVMCATY2,VA("BID"),VA("PID"),X,Y
+5 KILL IVMGYR1,IVMGYR2,IVMGATOT,IVMGCTOT,IVMAGTOT,IVMCGTOT
+6 QUIT
+7 ;
TOTY1 ; Sum total MT COPAY EXTMPT's, MT COPAY REQUIRED's and GMT COPAY REQUIRED's for year 1.
+1 SET IVMCATY1=$PIECE(IVMSCR,U,3)
+2 if IVMCATY1=4&(IVMY1=IVMBEGYR)
SET IVMAYR1=IVMAYR1+1
+3 if IVMCATY1=6&(IVMY1=IVMBEGYR)
SET IVMCYR1=IVMCYR1+1
+4 if IVMCATY1=16&(IVMY1=IVMBEGYR)
SET IVMGYR1=IVMGYR1+1
+5 if IVMCATY1=4&(IVMY1=IVMENDYR)
SET IVMAYR2=IVMAYR2+1
+6 if IVMCATY1=6&(IVMY1=IVMENDYR)
SET IVMCYR2=IVMCYR2+1
+7 if IVMCATY1=16&(IVMY1=IVMENDYR)
SET IVMGYR2=IVMGYR2+1
+8 QUIT
+9 ;
TOTY2 ; Sum total Cat A's and C's for year 2.
+1 SET IVMCATY2=$PIECE(IVMSCR,U,5)
+2 if IVMCATY2=4&(IVMY2=IVMENDYR)
SET IVMAYR2=IVMAYR2+1
+3 if IVMCATY2=6&(IVMY2=IVMENDYR)
SET IVMCYR2=IVMCYR2+1
+4 if IVMCATY2=16&(IVMY2=IVMENDYR)
SET IVMGYR2=IVMGYR2+1
+5 QUIT
+6 ;
HDR ; Report heading.
+1 ; init form feed to CRT, subsequent form feeds to all other devices
IF $EXTRACT(IOST,1,2)["C-"!(IVMPAG)
WRITE @IOF
+2 SET IVMPAG=IVMPAG+1
SET Y=IVMCURDT
XECUTE ^DD("DD")
+3 WRITE !?3,Y,?66,"PAGE: ",IVMPAG
+4 WRITE !?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"
+5 WRITE !?28,"FOR YEARS: "_(IVMBEGYR+1700)_" AND "_(IVMENDYR+1700),!,$TRANSLATE($JUSTIFY(" ",79)," ","="),!!
+6 QUIT
+7 ;
HDRPAT ; Column headings for patient data.
+1 WRITE !?5,"PATIENT",?30,"SSN",?42,"MEANS TEST",?64,"MEANS TEST",!?43,"CATEGORY",?65,"CATEGORY",!?45,(IVMBEGYR+1700),?67,(IVMENDYR+1700),!!
+2 QUIT
+3 ;
DSP(X) ; Return the MT category corresponding to the internal number.
+1 QUIT $SELECT(X=4:"MT COPAY EXEMPT",X=6:"MT COPAY REQUIRED",X=16:"GMT COPAY REQUIRED",1:"")
