DGMTU21 ;ALB/RMO - Income Utilities Cont. ;6 MAR 1992 8:40 am
;;5.3;Registration;**33,45,182,688**;Aug 13, 1993;Build 29
;
ALL(DFN,DGTYPE,DGDT,DGRTY,DGMT) ;Select patient relation, individual annual
; income and income relation arrays of internal
; entry numbers
; Input -- DFN Patient file IEN
; DGTYPE Type of Relation which can
; contain:
; V for veteran
; S for spouse
; C for dependent children
; or
; D for all dependents
; DGDT Date/Time
; DGRTY Type of Array to Return
; which can contain:
; I for Ind Annual Income
; P for Patient Relation
; R for Income Relation
; (Optional - default IPR)
; DGMT IFN of Means Test (optional)
; Output -- DGREL Patient Relation IEN Array
; DGINC Individual Annual Income IEN Array
; DGINR Income Relation IEN Array
; DGDEP Number of Dependents
K DGINC,DGINR,DGREL
N DGCNT,DGLY,DGPRTY
S:'$D(DGRTY) DGRTY="IPR" S DGLY=$$LYR^DGMTSCU1(DGDT)
D GETREL^DGMTU11(DFN,DGTYPE,DGLY,$G(DGMT))
S DGPRTY="" F S DGPRTY=$O(DGREL(DGPRTY)) Q:DGPRTY="" D SET
I DGRTY'["P" K DGREL
ALLQ Q
;
SET ;Set individual annual income and income relation arrays
N DGCNT,DGPRI,DGINI,DGIRI
I "CD"[DGPRTY S DGCNT=0 F S DGCNT=$O(DGREL(DGPRTY,DGCNT)) Q:'DGCNT D
.S DGPRI=+DGREL(DGPRTY,DGCNT) D GET
.I DGINI,DGRTY["I" S DGINC(DGPRTY,DGCNT)=DGINI
.I DGIRI,DGRTY["R" S DGINR(DGPRTY,DGCNT)=DGIRI
I "SV"[DGPRTY D
.S DGPRI=+DGREL(DGPRTY) D GET
.I DGINI,DGRTY["I" S DGINC(DGPRTY)=DGINI
.I DGIRI,DGRTY["R" S DGINR(DGPRTY)=DGIRI
Q
;
GET ;Look-up individual annual income and income relation IEN
S DGINI=+$$IAI^DGMTU3(DGPRI,DGLY,$S($G(DGMT):$P($G(^DGMT(408.31,DGMT,0)),"^",19),1:1))
S DGIRI=+$O(^DGMT(408.22,"AIND",DGINI,0))
Q
;
; GTS - DG*5.3*688
UPDTTSTS(DFN,IY) ;Update all tests for IY of converted IAI rec's
; INPUT: DFN - Patient file IEN
; IY - Income Year FM format (ex: 306 for 2006)
;
; OUTPUT: RESULT
; 1 - Converted records
; 0 - Did not convert records
;
N RESULT,TYPE,TESTDT,IRIEN,DGMT2
S RESULT=0
F TYPE=1,2,4 DO
. S TESTDT=""
. S IRIEN=""
. I $D(^DGMT(408.31,"AID",TYPE)) DO
. . F Q:('$D(^DGMT(408.31,"AID",TYPE,DFN))) S TESTDT=$O(^DGMT(408.31,"AID",TYPE,DFN,TESTDT)) Q:(+TESTDT=0) DO
. . . I $E(TESTDT,2,4)=IY DO
. . . . S IRIEN=$O(^DGMT(408.31,"AID",TYPE,DFN,TESTDT,""))
. . . . ; Update 2.11 in 408.31 rec
. . . . S DGMT2(408.31,+IRIEN_",",2.11)=1
. . . . S DGERR=""
. . . . D FILE^DIE("","DGMT2",DGERR)
. . . . S RESULT=1
Q RESULT
;
; GTS - DG*5.3*688
LSTNP(DFN,DGDT,DGMTYPT) ;Last MT/CP/LTC4 test for a patient regardless of Primary status
; Input -- DFN Patient IEN
; DGDT Date/Time (Optional- default today@2359)
; DGMTYPT Type of Test (Optional - if not defined
; Means Test will be assumed)
; Output -- Annual Means Test IEN^Date of Test
; ^Status Name^Status Code^Source of Test
N DGIDT,DGMTFL1,DGMTI,DGNOD,Y I '$D(DGMTYPT) S DGMTYPT=1
S DGIDT=$S($G(DGDT)>0:-DGDT,1:-DT) S:'$P(DGIDT,".",2) DGIDT=DGIDT_.2359
F S DGIDT=+$O(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT)) Q:'DGIDT!$G(DGMTFL1) D
.F DGMTI=0:0 S DGMTI=+$O(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT,DGMTI)) Q:'DGMTI!$G(DGMTFL1) D
..S DGNOD=$G(^DGMT(408.31,DGMTI,0)) I DGNOD!(DGMTYPT=4) S DGMTFL1=1,Y=DGMTI_"^"_$P(^(0),"^")_"^"_$$MTS^DGMTU(DFN,+$P(^(0),"^",3))_"^"_$P(DGNOD,"^",23)
Q $G(Y)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTU21 4302 printed Dec 13, 2024@02:45:35 Page 2
DGMTU21 ;ALB/RMO - Income Utilities Cont. ;6 MAR 1992 8:40 am
+1 ;;5.3;Registration;**33,45,182,688**;Aug 13, 1993;Build 29
+2 ;
ALL(DFN,DGTYPE,DGDT,DGRTY,DGMT) ;Select patient relation, individual annual
+1 ; income and income relation arrays of internal
+2 ; entry numbers
+3 ; Input -- DFN Patient file IEN
+4 ; DGTYPE Type of Relation which can
+5 ; contain:
+6 ; V for veteran
+7 ; S for spouse
+8 ; C for dependent children
+9 ; or
+10 ; D for all dependents
+11 ; DGDT Date/Time
+12 ; DGRTY Type of Array to Return
+13 ; which can contain:
+14 ; I for Ind Annual Income
+15 ; P for Patient Relation
+16 ; R for Income Relation
+17 ; (Optional - default IPR)
+18 ; DGMT IFN of Means Test (optional)
+19 ; Output -- DGREL Patient Relation IEN Array
+20 ; DGINC Individual Annual Income IEN Array
+21 ; DGINR Income Relation IEN Array
+22 ; DGDEP Number of Dependents
+23 KILL DGINC,DGINR,DGREL
+24 NEW DGCNT,DGLY,DGPRTY
+25 if '$DATA(DGRTY)
SET DGRTY="IPR"
SET DGLY=$$LYR^DGMTSCU1(DGDT)
+26 DO GETREL^DGMTU11(DFN,DGTYPE,DGLY,$GET(DGMT))
+27 SET DGPRTY=""
FOR
SET DGPRTY=$ORDER(DGREL(DGPRTY))
if DGPRTY=""
QUIT
DO SET
+28 IF DGRTY'["P"
KILL DGREL
ALLQ QUIT
+1 ;
SET ;Set individual annual income and income relation arrays
+1 NEW DGCNT,DGPRI,DGINI,DGIRI
+2 IF "CD"[DGPRTY
SET DGCNT=0
FOR
SET DGCNT=$ORDER(DGREL(DGPRTY,DGCNT))
if 'DGCNT
QUIT
Begin DoDot:1
+3 SET DGPRI=+DGREL(DGPRTY,DGCNT)
DO GET
+4 IF DGINI
IF DGRTY["I"
SET DGINC(DGPRTY,DGCNT)=DGINI
+5 IF DGIRI
IF DGRTY["R"
SET DGINR(DGPRTY,DGCNT)=DGIRI
End DoDot:1
+6 IF "SV"[DGPRTY
Begin DoDot:1
+7 SET DGPRI=+DGREL(DGPRTY)
DO GET
+8 IF DGINI
IF DGRTY["I"
SET DGINC(DGPRTY)=DGINI
+9 IF DGIRI
IF DGRTY["R"
SET DGINR(DGPRTY)=DGIRI
End DoDot:1
+10 QUIT
+11 ;
GET ;Look-up individual annual income and income relation IEN
+1 SET DGINI=+$$IAI^DGMTU3(DGPRI,DGLY,$SELECT($GET(DGMT):$PIECE($GET(^DGMT(408.31,DGMT,0)),"^",19),1:1))
+2 SET DGIRI=+$ORDER(^DGMT(408.22,"AIND",DGINI,0))
+3 QUIT
+4 ;
+5 ; GTS - DG*5.3*688
UPDTTSTS(DFN,IY) ;Update all tests for IY of converted IAI rec's
+1 ; INPUT: DFN - Patient file IEN
+2 ; IY - Income Year FM format (ex: 306 for 2006)
+3 ;
+4 ; OUTPUT: RESULT
+5 ; 1 - Converted records
+6 ; 0 - Did not convert records
+7 ;
+8 NEW RESULT,TYPE,TESTDT,IRIEN,DGMT2
+9 SET RESULT=0
+10 FOR TYPE=1,2,4
Begin DoDot:1
+11 SET TESTDT=""
+12 SET IRIEN=""
+13 IF $DATA(^DGMT(408.31,"AID",TYPE))
Begin DoDot:2
+14 FOR
if ('$DATA(^DGMT(408.31,"AID",TYPE,DFN)))
QUIT
SET TESTDT=$ORDER(^DGMT(408.31,"AID",TYPE,DFN,TESTDT))
if (+TESTDT=0)
QUIT
Begin DoDot:3
+15 IF $EXTRACT(TESTDT,2,4)=IY
Begin DoDot:4
+16 SET IRIEN=$ORDER(^DGMT(408.31,"AID",TYPE,DFN,TESTDT,""))
+17 ; Update 2.11 in 408.31 rec
+18 SET DGMT2(408.31,+IRIEN_",",2.11)=1
+19 SET DGERR=""
+20 DO FILE^DIE("","DGMT2",DGERR)
+21 SET RESULT=1
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+22 QUIT RESULT
+23 ;
+24 ; GTS - DG*5.3*688
LSTNP(DFN,DGDT,DGMTYPT) ;Last MT/CP/LTC4 test for a patient regardless of Primary status
+1 ; Input -- DFN Patient IEN
+2 ; DGDT Date/Time (Optional- default today@2359)
+3 ; DGMTYPT Type of Test (Optional - if not defined
+4 ; Means Test will be assumed)
+5 ; Output -- Annual Means Test IEN^Date of Test
+6 ; ^Status Name^Status Code^Source of Test
+7 NEW DGIDT,DGMTFL1,DGMTI,DGNOD,Y
IF '$DATA(DGMTYPT)
SET DGMTYPT=1
+8 SET DGIDT=$SELECT($GET(DGDT)>0:-DGDT,1:-DT)
if '$PIECE(DGIDT,".",2)
SET DGIDT=DGIDT_.2359
+9 FOR
SET DGIDT=+$ORDER(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT))
if 'DGIDT!$GET(DGMTFL1)
QUIT
Begin DoDot:1
+10 FOR DGMTI=0:0
SET DGMTI=+$ORDER(^DGMT(408.31,"AID",DGMTYPT,DFN,DGIDT,DGMTI))
if 'DGMTI!$GET(DGMTFL1)
QUIT
Begin DoDot:2
+11 SET DGNOD=$GET(^DGMT(408.31,DGMTI,0))
IF DGNOD!(DGMTYPT=4)
SET DGMTFL1=1
SET Y=DGMTI_"^"_$PIECE(^(0),"^")_"^"_$$MTS^DGMTU(DFN,+$PIECE(^(0),"^",3))_"^"_$PIECE(DGNOD,"^",23)
End DoDot:2
End DoDot:1
+12 QUIT $GET(Y)
