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