Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG311PIR

DG311PIR.m

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