- 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 Jan 18, 2025@03:01:20 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