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

DGRP9.m

Go to the documentation of this file.
  1. DGRP9 ;ALB/RMO/MIR - Screen 9 - Income Screening Data ;23 JAN 1992 11:00 am
  1. ;;5.3;PIMS;**45,108,487,1015,1016**;JUN 30, 2012;Build 20
  1. ;
  1. EN ;
  1. ; DVBGUI : CAPRI GUI User
  1. I $D(DVBGUI) U IO ;If called from CAPRI menu set output device.
  1. K DGDEP,DGINC,DGREL
  1. N DGMT,DGEFDT,DGMTED,DGNOBUCK,DGLSTYR,DGMTV
  1. S DGLSTYR=$E(DT,1,3)+1699
  1. S DGRPS=9 D H^DGRPU
  1. D:'DGRPV NEW^DGRPEIS1
  1. D ALL^DGMTU21(DFN,"VSD",DT,"IPR")
  1. S DGNOBUCK=$S(DGRPV:0,1:$$NOBUCKS^DGMTU22(DFN,DT))
  1. S DGMT=$$LST^DGMTU(DFN,DT),DGEFDT=$P(DGMT,U,2)
  1. ;
  1. ; If Date of Test returned is not more than a year old, or the MT does not have one of the following statuses:
  1. ; MT COPAY EXEMPT (MT) A
  1. ; MT COPAY REQUIRED (MT) C
  1. ; EXEMPT (CP) E
  1. ; NON-EXEMPT (CP) M
  1. ; PENDING ADJUDICATION (CP) P
  1. ; or DGNOBUCK=0 (Prior or Current years IAI data does not exist and no dpdnts or spouse exists)
  1. ; SET date of test for 408.31 records (DGEFDT) to today (create new records)
  1. S:'((DGEFDT+10000)>DT&("^A^C^P^E^M^"[(U_$P(DGMT,U,4)))&DGNOBUCK) DGEFDT=DT
  1. S DGISYR=$E($$LYR^DGMTSCU1(DGEFDT),1,3)+1700 ; IS year (Year previous to DGEFDT)
  1. D:DT'=DGEFDT ALL^DGMTU21(DFN,"VSD",DGEFDT,"IPR") ; Get IAI records if DGEFDT is <DT
  1. ;
  1. ; GTS - DG*5.3*688 MT Version
  1. ; If creating new IAI records for new year (execution transfers when 'E' is entered in EN^DGRPP)
  1. S:(+$G(DGIAINEW)=1) DGMTV=1
  1. ; If identifying IAI records for display to user for first time in L/E execution
  1. I +$G(DGIAINEW)=0 DO
  1. . ; If MT 408.31 record exists and is for current year, get form of test; if it doesn't exist,
  1. . ; default form to version 1
  1. . I ($P(DGMT,"^",1)]""),($E($P(DGMT,"^",2),1,3)=$E(DT,1,3)) S DGMTV=+$P($G(^DGMT(408.31,+DGMT,2)),"^",11) ; existing MT version
  1. . I ($P(DGMT,"^",1)']"")!(($P(DGMT,"^",1)]"")&($E($P(DGMT,"^",2),1,3)'=$E(DT,1,3))) DO
  1. . . S DGMTV=1 ; Default IS records without MT to version 1 format
  1. . . ; If Test Date is not current year
  1. . . I ($P(DGMT,"^",1)]""),($E($P(DGMT,"^",2),1,3)'=$E(DT,1,3)) DO
  1. . . . ; If test date is less than 1 yr old or test is an active status get the means test version of the test
  1. . . . ; and prior yrs IAI recs exist
  1. . . . I ((DGEFDT+10000)>DT&("^A^C^P^E^M^"[(U_$P(DGMT,U,4)))&DGNOBUCK) S DGMTV=+$P($G(^DGMT(408.31,+DGMT,2)),"^",11)
  1. . . . ; If test date is more than 1 yr old OR test is NOT an active status or there are no prior yrs IAI recs
  1. . . . I '((DGEFDT+10000)>DT&("^A^C^P^E^M^"[(U_$P(DGMT,U,4)))&DGNOBUCK) DO
  1. . . . .I $D(DGINC),($$VER^DGMTUTL3(.DGINC)=0) DO IAICK(DFN,.DGINC)
  1. . . ;
  1. . . ; If 408.21 rec's and records are pre Feb '05 format, then convert IS (0) node to version 1
  1. . . ; If no IS nodes exist or are version 1, do not convert 0 node. (Entry will be version 1)
  1. . . I $P(DGMT,"^",1)']"",$D(DGINC),($$VER^DGMTUTL3(.DGINC)=0) DO IAICK(DFN,.DGINC)
  1. ;
  1. ; Default DGMTV=1 when entering a new test and IAI records from prior year are not available
  1. I +DGMT'>0 I '((DGEFDT+10000)>DT&("^A^C^P^E^M^"[(U_$P(DGMT,U,4)))) S DGMTV=1
  1. ;
  1. S DGSP=$D(DGREL("S")) ; DGSP = flag ... + if spouse, 0 if not
  1. D TOT(.DGINC) ;Totals income into DGTOT(x) node (x=V, S, or D)
  1. D:(+DGMTV=0) DIS ;Display and keep old version 0 MT in 0 form after saving
  1. D:(+DGMTV=1) DIS1 ;Display and store MT in version 1 format
  1. K DGTOT,DGIAINEW
  1. G ^DGRPP
  1. ;
  1. DIS ;Display income
  1. D MTCHK
  1. N DGBL,SCV0
  1. S SCV0=""
  1. W !!?34,"Veteran" W:DGSP ?46,"Spouse" W:DGDEP ?56,"Dependents" W ?73,"Total"
  1. W !?31,"-----------------------------------------------"
  1. S DGGTOT=0,DGRPW=1 ;initialize grand total variable
  1. S Z=1 D WW^DGRPV D FLD(.DGTOT,8,"Social Security (Not SSI)")
  1. S Z=2 D WW^DGRPV D FLD(.DGTOT,9,"U.S. Civil Service")
  1. S Z=3 D WW^DGRPV D FLD(.DGTOT,10,"U.S. Railroad Retirement")
  1. S Z=4 D WW^DGRPV D FLD(.DGTOT,11,"Military Retirement")
  1. S Z=5 D WW^DGRPV D FLD(.DGTOT,12,"Unemployment Compensation")
  1. S Z=6 D WW^DGRPV D FLD(.DGTOT,13,"Other Retirement")
  1. S Z=7 D WW^DGRPV D FLD(.DGTOT,14,"Total Employment Income")
  1. S Z=8 D WW^DGRPV D FLD(.DGTOT,15,"Interest,Dividend,Annuity")
  1. S Z=9 D WW^DGRPV D FLD(.DGTOT,16,"Workers Comp or Black Lung")
  1. S Z=10 D WW^DGRPV D FLD(.DGTOT,17,"All Other Income")
  1. W !,DGBL,DGBL," Total 1-10 -->"," ",$J($$AMT^DGMTSCU1(DGGTOT),12)
  1. ;
  1. ;** Patch DG*5.3*108; estimated household income follows
  1. W !!,DGISYR_" Estimated ""Household"" Taxable Income: "_$S($P(DGTOT("V"),U,21)'="":$$AMT^DGMTSCU1($P(DGTOT("V"),U,21)),1:"")
  1. Q
  1. ;
  1. DIS1 ;Display income in version 1 form for screen 9 in Load/Edit.
  1. D MTCHK
  1. N DGBL,SCV0
  1. W !!?34,"Veteran" W:DGSP ?46,"Spouse" W:DGDEP ?56,"Dependents" W ?73,"Total"
  1. W !?31,"-----------------------------------------------"
  1. S DGGTOT=0,DGRPW=1 ;initialize grand total variable
  1. S Z=1 D WW^DGRPV W " Total Employment Income",!
  1. D FLD(.DGTOT,14," (Wages, Bonuses, Tips):")
  1. S Z=2 D WW^DGRPV W " Net Income from Farm,",!
  1. D FLD(.DGTOT,17," Ranch, Property, Bus.:")
  1. S Z=3 D WW^DGRPV W " Other Income Amounts",!
  1. W " (Soc. Sec., Compensation,",!
  1. S SCV0=""
  1. D FLD(.DGTOT,8," Pension, Interest, Div.): ")
  1. K SCV0
  1. W !,DGBL,DGBL," Total 1-3 --> "," ",$J($$AMT^DGMTSCU1(DGGTOT),11)
  1. ;
  1. ;** Estimated household income follows
  1. W !!,DGISYR_" Estimated ""Household"" Taxable Income: "_$S($P(DGTOT("V"),U,21)'="":$$AMT^DGMTSCU1($P(DGTOT("V"),U,21)),1:"")
  1. Q
  1. ;
  1. FLD(DGIN,DGPCE,DGTXT) ;Display inc. fields
  1. ; Input:
  1. ; DGIN 0 node of #408.21 for vet,spouse, and deps
  1. ; DGRPCE as piece
  1. ; DGTXT as income desc.
  1. ; DGGTOT - If defined keeps running total
  1. N DGTOT,I
  1. I '$D(DGBL) S $P(DGBL," ",26)=""
  1. W:Z'["10" " "
  1. W " ",DGTXT,$P(DGBL," ",$L(DGTXT),28)
  1. W:('$D(SCV0)) $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),13)
  1. W:($D(SCV0)) $J($$AMT^DGMTSCU1($P(DGIN("V"),"^",DGPCE)),10)
  1. W " ",$S($D(DGIN("S")):$J($$AMT^DGMTSCU1($P(DGIN("S"),"^",DGPCE)),10),1:$E(DGBL,1,10))
  1. W " ",$S($D(DGIN("D")):$J($$AMT^DGMTSCU1($P(DGIN("D"),"^",DGPCE)),11),1:$E(DGBL,1,11))
  1. S DGTOT="",I="" F S I=$O(DGIN(I)) Q:I="" I $P(DGIN(I),"^",DGPCE)]"" S DGTOT=DGTOT+$P(DGIN(I),"^",DGPCE)
  1. W " ",$J($$AMT^DGMTSCU1(DGTOT),12)
  1. I $D(DGGTOT) S DGGTOT=DGGTOT+DGTOT
  1. Q
  1. ;
  1. TOT(DGINC,DGDOEXP) ; Totals income
  1. ; Input
  1. ; DGINC(x,ct) where X is V, S, or D and CT(counter)(per ALL^DGMTU21)
  1. ; DGDOEXP: IF =1 TOTAL EXPENSE
  1. ;
  1. ;Output
  1. ; DGTOT(x) where x is V, S, or D and DGTOT(x) = 0 node of #408.21
  1. ; (totaled if x is D...total of all deps)
  1. ;
  1. N DGCT,NODE,PIECE
  1. S DGDOEXP=$G(DGDOEXP)
  1. S DGTOT("V")=""
  1. F DGTYPE="V","S","D" I $D(DGREL(DGTYPE)) S DGTOT(DGTYPE)="" D
  1. . S:DGDOEXP&("VS"[DGTYPE) DGEXP(DGTYPE)=$$GET1ND(+$G(DGINC(DGTYPE)))
  1. . I "VS"[DGTYPE S DGTOT(DGTYPE)=$$GET0ND(+$G(DGINC(DGTYPE))) Q
  1. . F DGCT=0:0 S DGCT=$O(DGINC(DGTYPE,DGCT)) Q:'DGCT D
  1. . . S:DGDOEXP DGEXP(DGTYPE)=$$GET1ND(+$G(DGINC(DGTYPE,DGCT)))
  1. . . S NODE=$$GET0ND(+DGINC(DGTYPE,DGCT))
  1. . . F PIECE=8:1:17 I $P(NODE,"^",PIECE)]"" S $P(DGTOT("D"),"^",PIECE)=$P(DGTOT("D"),"^",PIECE)+$P(NODE,"^",PIECE)
  1. Q
  1. ;
  1. GET0ND(IEN) ; Returns the 0 node of File #408.21
  1. Q $G(^DGMT(408.21,IEN,0))
  1. ;
  1. GET1ND(IEN) ; Returns the 1 node of file #408.21
  1. Q $G(^DGMT(408.21,IEN,1))
  1. ;
  1. MTCHK ; Checks if MT/CP is complete for prior calendar year
  1. ; Input:
  1. ; DFN
  1. ; DGINR array of income relation for deps
  1. ; DGISYR as income screening year
  1. ;Output:
  1. ; DGMTC as MT complete flag (1= yes,2=Non-Mt'd deps exist, 0 o/w)
  1. ; DGMTC("S")= Mt complete, but spouse not MTed
  1. ; DGMTC("D")= Mt complete, but at least one dep not MT'D
  1. ; $D(DGMTED(X,X) if can't edit MT data
  1. ;
  1. N DGFL,DGHD,DGMTYPT,DGMTCP,I,X
  1. S (DGFL,DGMTC)=0 ;initialize flag to 0
  1. S DGHD="Income data for "_DGISYR_". "
  1. I '$D(DGMTV) N DGMTV S DGMTV=1
  1. S:DGMTV=0 DGRPVV(9)="0000000000"
  1. S:DGMTV=1 DGRPVV(9)="000"
  1. I $P($G(^DGMT(408.21,+$G(DGINC("V")),0)),U,18) S DGHD=DGHD_" [Data Copied - Not Updated]"
  1. I '$$MTCOMP^DGRPU(DFN,DGEFDT) W !?(40-($L(DGHD)/2)),DGHD Q ; CP/MT not complete
  1. S DGMTCP=$S(DGMTYPT=1:"Means",1:"Copay")
  1. S:DGMTV=0 DGRPVV(9)="1111111111"
  1. S:DGMTV=1 DGRPVV(9)="111"
  1. S DGMTC=1,DGMTED("V")=1 S DGHD=DGHD_DGMTCP_" Test is complete for that calendar year!"
  1. W !?(40-($L(DGHD)/2)),DGHD
  1. G:DGEFDT'=DT MTCKQT ;NO EDITING AT ALL FOR LAST YEAR
  1. I $D(DGREL("S")) S DGFL=1 I +$G(^DGMT(408.22,+$G(DGINR("S")),"MT")) S DGMTED("S")=1,DGFL=0
  1. I DGFL S DGMTC("S")=1 S DGFL=0
  1. F I=0:0 S I=$O(DGREL("D",I)) Q:'I S X=+$G(^DGMT(408.22,+$G(DGINR("D",I)),"MT")) S:X DGMTED("D",I)=1 I 'X S DGFL=1
  1. I DGFL S DGMTC("D")=1
  1. I $D(DGMTC("S"))!$D(DGMTC("D")) W !,*7," You can only edit these items for dependents who are not "_DGMTCP_" tested!" S DGMTC=2 S:DGMTV=0 DGRPVV(9)="0000000000" S:DGMTV=1 DGRPVV(9)="000" Q
  1. W !,*7,?12,"This data must be edited through the "_DGMTCP_" test module!"
  1. MTCKQT Q
  1. ;
  1. ;; GTS - DG*5.3*688 MT Version
  1. IAICK(DFN,DGINC) ;Check version of IAI recs that don't have assoc. MT and convert version 0 record
  1. N DGTY,OTHRTST
  1. S DGTY=$S((+$G(^DGMT(408.21,+DGINC("V"),0))>0):$E(+$G(^DGMT(408.21,+DGINC("V"),0)),1,3)+1,1:$E(DT,1,3))
  1. ;NOTE: ISCNVRT not executed when - Patient is changed to NSC VET. but PEC remains SC when Copay test exists.
  1. ; Changing PEC to SC will exercise ISCNVRT and convert vr 0 IAI rec's to vr 1
  1. D ISCNVRT^DGMTUTL(.DGINC)
  1. S OTHRTST=$$UPDTTSTS^DGMTU21(DFN,DGTY) ;Update 2.11 on all (1, 2 and 4 type) 408.31 recs for DFN and IY
  1. Q