IVM228P ;ALB/SE,RTK - Means Test Utilities ;09/05/00
;;2.0;INCOME VERIFICATION MATCH;**28**; 21-OCT-94
;
;This routine will determine if "AC" (Means Tests) and "AD"
;(Copay tests) x-references are set for future tests in the
;IVM PATIENT file (#301.5). If a future test without a
;x-reference is found, the routine will set a x-reference for
;it.
;
EN ;entry point
D INIT
Q
EN1 D CREATE
D AC
D AD
D MULTI
D CLEAN
Q
;
;
INIT N %,I,X,X1,X2
S FILERR=""
I $D(XPDNM) D
.I $$VERCP^XPDUTL("DGFDT")'>0 D
..S %=$$NEWCP^XPDUTL("DGFDT","",DT)
.I $$VERCP^XPDUTL("DG5IEN")'>0 D
..S %=$$NEWCP^XPDUTL("DG5IEN","",0)
.I $$VERCP^XPDUTL("DG31IEN")'>0 D
..S %=$$NEWCP^XPDUTL("DG31IEN","",0)
;
F I="MTRECS","MTFIX","MTERR" D
.I $D(^XTMP("DG-"_I)) Q
.S X1=DT
.S X2=30
.D C^%DTC
.S ^XTMP("DG-"_I,0)=X_"^"_$$DT^XLFDT_"^IVM*2*28 POST-INSTALL "_$S(I="MTRECS":"record count",I="MTFIX":"records corrected",1:"filing errors")
;
I '$D(XPDNM) S (^XTMP("DG-MTRECS",1),^XTMP("DG-MTFIX",1))=0
I $D(XPDNM) S %=$$VERCP^XPDUTL("DGFDT") D
.I '$D(^XTMP("DG-MTRECS",1)) S ^XTMP("DG-MTRECS",1)=0
.I '$D(^XTMP("DG-MTFIX",1)) S ^XTMP("DG-MTFIX",1)=0
I $G(%)="" S %=0
I %=0 D EN1
Q
CREATE ;from the "B" x-reference in 408.31 create entries in the temp global
;
K ^TMP("DGFUTURE",$J)
N DGFDT,DG31IEN
S DGFDT=DT
F S DGFDT=$O(^DGMT(408.31,"B",DGFDT)) Q:'DGFDT D
.S DG31IEN=0
.F S DG31IEN=$O(^DGMT(408.31,"B",DGFDT,DG31IEN)) Q:'DG31IEN D
..S ^TMP("DGFUTURE",$J,DGFDT,DG31IEN)=""
..S ^XTMP("DG-MTRECS",1)=$G(^XTMP("DG-MTRECS",1))+1
..Q
Q
;
;
AC ;delete entries in ^TMP found in the "AC" x-ref in 301.5
N DGFDT,DG5IEN,DG31IEN,DATA,%
S DGFDT=DT
F S DGFDT=$O(^IVM(301.5,"AC",DGFDT)) Q:'DGFDT D
.S DG5IEN=0
.F S DG5IEN=$O(^IVM(301.5,"AC",DGFDT,DG5IEN)) Q:'DG5IEN D
..S DG31IEN=0
..S DG31IEN=$O(^IVM(301.5,"AC",DGFDT,DG5IEN,DG31IEN)) Q:'DG31IEN D
...I $D(^TMP("DGFUTURE",$J,DGFDT,DG31IEN)) D
....K ^TMP("DGFUTURE",$J,DGFDT,DG31IEN)
....I $P(^IVM(301.5,DG5IEN,0),"^",6)="" S DATA(.06)=DG31IEN I '$$UPD^DGENDBS(301.5,DG5IEN,.DATA) S FILERR(301.5,DG31IEN)="Unable to access cross reference"
....I $G(FILERR) M ^XTMP("DG-MTERR")=FILERR K FILERR
...I $D(XPDNM) S %=$$UPCP^XPDUTL("DG31IEN",DG31IEN)
..I $D(XPDNM) S %=$$UPCP^XPDUTL("DG5IEN",DG5IEN)
.I $D(XPDNM) S %=$$UPCP^XPDUTL("DGFDT",DGFDT)
Q
;
;
AD ;delete entries in ^TMP found in the "AD" x-ref in 301.5
N DGFDT,DG5IEN,DG31IEN,DATA,%
S DGFDT=DT
F S DGFDT=$O(^IVM(301.5,"AD",DGFDT)) Q:'DGFDT D
.S DG5IEN=0
.F S DG5IEN=$O(^IVM(301.5,"AD",DGFDT,DG5IEN)) Q:'DG5IEN D
..S DG31IEN=0
..S DG31IEN=$O(^IVM(301.5,"AD",DGFDT,DG5IEN,DG31IEN)) Q:'DG31IEN D
...I $D(^TMP("DGFUTURE",$J,DGFDT,DG31IEN)) D
....K ^TMP("DGFUTURE",$J,DGFDT,DG31IEN)
....I $P(^IVM(301.5,DG5IEN,0),"^",7)="" S DATA(.07)=DG31IEN I '$$UPD^DGENDBS(301.5,DG5IEN,.DATA) S FILERR(301.5,DG31IEN)="Unable to access cross reference"
....I $G(FILERR) M ^XTMP("DG-MTERR")=FILERR K FILERR
...I $D(XPDNM) S %=$$UPCP^XPDUTL("DG31IEN",DG31IEN)
..I $D(XPDNM) S %=$$UPCP^XPDUTL("DG5IEN",DG5IEN)
.I $D(XPDNM) S %=$$UPCP^XPDUTL("DGFDT",DGFDT)
Q
;
;
MULTI ;since there can be multi future tests for a patient, check to see
;if there is a value in the patient's 1999 income year record in
;file #301.5 in the 6th piece (means test ien) or the 7th piece
;(copay test ien). delete entry in the ^TMP if there is a pointer
;to the 408.31 file in either field.
;
N DFN,DGFDT,DG31IEN,DG5IEN,DG5IEN1,DGTYPE,ERRMSG
S DGFDT=DT
F S DGFDT=$O(^TMP("DGFUTURE",$J,DGFDT)) Q:'DGFDT D
.S DG31IEN=0
.F S DG31IEN=$O(^TMP("DGFUTURE",$J,DGFDT,DG31IEN)) Q:'DG31IEN D
..S DFN=$P($G(^DGMT(408.31,DG31IEN,0)),"^",2) Q:'DFN
..S DGTYPE=$P($G(^DGMT(408.31,DG31IEN,0)),"^",19)
..S DG5IEN=0
..S DG5IEN=$O(^IVM(301.5,"AYR",2990000,DFN,DG5IEN)) Q:'DG5IEN D
...S DG5IEN1=$G(^IVM(301.5,DG5IEN,0)) Q:'DG5IEN1 D
....I (($P(DG5IEN1,"^",6))!($P(DG5IEN1,"^",7))) K ^TMP("DGFUTURE",$J,DGFDT,DG31IEN) Q
....S ERRMSG=""
....D ADDFUTR^IVMPLOG2(DG31IEN) I ERRMSG'="" S FILERR(301.5,DG31IEN)="Unable to create cross reference"
....S ^XTMP("DG-MTFIX",1)=$G(^XTMP("DG-MTFIX",1))+1
....I $G(FILERR) M ^XTMP("DG-MTERR")=FILERR K FILERR
;
D MAIL^IVM228M
I $D(XPDNM) S %=$$COMCP^XPDUTL("DGFDT")
D BMES^XPDUTL(" Means test clean up routine has completed successfully.")
Q
;
CLEAN K ^TMP("DGFUTURE",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM228P 4449 printed Dec 13, 2024@02:00:56 Page 2
IVM228P ;ALB/SE,RTK - Means Test Utilities ;09/05/00
+1 ;;2.0;INCOME VERIFICATION MATCH;**28**; 21-OCT-94
+2 ;
+3 ;This routine will determine if "AC" (Means Tests) and "AD"
+4 ;(Copay tests) x-references are set for future tests in the
+5 ;IVM PATIENT file (#301.5). If a future test without a
+6 ;x-reference is found, the routine will set a x-reference for
+7 ;it.
+8 ;
EN ;entry point
+1 DO INIT
+2 QUIT
EN1 DO CREATE
+1 DO AC
+2 DO AD
+3 DO MULTI
+4 DO CLEAN
+5 QUIT
+6 ;
+7 ;
INIT NEW %,I,X,X1,X2
+1 SET FILERR=""
+2 IF $DATA(XPDNM)
Begin DoDot:1
+3 IF $$VERCP^XPDUTL("DGFDT")'>0
Begin DoDot:2
+4 SET %=$$NEWCP^XPDUTL("DGFDT","",DT)
End DoDot:2
+5 IF $$VERCP^XPDUTL("DG5IEN")'>0
Begin DoDot:2
+6 SET %=$$NEWCP^XPDUTL("DG5IEN","",0)
End DoDot:2
+7 IF $$VERCP^XPDUTL("DG31IEN")'>0
Begin DoDot:2
+8 SET %=$$NEWCP^XPDUTL("DG31IEN","",0)
End DoDot:2
End DoDot:1
+9 ;
+10 FOR I="MTRECS","MTFIX","MTERR"
Begin DoDot:1
+11 IF $DATA(^XTMP("DG-"_I))
QUIT
+12 SET X1=DT
+13 SET X2=30
+14 DO C^%DTC
+15 SET ^XTMP("DG-"_I,0)=X_"^"_$$DT^XLFDT_"^IVM*2*28 POST-INSTALL "_$S(I="MTRECS":"record count",I="MTFIX":"records corrected",1:"filing errors")
End DoDot:1
+16 ;
+17 IF '$DATA(XPDNM)
SET (^XTMP("DG-MTRECS",1),^XTMP("DG-MTFIX",1))=0
+18 IF $DATA(XPDNM)
SET %=$$VERCP^XPDUTL("DGFDT")
Begin DoDot:1
+19 IF '$DATA(^XTMP("DG-MTRECS",1))
SET ^XTMP("DG-MTRECS",1)=0
+20 IF '$DATA(^XTMP("DG-MTFIX",1))
SET ^XTMP("DG-MTFIX",1)=0
End DoDot:1
+21 IF $GET(%)=""
SET %=0
+22 IF %=0
DO EN1
+23 QUIT
CREATE ;from the "B" x-reference in 408.31 create entries in the temp global
+1 ;
+2 KILL ^TMP("DGFUTURE",$JOB)
+3 NEW DGFDT,DG31IEN
+4 SET DGFDT=DT
+5 FOR
SET DGFDT=$ORDER(^DGMT(408.31,"B",DGFDT))
if 'DGFDT
QUIT
Begin DoDot:1
+6 SET DG31IEN=0
+7 FOR
SET DG31IEN=$ORDER(^DGMT(408.31,"B",DGFDT,DG31IEN))
if 'DG31IEN
QUIT
Begin DoDot:2
+8 SET ^TMP("DGFUTURE",$JOB,DGFDT,DG31IEN)=""
+9 SET ^XTMP("DG-MTRECS",1)=$GET(^XTMP("DG-MTRECS",1))+1
+10 QUIT
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
+13 ;
AC ;delete entries in ^TMP found in the "AC" x-ref in 301.5
+1 NEW DGFDT,DG5IEN,DG31IEN,DATA,%
+2 SET DGFDT=DT
+3 FOR
SET DGFDT=$ORDER(^IVM(301.5,"AC",DGFDT))
if 'DGFDT
QUIT
Begin DoDot:1
+4 SET DG5IEN=0
+5 FOR
SET DG5IEN=$ORDER(^IVM(301.5,"AC",DGFDT,DG5IEN))
if 'DG5IEN
QUIT
Begin DoDot:2
+6 SET DG31IEN=0
+7 SET DG31IEN=$ORDER(^IVM(301.5,"AC",DGFDT,DG5IEN,DG31IEN))
if 'DG31IEN
QUIT
Begin DoDot:3
+8 IF $DATA(^TMP("DGFUTURE",$JOB,DGFDT,DG31IEN))
Begin DoDot:4
+9 KILL ^TMP("DGFUTURE",$JOB,DGFDT,DG31IEN)
+10 IF $PIECE(^IVM(301.5,DG5IEN,0),"^",6)=""
SET DATA(.06)=DG31IEN
IF '$$UPD^DGENDBS(301.5,DG5IEN,.DATA)
SET FILERR(301.5,DG31IEN)="Unable to access cross reference"
+11 IF $GET(FILERR)
MERGE ^XTMP("DG-MTERR")=FILERR
KILL FILERR
End DoDot:4
+12 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DG31IEN",DG31IEN)
End DoDot:3
+13 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DG5IEN",DG5IEN)
End DoDot:2
+14 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGFDT",DGFDT)
End DoDot:1
+15 QUIT
+16 ;
+17 ;
AD ;delete entries in ^TMP found in the "AD" x-ref in 301.5
+1 NEW DGFDT,DG5IEN,DG31IEN,DATA,%
+2 SET DGFDT=DT
+3 FOR
SET DGFDT=$ORDER(^IVM(301.5,"AD",DGFDT))
if 'DGFDT
QUIT
Begin DoDot:1
+4 SET DG5IEN=0
+5 FOR
SET DG5IEN=$ORDER(^IVM(301.5,"AD",DGFDT,DG5IEN))
if 'DG5IEN
QUIT
Begin DoDot:2
+6 SET DG31IEN=0
+7 SET DG31IEN=$ORDER(^IVM(301.5,"AD",DGFDT,DG5IEN,DG31IEN))
if 'DG31IEN
QUIT
Begin DoDot:3
+8 IF $DATA(^TMP("DGFUTURE",$JOB,DGFDT,DG31IEN))
Begin DoDot:4
+9 KILL ^TMP("DGFUTURE",$JOB,DGFDT,DG31IEN)
+10 IF $PIECE(^IVM(301.5,DG5IEN,0),"^",7)=""
SET DATA(.07)=DG31IEN
IF '$$UPD^DGENDBS(301.5,DG5IEN,.DATA)
SET FILERR(301.5,DG31IEN)="Unable to access cross reference"
+11 IF $GET(FILERR)
MERGE ^XTMP("DG-MTERR")=FILERR
KILL FILERR
End DoDot:4
+12 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DG31IEN",DG31IEN)
End DoDot:3
+13 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DG5IEN",DG5IEN)
End DoDot:2
+14 IF $DATA(XPDNM)
SET %=$$UPCP^XPDUTL("DGFDT",DGFDT)
End DoDot:1
+15 QUIT
+16 ;
+17 ;
MULTI ;since there can be multi future tests for a patient, check to see
+1 ;if there is a value in the patient's 1999 income year record in
+2 ;file #301.5 in the 6th piece (means test ien) or the 7th piece
+3 ;(copay test ien). delete entry in the ^TMP if there is a pointer
+4 ;to the 408.31 file in either field.
+5 ;
+6 NEW DFN,DGFDT,DG31IEN,DG5IEN,DG5IEN1,DGTYPE,ERRMSG
+7 SET DGFDT=DT
+8 FOR
SET DGFDT=$ORDER(^TMP("DGFUTURE",$JOB,DGFDT))
if 'DGFDT
QUIT
Begin DoDot:1
+9 SET DG31IEN=0
+10 FOR
SET DG31IEN=$ORDER(^TMP("DGFUTURE",$JOB,DGFDT,DG31IEN))
if 'DG31IEN
QUIT
Begin DoDot:2
+11 SET DFN=$PIECE($GET(^DGMT(408.31,DG31IEN,0)),"^",2)
if 'DFN
QUIT
+12 SET DGTYPE=$PIECE($GET(^DGMT(408.31,DG31IEN,0)),"^",19)
+13 SET DG5IEN=0
+14 SET DG5IEN=$ORDER(^IVM(301.5,"AYR",2990000,DFN,DG5IEN))
if 'DG5IEN
QUIT
Begin DoDot:3
+15 SET DG5IEN1=$GET(^IVM(301.5,DG5IEN,0))
if 'DG5IEN1
QUIT
Begin DoDot:4
+16 IF (($PIECE(DG5IEN1,"^",6))!($PIECE(DG5IEN1,"^",7)))
KILL ^TMP("DGFUTURE",$JOB,DGFDT,DG31IEN)
QUIT
+17 SET ERRMSG=""
+18 DO ADDFUTR^IVMPLOG2(DG31IEN)
IF ERRMSG'=""
SET FILERR(301.5,DG31IEN)="Unable to create cross reference"
+19 SET ^XTMP("DG-MTFIX",1)=$GET(^XTMP("DG-MTFIX",1))+1
+20 IF $GET(FILERR)
MERGE ^XTMP("DG-MTERR")=FILERR
KILL FILERR
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 DO MAIL^IVM228M
+23 IF $DATA(XPDNM)
SET %=$$COMCP^XPDUTL("DGFDT")
+24 DO BMES^XPDUTL(" Means test clean up routine has completed successfully.")
+25 QUIT
+26 ;
CLEAN KILL ^TMP("DGFUTURE",$JOB)
+1 QUIT
