source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG311PIR.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.9 KB
Line 
1DG311PIR ;ALB/JJG-Total Dependents Calculation Utility ; 07 AUG 2000
2 ;;5.3;Registration;**311**;Aug 13, 1993
3 ;
4 ; This routine will be run as a post-installation routine for patch
5 ; DG*5.3*311. The main purpose for this routine is to recalculate
6 ; the TOTAL DEPENDENTS field (408.31,.18) of the ANNUAL MEANS TEST file
7 ; (#408.31). This field may have been set incorrectly as a result of
8 ; a recent modification to routine DGMTU11 that was released as part of
9 ; patch DG*5.3*291.
10 ;
11POST ;entry point for post-install, setting up checkpoints
12 N %
13 I $D(XPDNM) S %=$$NEWCP^XPDUTL("DGMTDT","MAIN^DG311PIR",0)
14 Q
15MAIN ;Main Driver
16 N DGRECNT,DGLY,DGMTPAR
17 S U="^",DGRECNT=0
18 D BMES^XPDUTL(" Starting post-install process...")
19 S DGLY=2990000 ;Last Year, required by PAR^DGMTSCU
20 D PAR^DGMTSCU
21 D LOOP
22 D MAIN^DG311PTR ; Clean up any invalid '0' pointers to Patient Relation
23 D BMES^XPDUTL(" Post-install process has completed.")
24 D BMES^XPDUTL(" "_DGRECNT_" total records have been identified and corrected.")
25 Q
26LOOP ; Locate and correct incorrect TOTAL DEPENDENTS field
27 N DGMTDT,DGIEN31,DGNOD31,DGIEN2,DGSTA,DGTOTD,DGMTYPT,DGDEPC,DGPAY,DGDEC
28 N DGHARD
29 S DGMTDT=3000705 ;Patch DG*5.3*291 release date
30 I $D(XPDNM) S DGMTDT=+$$PARCP^XPDUTL("DGMTDT")
31 S:(DGMTDT<3000705) DGMTDT=3000705
32 F S DGMTDT=$O(^DGMT(408.31,"B",DGMTDT)) Q:'DGMTDT D
33 .S DGIEN31=0
34 .F S DGIEN31=$O(^DGMT(408.31,"B",DGMTDT,DGIEN31)) Q:'DGIEN31 D
35 . .S DGNOD31=$G(^DGMT(408.31,DGIEN31,0))
36 . .S DGIEN2=$P(DGNOD31,"^",2) Q:'DGIEN2
37 . .S DGSTA=$P(DGNOD31,"^",3) ;Means Test Status
38 . .S DGMTYPT=$P(DGNOD31,"^",19) ;Type of Test: 1=Means Test 2=Copay Test
39 . .S DGTOTD=$P(DGNOD31,"^",18) ;Total Dependents
40 . .S DGPAY=$P(DGNOD31,"^",11) ;Agreed To Pay Deductible
41 . .S DGDEC=$P(DGNOD31,"^",14) ;Declines To Give Income Info.
42 . .S DGHARD=$P(DGNOD31,"^",20) ;Hardship?
43 . .D GETREL^DGMTU11(DGIEN2,"VSC",DGMTDT,DGIEN31) ; Recalculate Total Dependents minus spouse
44 . .S DGDEPC=DGDEP
45 . .S:$G(DGREL("S")) DGDEPC=DGDEPC+1 ; Include the spouse as DGMTU11 only returns children
46 . .I (DGTOTD!DGDEPC)&(DGTOTD'=DGDEPC) D UPDATE
47 . .I $D(XPDNM) S %=$$UPCP^XPDUTL("DGMTDT",DGMTDT) ; Update Checkpoint
48 Q
49UPDATE ;Update .18 field of ANNUAL MEANS TEST file
50 N DATA,DGENDA,ERROR,DFN,DGMTI,DGVIRI,DGVINI,DGMTACT,DGMTI,DGMTINF,DGREL,DGPRIEN,DGUPSW
51 S DFN=DGIEN2,DGMTI=DGIEN31,(DGVIRI,DGREL,DGUPSW)=""
52 F S:(DGREL'=1) DGVIRI=$O(^DGMT(408.22,"B",DFN,DGVIRI),-1) Q:DGREL=1!('DGVIRI) D
53 .S DGVINI=$P($G(^DGMT(408.22,DGVIRI,0)),U,2)
54 .Q:'DGVINI
55 .S DGPRIEN=$P($G(^DGMT(408.21,DGVINI,0)),U,2) ; Pointer to PATIENT RELATION file (#408.12)
56 .Q:'DGPRIEN
57 .S DGREL=$P($G(^DGPR(408.12,DGPRIEN,0)),U,2) ;Pointer to RELATIONSHIP file (#408.11)
58 .I DGREL=1 S DATA(.13)=DGDEP,DGENDA=DGVIRI,ERROR="" D
59 .. I $$UPD^DGENDBS(408.22,.DGENDA,.DATA,.ERROR) Q
60 Q:DGREL'=1 ; Quit if relationship is not 'SELF'
61 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'.
62 K DATA
63 S DATA(.18)=DGDEPC ; Newly derived Total # of dependents
64 ; In the following 2 lines, only want to update Status and associated
65 ; fields if current status is 'Cat A', and 'Hardship' flag is not 'YES'.
66 ; For copay test, only update status and associated fields if current
67 ; status is 'Exempt' and 'Hardship' flag is not 'YES'.
68 I (DGSTA=4),'DGHARD S DGUPSW=1
69 I DGMTYPT=2&(DGSTA=7),'DGHARD S DGUPSW=1
70 I DGUPSW D
71 .S DATA(.03)=DGMTS ; Newly derived Status
72 .S DATA(.12)=DGTHA ; Newly derived Threshold A field
73 .S DATA(2.03)=DGMTS ; Newly derived Test Determined Status
74 I (DGSTA'=4)&(DGSTA'=7) S DGMTS=DGSTA ; need DGMTS for build of ^XTMP
75 S DGENDA=DGIEN31,ERROR=""
76 S DGMTACT="EDT",DGMTI=DGENDA,DGMTINF=1 ; Needed for call to DGMTEVT
77 D PRIOR^DGMTEVT
78 I $$UPD^DGENDBS(408.31,.DGENDA,.DATA,.ERROR) D
79 .D AFTER^DGMTEVT
80 .D EN^DGMTEVT ; Call to Means Test Event Driver
81 .S DGRECNT=DGRECNT+1
82 .D BUILDLN
83 .D ATRXREF
84 Q
85 ;
86BUILDLN ; Build storage array with data
87 ;
88 ;Output:
89 ; ^XTMP("DG311PIR",pt name,pt ssn,income year,old status,new status)=""
90 ;
91 N DGNAME,DGSSN,DGINY
92 ;
93 ; - pt name and ssn from Patient (#2) file
94 S DGNAME=$P($G(^DPT(DFN,0)),"^"),DGSSN=$P($G(^(.36)),"^",3)
95 S:DGNAME="" DGNAME=DFN
96 S:DGSSN="" DGSSN="MISSING"
97 S Y=DGMTDT
98 D DD^%DT
99 S DGINY=$P(Y," ",3)
100 ;
101 S ^XTMP("DG311PIR",DGNAME,DGSSN,DGINY,DGSTA,DGMTS)=""
102 Q
103 ;
104ATRXREF ; Add entry into the 'ATR' cross reference of the IVM PATIENT (#301.5)
105 ; file so that demographic and income information will be transmitted
106 ; to the IVM Center.
107 ;
108 N IVIEN,IVNOD,IVIY,IVLAST,IVSF,IVTS
109 S IVIEN="",IVLAST=0,IVLIEN=""
110 F S IVIEN=$O(^IVM(301.5,"B",DGIEN2,IVIEN)) Q:'IVIEN D
111 . S IVNOD=^IVM(301.5,IVIEN,0)
112 . S IVIY=$P(IVNOD,U,2)
113 . S:(IVIY>IVLAST) IVLAST=IVIY,IVLIEN=IVIEN
114 I (IVLIEN'="") D
115 . S ^IVM(301.5,"ATR",0,IVLIEN)=""
116 . S IVTS=$P(IVNOD,U,3) ; Transmission Status Flag
117 . S IVSF=$P(IVNOD,U,4) ; Stop Flag
118 . I IVTS!IVSF D
119 .. K DATA
120 .. S DATA(.03)=0,DATA(.04)=0,ERROR=""
121 .. I $$UPD^DGENDBS(301.5,.IVLIEN,.DATA,.ERROR) Q
122 Q
Note: See TracBrowser for help on using the repository browser.