- DG311PIR ;ALB/JJG-Total Dependents Calculation Utility ; 07 AUG 2000
- ;;5.3;Registration;**311**;Aug 13, 1993
- ;
- ; This routine will be run as a post-installation routine for patch
- ; DG*5.3*311. The main purpose for this routine is to recalculate
- ; the TOTAL DEPENDENTS field (408.31,.18) of the ANNUAL MEANS TEST file
- ; (#408.31). This field may have been set incorrectly as a result of
- ; a recent modification to routine DGMTU11 that was released as part of
- ; patch DG*5.3*291.
- ;
- POST ;entry point for post-install, setting up checkpoints
- N %
- I $D(XPDNM) S %=$$NEWCP^XPDUTL("DGMTDT","MAIN^DG311PIR",0)
- Q
- MAIN ;Main Driver
- N DGRECNT,DGLY,DGMTPAR
- S U="^",DGRECNT=0
- D BMES^XPDUTL(" Starting post-install process...")
- S DGLY=2990000 ;Last Year, required by PAR^DGMTSCU
- D PAR^DGMTSCU
- D LOOP
- D MAIN^DG311PTR ; Clean up any invalid '0' pointers to Patient Relation
- D BMES^XPDUTL(" Post-install process has completed.")
- D BMES^XPDUTL(" "_DGRECNT_" total records have been identified and corrected.")
- Q
- LOOP ; Locate and correct incorrect TOTAL DEPENDENTS field
- N DGMTDT,DGIEN31,DGNOD31,DGIEN2,DGSTA,DGTOTD,DGMTYPT,DGDEPC,DGPAY,DGDEC
- N DGHARD
- S DGMTDT=3000705 ;Patch DG*5.3*291 release date
- I $D(XPDNM) S DGMTDT=+$$PARCP^XPDUTL("DGMTDT")
- S:(DGMTDT<3000705) DGMTDT=3000705
- F S DGMTDT=$O(^DGMT(408.31,"B",DGMTDT)) Q:'DGMTDT D
- .S DGIEN31=0
- .F S DGIEN31=$O(^DGMT(408.31,"B",DGMTDT,DGIEN31)) Q:'DGIEN31 D
- . .S DGNOD31=$G(^DGMT(408.31,DGIEN31,0))
- . .S DGIEN2=$P(DGNOD31,"^",2) Q:'DGIEN2
- . .S DGSTA=$P(DGNOD31,"^",3) ;Means Test Status
- . .S DGMTYPT=$P(DGNOD31,"^",19) ;Type of Test: 1=Means Test 2=Copay Test
- . .S DGTOTD=$P(DGNOD31,"^",18) ;Total Dependents
- . .S DGPAY=$P(DGNOD31,"^",11) ;Agreed To Pay Deductible
- . .S DGDEC=$P(DGNOD31,"^",14) ;Declines To Give Income Info.
- . .S DGHARD=$P(DGNOD31,"^",20) ;Hardship?
- . .D GETREL^DGMTU11(DGIEN2,"VSC",DGMTDT,DGIEN31) ; Recalculate Total Dependents minus spouse
- . .S DGDEPC=DGDEP
- . .S:$G(DGREL("S")) DGDEPC=DGDEPC+1 ; Include the spouse as DGMTU11 only returns children
- . .I (DGTOTD!DGDEPC)&(DGTOTD'=DGDEPC) D UPDATE
- . .I $D(XPDNM) S %=$$UPCP^XPDUTL("DGMTDT",DGMTDT) ; Update Checkpoint
- Q
- UPDATE ;Update .18 field of ANNUAL MEANS TEST file
- N DATA,DGENDA,ERROR,DFN,DGMTI,DGVIRI,DGVINI,DGMTACT,DGMTI,DGMTINF,DGREL,DGPRIEN,DGUPSW
- S DFN=DGIEN2,DGMTI=DGIEN31,(DGVIRI,DGREL,DGUPSW)=""
- F S:(DGREL'=1) DGVIRI=$O(^DGMT(408.22,"B",DFN,DGVIRI),-1) Q:DGREL=1!('DGVIRI) D
- .S DGVINI=$P($G(^DGMT(408.22,DGVIRI,0)),U,2)
- .Q:'DGVINI
- .S DGPRIEN=$P($G(^DGMT(408.21,DGVINI,0)),U,2) ; Pointer to PATIENT RELATION file (#408.12)
- .Q:'DGPRIEN
- .S DGREL=$P($G(^DGPR(408.12,DGPRIEN,0)),U,2) ;Pointer to RELATIONSHIP file (#408.11)
- .I DGREL=1 S DATA(.13)=DGDEP,DGENDA=DGVIRI,ERROR="" D
- .. I $$UPD^DGENDBS(408.22,.DGENDA,.DATA,.ERROR) Q
- Q:DGREL'=1 ; Quit if relationship is not 'SELF'
- D:(DGSTA=4)!(DGMTYPT=2&(DGSTA=7)) SET^DGMTSCU2 ;only make call if current status is 'Cat A'. Or, if copay test, only make call for status of 'Exempt'.
- K DATA
- S DATA(.18)=DGDEPC ; Newly derived Total # of dependents
- ; In the following 2 lines, only want to update Status and associated
- ; fields if current status is 'Cat A', and 'Hardship' flag is not 'YES'.
- ; For copay test, only update status and associated fields if current
- ; status is 'Exempt' and 'Hardship' flag is not 'YES'.
- I (DGSTA=4),'DGHARD S DGUPSW=1
- I DGMTYPT=2&(DGSTA=7),'DGHARD S DGUPSW=1
- I DGUPSW D
- .S DATA(.03)=DGMTS ; Newly derived Status
- .S DATA(.12)=DGTHA ; Newly derived Threshold A field
- .S DATA(2.03)=DGMTS ; Newly derived Test Determined Status
- I (DGSTA'=4)&(DGSTA'=7) S DGMTS=DGSTA ; need DGMTS for build of ^XTMP
- S DGENDA=DGIEN31,ERROR=""
- S DGMTACT="EDT",DGMTI=DGENDA,DGMTINF=1 ; Needed for call to DGMTEVT
- D PRIOR^DGMTEVT
- I $$UPD^DGENDBS(408.31,.DGENDA,.DATA,.ERROR) D
- .D AFTER^DGMTEVT
- .D EN^DGMTEVT ; Call to Means Test Event Driver
- .S DGRECNT=DGRECNT+1
- .D BUILDLN
- .D ATRXREF
- Q
- ;
- BUILDLN ; Build storage array with data
- ;
- ;Output:
- ; ^XTMP("DG311PIR",pt name,pt ssn,income year,old status,new status)=""
- ;
- N DGNAME,DGSSN,DGINY
- ;
- ; - pt name and ssn from Patient (#2) file
- S DGNAME=$P($G(^DPT(DFN,0)),"^"),DGSSN=$P($G(^(.36)),"^",3)
- S:DGNAME="" DGNAME=DFN
- S:DGSSN="" DGSSN="MISSING"
- S Y=DGMTDT
- D DD^%DT
- S DGINY=$P(Y," ",3)
- ;
- S ^XTMP("DG311PIR",DGNAME,DGSSN,DGINY,DGSTA,DGMTS)=""
- Q
- ;
- ATRXREF ; Add entry into the 'ATR' cross reference of the IVM PATIENT (#301.5)
- ; file so that demographic and income information will be transmitted
- ; to the IVM Center.
- ;
- N IVIEN,IVNOD,IVIY,IVLAST,IVSF,IVTS
- S IVIEN="",IVLAST=0,IVLIEN=""
- F S IVIEN=$O(^IVM(301.5,"B",DGIEN2,IVIEN)) Q:'IVIEN D
- . S IVNOD=^IVM(301.5,IVIEN,0)
- . S IVIY=$P(IVNOD,U,2)
- . S:(IVIY>IVLAST) IVLAST=IVIY,IVLIEN=IVIEN
- I (IVLIEN'="") D
- . S ^IVM(301.5,"ATR",0,IVLIEN)=""
- . S IVTS=$P(IVNOD,U,3) ; Transmission Status Flag
- . S IVSF=$P(IVNOD,U,4) ; Stop Flag
- . I IVTS!IVSF D
- .. K DATA
- .. S DATA(.03)=0,DATA(.04)=0,ERROR=""
- .. I $$UPD^DGENDBS(301.5,.IVLIEN,.DATA,.ERROR) Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG311PIR 5150 printed Mar 13, 2025@21:39:58 Page 2
- DG311PIR ;ALB/JJG-Total Dependents Calculation Utility ; 07 AUG 2000
- +1 ;;5.3;Registration;**311**;Aug 13, 1993
- +2 ;
- +3 ; This routine will be run as a post-installation routine for patch
- +4 ; DG*5.3*311. The main purpose for this routine is to recalculate
- +5 ; the TOTAL DEPENDENTS field (408.31,.18) of the ANNUAL MEANS TEST file
- +6 ; (#408.31). This field may have been set incorrectly as a result of
- +7 ; a recent modification to routine DGMTU11 that was released as part of
- +8 ; patch DG*5.3*291.
- +9 ;
- POST ;entry point for post-install, setting up checkpoints
- +1 NEW %
- +2 IF $DATA(XPDNM)
- SET %=$$NEWCP^XPDUTL("DGMTDT","MAIN^DG311PIR",0)
- +3 QUIT
- MAIN ;Main Driver
- +1 NEW DGRECNT,DGLY,DGMTPAR
- +2 SET U="^"
- SET DGRECNT=0
- +3 DO BMES^XPDUTL(" Starting post-install process...")
- +4 ;Last Year, required by PAR^DGMTSCU
- SET DGLY=2990000
- +5 DO PAR^DGMTSCU
- +6 DO LOOP
- +7 ; Clean up any invalid '0' pointers to Patient Relation
- DO MAIN^DG311PTR
- +8 DO BMES^XPDUTL(" Post-install process has completed.")
- +9 DO BMES^XPDUTL(" "_DGRECNT_" total records have been identified and corrected.")
- +10 QUIT
- LOOP ; Locate and correct incorrect TOTAL DEPENDENTS field
- +1 NEW DGMTDT,DGIEN31,DGNOD31,DGIEN2,DGSTA,DGTOTD,DGMTYPT,DGDEPC,DGPAY,DGDEC
- +2 NEW DGHARD
- +3 ;Patch DG*5.3*291 release date
- SET DGMTDT=3000705
- +4 IF $DATA(XPDNM)
- SET DGMTDT=+$$PARCP^XPDUTL("DGMTDT")
- +5 if (DGMTDT<3000705)
- SET DGMTDT=3000705
- +6 FOR
- SET DGMTDT=$ORDER(^DGMT(408.31,"B",DGMTDT))
- if 'DGMTDT
- QUIT
- Begin DoDot:1
- +7 SET DGIEN31=0
- +8 FOR
- SET DGIEN31=$ORDER(^DGMT(408.31,"B",DGMTDT,DGIEN31))
- if 'DGIEN31
- QUIT
- Begin DoDot:2
- +9 SET DGNOD31=$GET(^DGMT(408.31,DGIEN31,0))
- +10 SET DGIEN2=$PIECE(DGNOD31,"^",2)
- if 'DGIEN2
- QUIT
- +11 ;Means Test Status
- SET DGSTA=$PIECE(DGNOD31,"^",3)
- +12 ;Type of Test: 1=Means Test 2=Copay Test
- SET DGMTYPT=$PIECE(DGNOD31,"^",19)
- +13 ;Total Dependents
- SET DGTOTD=$PIECE(DGNOD31,"^",18)
- +14 ;Agreed To Pay Deductible
- SET DGPAY=$PIECE(DGNOD31,"^",11)
- +15 ;Declines To Give Income Info.
- SET DGDEC=$PIECE(DGNOD31,"^",14)
- +16 ;Hardship?
- SET DGHARD=$PIECE(DGNOD31,"^",20)
- +17 ; Recalculate Total Dependents minus spouse
- DO GETREL^DGMTU11(DGIEN2,"VSC",DGMTDT,DGIEN31)
- +18 SET DGDEPC=DGDEP
- +19 ; Include the spouse as DGMTU11 only returns children
- if $GET(DGREL("S"))
- SET DGDEPC=DGDEPC+1
- +20 IF (DGTOTD!DGDEPC)&(DGTOTD'=DGDEPC)
- DO UPDATE
- +21 ; Update Checkpoint
- IF $DATA(XPDNM)
- SET %=$$UPCP^XPDUTL("DGMTDT",DGMTDT)
- End DoDot:2
- End DoDot:1
- +22 QUIT
- UPDATE ;Update .18 field of ANNUAL MEANS TEST file
- +1 NEW DATA,DGENDA,ERROR,DFN,DGMTI,DGVIRI,DGVINI,DGMTACT,DGMTI,DGMTINF,DGREL,DGPRIEN,DGUPSW
- +2 SET DFN=DGIEN2
- SET DGMTI=DGIEN31
- SET (DGVIRI,DGREL,DGUPSW)=""
- +3 FOR
- if (DGREL'=1)
- SET DGVIRI=$ORDER(^DGMT(408.22,"B",DFN,DGVIRI),-1)
- if DGREL=1!('DGVIRI)
- QUIT
- Begin DoDot:1
- +4 SET DGVINI=$PIECE($GET(^DGMT(408.22,DGVIRI,0)),U,2)
- +5 if 'DGVINI
- QUIT
- +6 ; Pointer to PATIENT RELATION file (#408.12)
- SET DGPRIEN=$PIECE($GET(^DGMT(408.21,DGVINI,0)),U,2)
- +7 if 'DGPRIEN
- QUIT
- +8 ;Pointer to RELATIONSHIP file (#408.11)
- SET DGREL=$PIECE($GET(^DGPR(408.12,DGPRIEN,0)),U,2)
- +9 IF DGREL=1
- SET DATA(.13)=DGDEP
- SET DGENDA=DGVIRI
- SET ERROR=""
- Begin DoDot:2
- +10 IF $$UPD^DGENDBS(408.22,.DGENDA,.DATA,.ERROR)
- QUIT
- End DoDot:2
- End DoDot:1
- +11 ; Quit if relationship is not 'SELF'
- if DGREL'=1
- QUIT
- +12 ;only make call if current status is 'Cat A'. Or, if copay test, only make call for status of 'Exempt'.
- if (DGSTA=4)!(DGMTYPT=2&(DGSTA=7))
- DO SET^DGMTSCU2
- +13 KILL DATA
- +14 ; Newly derived Total # of dependents
- SET DATA(.18)=DGDEPC
- +15 ; In the following 2 lines, only want to update Status and associated
- +16 ; fields if current status is 'Cat A', and 'Hardship' flag is not 'YES'.
- +17 ; For copay test, only update status and associated fields if current
- +18 ; status is 'Exempt' and 'Hardship' flag is not 'YES'.
- +19 IF (DGSTA=4)
- IF 'DGHARD
- SET DGUPSW=1
- +20 IF DGMTYPT=2&(DGSTA=7)
- IF 'DGHARD
- SET DGUPSW=1
- +21 IF DGUPSW
- Begin DoDot:1
- +22 ; Newly derived Status
- SET DATA(.03)=DGMTS
- +23 ; Newly derived Threshold A field
- SET DATA(.12)=DGTHA
- +24 ; Newly derived Test Determined Status
- SET DATA(2.03)=DGMTS
- End DoDot:1
- +25 ; need DGMTS for build of ^XTMP
- IF (DGSTA'=4)&(DGSTA'=7)
- SET DGMTS=DGSTA
- +26 SET DGENDA=DGIEN31
- SET ERROR=""
- +27 ; Needed for call to DGMTEVT
- SET DGMTACT="EDT"
- SET DGMTI=DGENDA
- SET DGMTINF=1
- +28 DO PRIOR^DGMTEVT
- +29 IF $$UPD^DGENDBS(408.31,.DGENDA,.DATA,.ERROR)
- Begin DoDot:1
- +30 DO AFTER^DGMTEVT
- +31 ; Call to Means Test Event Driver
- DO EN^DGMTEVT
- +32 SET DGRECNT=DGRECNT+1
- +33 DO BUILDLN
- +34 DO ATRXREF
- End DoDot:1
- +35 QUIT
- +36 ;
- BUILDLN ; Build storage array with data
- +1 ;
- +2 ;Output:
- +3 ; ^XTMP("DG311PIR",pt name,pt ssn,income year,old status,new status)=""
- +4 ;
- +5 NEW DGNAME,DGSSN,DGINY
- +6 ;
- +7 ; - pt name and ssn from Patient (#2) file
- +8 SET DGNAME=$PIECE($GET(^DPT(DFN,0)),"^")
- SET DGSSN=$PIECE($GET(^(.36)),"^",3)
- +9 if DGNAME=""
- SET DGNAME=DFN
- +10 if DGSSN=""
- SET DGSSN="MISSING"
- +11 SET Y=DGMTDT
- +12 DO DD^%DT
- +13 SET DGINY=$PIECE(Y," ",3)
- +14 ;
- +15 SET ^XTMP("DG311PIR",DGNAME,DGSSN,DGINY,DGSTA,DGMTS)=""
- +16 QUIT
- +17 ;
- ATRXREF ; Add entry into the 'ATR' cross reference of the IVM PATIENT (#301.5)
- +1 ; file so that demographic and income information will be transmitted
- +2 ; to the IVM Center.
- +3 ;
- +4 NEW IVIEN,IVNOD,IVIY,IVLAST,IVSF,IVTS
- +5 SET IVIEN=""
- SET IVLAST=0
- SET IVLIEN=""
- +6 FOR
- SET IVIEN=$ORDER(^IVM(301.5,"B",DGIEN2,IVIEN))
- if 'IVIEN
- QUIT
- Begin DoDot:1
- +7 SET IVNOD=^IVM(301.5,IVIEN,0)
- +8 SET IVIY=$PIECE(IVNOD,U,2)
- +9 if (IVIY>IVLAST)
- SET IVLAST=IVIY
- SET IVLIEN=IVIEN
- End DoDot:1
- +10 IF (IVLIEN'="")
- Begin DoDot:1
- +11 SET ^IVM(301.5,"ATR",0,IVLIEN)=""
- +12 ; Transmission Status Flag
- SET IVTS=$PIECE(IVNOD,U,3)
- +13 ; Stop Flag
- SET IVSF=$PIECE(IVNOD,U,4)
- +14 IF IVTS!IVSF
- Begin DoDot:2
- +15 KILL DATA
- +16 SET DATA(.03)=0
- SET DATA(.04)=0
- SET ERROR=""
- +17 IF $$UPD^DGENDBS(301.5,.IVLIEN,.DATA,.ERROR)
- QUIT
- End DoDot:2
- End DoDot:1
- +18 QUIT