IVMZ07C ;BAJ/PHH/LBD - HL7 Z07 CONSISTENCY CHECKER -- DRIVER ROUTINE ; 7/14/10 11:54am
;;2.0;INCOME VERIFICATION MATCH;**105,128,134,147,153**;JUL 8,1996;Build 2
;
;
; This routine calls various checking subroutines and manages arrays and data filing
; for inconsistency checking prior to building a Z07 HL7 record. This routine returns
; a value and must be called as an API:
;
; I '$$EN^IVMZ07C(DFN) Q
;
; Values returned:
; 0 = Fail: inconsistencies found, do not build Z07 record
; 1 = Pass: No inconsistencies found, Ok to build Z07 record
;
; Must be called from entry point
Q
;
EN(DFN) ; entry point. Patient DFN is sent from calling routine.
; initialize working variables
;IVM*2*153 adds variable DGPMSE
N PASS,DGP,DGSD,U,DGPMSE
S U="^"
;
; Input: DFN = ^DPT(DFN) of record to check
; BATCH = 1 batch/background job records should be counted
; = 0 single job, do not count records
; structure:
; 1. delete existing Z07 inconsistencies
; 2. load data arrays
; 3. call subroutines
; 4. check for Pass/Fail
; 5. update file 38.5 if necessary
; 6. return Pass/Fail
;
; Set flag
S PASS=0
I '$D(^DPT(DFN)) Q PASS
; If DFN is for a merged patient, quit (IVM*2*147)
I $D(^DPT(DFN,-9)) Q PASS
;
S PASS=1
;
; Load Patient and Spouse/dependent data
D LOADPT(DFN,.DGP),LOADSD^IVMZ072(DFN,.DGSD)
;
; Do checks and file inconsistencies
D WORK(DFN,.DGP,.DGSD)
;
; Delete old Inconsistency info
D DELETE(DFN)
;
; File new inconsistencies if necessary
I $$FILE(DFN) S PASS=0
;
; update counters
D COUNT(PASS)
;
; return pass/fail flag
Q PASS
;
COUNT(PASS) ; counter for batch run
N I
; Set it up the first time through
I '$D(^TMP($J,"CC")) D
. F I=0,1 S ^TMP($J,"CC",I)=0
;
; Increment Batch counter
S ^TMP($J,"CC",PASS)=^TMP($J,"CC",PASS)+1
Q
;
LOADPT(DFN,DGP) ; load patient data into arrays
N NIEN,IEN,I,DTTM,NAMCOM,NAME
; we need to load data from the following files
; Patient File 2
; Name Components 20
; Patient Enrollment 27.11
; Means test file 408.31
; MST History file 29.11
; Note: we also need Catastrophic data info, but that subroutine loads its own data array.
;
; ***************************
; DGP("PAT") Patient file
F I=0,.3,.15,.29,.31,.32,.321,.322,.35,.36,.361,.38,.52,"SSN","TYPE","VET" S DGP("PAT",I)=$G(^DPT(DFN,I))
S NAME=$P($G(^DPT(DFN,0)),"^",1),NAMCOM=$P($G(^DPT(DFN,"NAME")),"^",1)'=""
;IVM*2*153 get mse's from mse subfile 2.3216
I '$D(^DPT(DFN,.3216)) D MOVMSE^DGMSEUTL(DFN)
D GETMSE^DGMSEUTL(DFN,.DGPMSE)
;
; ***************************
; DGP("NAME") Name Components
I NAMCOM S NIEN=$P(^DPT(DFN,"NAME"),U,1) I '$D(^VA(20,NIEN,1)) S NAMCOM=0
S DGP("NAME",1)=$S(NAMCOM:$G(^VA(20,NIEN,1)),1:$P(NAME,",")_"^"_$P($P(NAME,",",2)," ",1)_"^"_$P($P(NAME,",",2)," ",2))
;
; ***************************
;
; DGP("ENR") Patient Enrollment
S NIEN="",NIEN=$P($G(^DPT(DFN,"ENR")),U,1)
I NIEN]"",$D(^DGEN(27.11,NIEN)) M DGP("ENR")=^DGEN(27.11,NIEN)
;
; ***************************
; DGP("MEANS") Means Test
S NIEN=+$$LST^DGMTU(DFN) I NIEN,$D(^DGMT(408.31,NIEN,0)) S DGP("MEANS",0)=^DGMT(408.31,NIEN,0)
;
; ***************************
; DGP("MST") MST History
S (DTTM,NIEN)=""
S DTTM=$O(^DGMS(29.11,"APDT",DFN,""),-1)
I DTTM'="" D
. S NIEN=$O(^DGMS(29.11,"APDT",DFN,DTTM,""),-1)
. I $D(^DGMS(29.11,NIEN,0)) S DGP("MST",0)=^DGMS(29.11,NIEN,0)
;
; ***************************
Q
;
WORK(DFN,DGP,DGSD) ;
; call subroutines to run rules and file any inconsistencies
;
; Demographics rules
D EN^IVMZ7CD(DFN,.DGP,.DGSD)
;
; Enrollment/Eligibility rules
D EN^IVMZ7CE(DFN,.DGP)
;
; Service rules
D EN^IVMZ7CS(DFN,.DGP)
;
; Catastrophic Disability rules
D EN^IVMZ7CCD(DFN)
;
; Registration Inconsistencies
D EN^IVMZ7CR(DFN,.DGP,.DGSD)
;
Q
;
DELETE(DFN) ; delete all Z07 inconsistencies from INCONSISTENT DATA file (#38.5). Since we're not sure which rules
; will block a Z07 record, we need to loop through the INCONSISTENT DATA ELEMENTS file (#38.6) and grab only
; those rules which are marked to prevent building a Z07 record:
;
;
N DELARRY,RULE,DIK,DA
;
; create an array of rules which prevent Z07 records
S RULE=0 F S RULE=$O(^DGIN(38.6,RULE)) Q:RULE="" Q:$A(RULE)>$A(9) D
. I $P(^DGIN(38.6,RULE,0),U,6) S DELARRY(RULE)=""
;
; Now we have to check the patient INCONSISTENT DATA file (#38.5) and delete any records which have to be rechecked.
;
S DIK="^DGIN(38.5,"_DFN_","_"""I"""_","
;
S DA="" F S DA=$O(DELARRY(DA)) Q:DA="" D ^DIK
Q
;
FILE(DFN) ;
N FILE,SUCCESS,CCS,I,DGENDA,DATA,SUBFILE,DIK,DA
S FILE=38.5,CCS=0
; if no inconsistencies, return 0
I '$D(^TMP($J,DFN)) D Q CCS
. ; clean up INCONSISTENT DATA file if no inconsistencies exist
. I '$P($G(^DGIN(38.5,DFN,"I",0)),"^",4) D
. . S DIK="^DGIN(38.5,",DA=DFN
. . D ^DIK
;
; else process inconsistencies and return PASS=0
S CCS=1
; if a new entry, create a stub
S DATA(.01)=DFN
I '$D(^DGIN(FILE,"B",DFN)) D
. S DATA(2)=$$DT^XLFDT,DATA(3)=.5
. S SUCCESS=$$ADD^DGENDBS(FILE,,.DATA,,DFN)
;
; update file header with data and user info.
; Last Updated field (#4) = Today's date
; Last Updated by field (#5) = Postmaster
S DGENDA=DFN,DATA(4)=$$DT^XLFDT,DATA(5)=.5
S SUCCESS=$$UPD^DGENDBS(FILE,.DGENDA,.DATA)
;
; add inconsistencies to file
K DATA
S SUBFILE=38.51,DGENDA(1)=DFN
S I="" F S I=$O(^TMP($J,DFN,I)) Q:I="" D
. S (DATA(.01),DATA(.001),DGENDA)=I
. S SUCCESS=$$ADD^DGENDBS(SUBFILE,.DGENDA,.DATA)
;
; kill temp file before exit
K ^TMP($J,DFN)
;
Q CCS
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMZ07C 5893 printed Apr 09, 2024@21:02:28 Page 2
IVMZ07C ;BAJ/PHH/LBD - HL7 Z07 CONSISTENCY CHECKER -- DRIVER ROUTINE ; 7/14/10 11:54am
+1 ;;2.0;INCOME VERIFICATION MATCH;**105,128,134,147,153**;JUL 8,1996;Build 2
+2 ;
+3 ;
+4 ; This routine calls various checking subroutines and manages arrays and data filing
+5 ; for inconsistency checking prior to building a Z07 HL7 record. This routine returns
+6 ; a value and must be called as an API:
+7 ;
+8 ; I '$$EN^IVMZ07C(DFN) Q
+9 ;
+10 ; Values returned:
+11 ; 0 = Fail: inconsistencies found, do not build Z07 record
+12 ; 1 = Pass: No inconsistencies found, Ok to build Z07 record
+13 ;
+14 ; Must be called from entry point
+15 QUIT
+16 ;
EN(DFN) ; entry point. Patient DFN is sent from calling routine.
+1 ; initialize working variables
+2 ;IVM*2*153 adds variable DGPMSE
+3 NEW PASS,DGP,DGSD,U,DGPMSE
+4 SET U="^"
+5 ;
+6 ; Input: DFN = ^DPT(DFN) of record to check
+7 ; BATCH = 1 batch/background job records should be counted
+8 ; = 0 single job, do not count records
+9 ; structure:
+10 ; 1. delete existing Z07 inconsistencies
+11 ; 2. load data arrays
+12 ; 3. call subroutines
+13 ; 4. check for Pass/Fail
+14 ; 5. update file 38.5 if necessary
+15 ; 6. return Pass/Fail
+16 ;
+17 ; Set flag
+18 SET PASS=0
+19 IF '$DATA(^DPT(DFN))
QUIT PASS
+20 ; If DFN is for a merged patient, quit (IVM*2*147)
+21 IF $DATA(^DPT(DFN,-9))
QUIT PASS
+22 ;
+23 SET PASS=1
+24 ;
+25 ; Load Patient and Spouse/dependent data
+26 DO LOADPT(DFN,.DGP)
DO LOADSD^IVMZ072(DFN,.DGSD)
+27 ;
+28 ; Do checks and file inconsistencies
+29 DO WORK(DFN,.DGP,.DGSD)
+30 ;
+31 ; Delete old Inconsistency info
+32 DO DELETE(DFN)
+33 ;
+34 ; File new inconsistencies if necessary
+35 IF $$FILE(DFN)
SET PASS=0
+36 ;
+37 ; update counters
+38 DO COUNT(PASS)
+39 ;
+40 ; return pass/fail flag
+41 QUIT PASS
+42 ;
COUNT(PASS) ; counter for batch run
+1 NEW I
+2 ; Set it up the first time through
+3 IF '$DATA(^TMP($JOB,"CC"))
Begin DoDot:1
+4 FOR I=0,1
SET ^TMP($JOB,"CC",I)=0
End DoDot:1
+5 ;
+6 ; Increment Batch counter
+7 SET ^TMP($JOB,"CC",PASS)=^TMP($JOB,"CC",PASS)+1
+8 QUIT
+9 ;
LOADPT(DFN,DGP) ; load patient data into arrays
+1 NEW NIEN,IEN,I,DTTM,NAMCOM,NAME
+2 ; we need to load data from the following files
+3 ; Patient File 2
+4 ; Name Components 20
+5 ; Patient Enrollment 27.11
+6 ; Means test file 408.31
+7 ; MST History file 29.11
+8 ; Note: we also need Catastrophic data info, but that subroutine loads its own data array.
+9 ;
+10 ; ***************************
+11 ; DGP("PAT") Patient file
+12 FOR I=0,.3,.15,.29,.31,.32,.321,.322,.35,.36,.361,.38,.52,"SSN","TYPE","VET"
SET DGP("PAT",I)=$GET(^DPT(DFN,I))
+13 SET NAME=$PIECE($GET(^DPT(DFN,0)),"^",1)
SET NAMCOM=$PIECE($GET(^DPT(DFN,"NAME")),"^",1)'=""
+14 ;IVM*2*153 get mse's from mse subfile 2.3216
+15 IF '$DATA(^DPT(DFN,.3216))
DO MOVMSE^DGMSEUTL(DFN)
+16 DO GETMSE^DGMSEUTL(DFN,.DGPMSE)
+17 ;
+18 ; ***************************
+19 ; DGP("NAME") Name Components
+20 IF NAMCOM
SET NIEN=$PIECE(^DPT(DFN,"NAME"),U,1)
IF '$DATA(^VA(20,NIEN,1))
SET NAMCOM=0
+21 SET DGP("NAME",1)=$SELECT(NAMCOM:$GET(^VA(20,NIEN,1)),1:$PIECE(NAME,",")_"^"_$PIECE($PIECE(NAME,",",2)," ",1)_"^"_$PIECE($PIECE(NAME,",",2)," ",2))
+22 ;
+23 ; ***************************
+24 ;
+25 ; DGP("ENR") Patient Enrollment
+26 SET NIEN=""
SET NIEN=$PIECE($GET(^DPT(DFN,"ENR")),U,1)
+27 IF NIEN]""
IF $DATA(^DGEN(27.11,NIEN))
MERGE DGP("ENR")=^DGEN(27.11,NIEN)
+28 ;
+29 ; ***************************
+30 ; DGP("MEANS") Means Test
+31 SET NIEN=+$$LST^DGMTU(DFN)
IF NIEN
IF $DATA(^DGMT(408.31,NIEN,0))
SET DGP("MEANS",0)=^DGMT(408.31,NIEN,0)
+32 ;
+33 ; ***************************
+34 ; DGP("MST") MST History
+35 SET (DTTM,NIEN)=""
+36 SET DTTM=$ORDER(^DGMS(29.11,"APDT",DFN,""),-1)
+37 IF DTTM'=""
Begin DoDot:1
+38 SET NIEN=$ORDER(^DGMS(29.11,"APDT",DFN,DTTM,""),-1)
+39 IF $DATA(^DGMS(29.11,NIEN,0))
SET DGP("MST",0)=^DGMS(29.11,NIEN,0)
End DoDot:1
+40 ;
+41 ; ***************************
+42 QUIT
+43 ;
WORK(DFN,DGP,DGSD) ;
+1 ; call subroutines to run rules and file any inconsistencies
+2 ;
+3 ; Demographics rules
+4 DO EN^IVMZ7CD(DFN,.DGP,.DGSD)
+5 ;
+6 ; Enrollment/Eligibility rules
+7 DO EN^IVMZ7CE(DFN,.DGP)
+8 ;
+9 ; Service rules
+10 DO EN^IVMZ7CS(DFN,.DGP)
+11 ;
+12 ; Catastrophic Disability rules
+13 DO EN^IVMZ7CCD(DFN)
+14 ;
+15 ; Registration Inconsistencies
+16 DO EN^IVMZ7CR(DFN,.DGP,.DGSD)
+17 ;
+18 QUIT
+19 ;
DELETE(DFN) ; delete all Z07 inconsistencies from INCONSISTENT DATA file (#38.5). Since we're not sure which rules
+1 ; will block a Z07 record, we need to loop through the INCONSISTENT DATA ELEMENTS file (#38.6) and grab only
+2 ; those rules which are marked to prevent building a Z07 record:
+3 ;
+4 ;
+5 NEW DELARRY,RULE,DIK,DA
+6 ;
+7 ; create an array of rules which prevent Z07 records
+8 SET RULE=0
FOR
SET RULE=$ORDER(^DGIN(38.6,RULE))
if RULE=""
QUIT
if $ASCII(RULE)>$ASCII(9)
QUIT
Begin DoDot:1
+9 IF $PIECE(^DGIN(38.6,RULE,0),U,6)
SET DELARRY(RULE)=""
End DoDot:1
+10 ;
+11 ; Now we have to check the patient INCONSISTENT DATA file (#38.5) and delete any records which have to be rechecked.
+12 ;
+13 SET DIK="^DGIN(38.5,"_DFN_","_"""I"""_","
+14 ;
+15 SET DA=""
FOR
SET DA=$ORDER(DELARRY(DA))
if DA=""
QUIT
DO ^DIK
+16 QUIT
+17 ;
FILE(DFN) ;
+1 NEW FILE,SUCCESS,CCS,I,DGENDA,DATA,SUBFILE,DIK,DA
+2 SET FILE=38.5
SET CCS=0
+3 ; if no inconsistencies, return 0
+4 IF '$DATA(^TMP($JOB,DFN))
Begin DoDot:1
+5 ; clean up INCONSISTENT DATA file if no inconsistencies exist
+6 IF '$PIECE($GET(^DGIN(38.5,DFN,"I",0)),"^",4)
Begin DoDot:2
+7 SET DIK="^DGIN(38.5,"
SET DA=DFN
+8 DO ^DIK
End DoDot:2
End DoDot:1
QUIT CCS
+9 ;
+10 ; else process inconsistencies and return PASS=0
+11 SET CCS=1
+12 ; if a new entry, create a stub
+13 SET DATA(.01)=DFN
+14 IF '$DATA(^DGIN(FILE,"B",DFN))
Begin DoDot:1
+15 SET DATA(2)=$$DT^XLFDT
SET DATA(3)=.5
+16 SET SUCCESS=$$ADD^DGENDBS(FILE,,.DATA,,DFN)
End DoDot:1
+17 ;
+18 ; update file header with data and user info.
+19 ; Last Updated field (#4) = Today's date
+20 ; Last Updated by field (#5) = Postmaster
+21 SET DGENDA=DFN
SET DATA(4)=$$DT^XLFDT
SET DATA(5)=.5
+22 SET SUCCESS=$$UPD^DGENDBS(FILE,.DGENDA,.DATA)
+23 ;
+24 ; add inconsistencies to file
+25 KILL DATA
+26 SET SUBFILE=38.51
SET DGENDA(1)=DFN
+27 SET I=""
FOR
SET I=$ORDER(^TMP($JOB,DFN,I))
if I=""
QUIT
Begin DoDot:1
+28 SET (DATA(.01),DATA(.001),DGENDA)=I
+29 SET SUCCESS=$$ADD^DGENDBS(SUBFILE,.DGENDA,.DATA)
End DoDot:1
+30 ;
+31 ; kill temp file before exit
+32 KILL ^TMP($JOB,DFN)
+33 ;
+34 QUIT CCS
+35 ;
