- DGMTU11 ;ALB/MIR,TDM,GTS - Patient Relation Retrieval Utilities ; 10/30/06
- ;;5.3;Registration;**33,45,182,311,688**;Aug 13, 1993;Build 29
- ;
- ;
- ;=======================================================================
- ; The following utilities will obtain data from the PATIENT RELATION
- ; file
- ;=======================================================================
- ;
- ;
- GETREL(DFN,DGTYPE,DGDT,DGMT) ; Get all active dependents for a patient
- ;
- ; Input -- DFN as the IEN of file 2 (for the patient)
- ; DGTYPE containing the letters V, S, C, or D representing
- ; the type of dependents returned
- ; (C and D should be mutually exclusive)
- ; DGDT [optional] as active date...DT if not defined
- ; if no month/day, checks entire year/month
- ; DGMT [optional] IFN of means test
- ; Output -- DGREL("V") = veteran reference
- ; DGREL("S") = spouse reference
- ; DGREL("C",counter) = child reference (only MT dep)
- ; DGREL("D",counter) = dependent reference (all deps)
- ; reference=IFN of 408.12^dep file ref
- ; DGDEP = number of active dependents
- ;
- N CT,DGX,IFN,IEN,REF,X,DGCD K DGREL
- S (CT,IFN,IEN)=0,DGDT=$S($G(DGDT):DGDT,1:DT)
- D:$G(DGMT) RELINC ;IFN of Means Test is supplied
- D:('$G(DGREL("V"))&(DGTYPE["V"))!('$G(DGMT)) RELFND ;No Means Test IFN or problem setting DGREL(V)
- D GETRELQ ; Increment the dependent count
- Q
- RELINC F S IFN=$O(^DGMT(408.22,"AMT",DGMT,DFN,IFN)) Q:'IFN D
- .S IEN=+$P($G(^DGMT(408.21,IFN,0)),"^",2),DGX=$G(^DGPR(408.12,IEN,0))
- .D SET
- Q
- RELFND S IEN=0 F S IEN=$O(^DGPR(408.12,"B",DFN,IEN)) Q:'IEN S DGX=$G(^DGPR(408.12,IEN,0)) I $$ACTIVE(IEN,DGDT) D SET
- Q
- GETRELQ S DGDEP=CT
- Q
- ;
- ;
- SET ; set variables into array...first subscript is relation type, second
- ; is IEN of file 408.12 (patient relations file)
- ;
- N REF,TYPE
- S X=$P(DGX,"^",2),REF=$P(DGX,"^",3),TYPE=""
- I X=1,(DGTYPE["V") S TYPE="V"
- I X=2,(DGTYPE["S") S TYPE="S"
- I X>2,(X<7) S TYPE=$S(DGTYPE["D":"D",DGTYPE["C":"C",1:"")
- I X>6,(DGTYPE["D") S TYPE="D"
- I 'X!(TYPE']"") Q ; not valid or not chosen
- I "VS"[TYPE,$D(DGREL(TYPE)) Q ; take first self or spouse on file
- S REF=IEN_"^"_REF
- I "VS"[TYPE S DGREL(TYPE)=REF
- I "CD"[TYPE&('$G(DGCD(REF))) S CT=CT+1,DGREL(TYPE,CT)=REF,DGCD(REF)=CT
- Q
- ;
- ;
- ACTIVE(IEN,DGDT) ; Extrinsic function to determine if 408.12 entry is active
- ;
- ; Input -- IEN as internal entry number of pt relation file
- ; DGDT as 'as of' date (uses DT if undefined)
- ; Output -- 1 if active, 0 otherwise
- ;
- N DGFL,DGID,MIEN,DGNOM,DGNOY,ID,Y
- S DGID=$S($G(DGDT):DGDT,1:DT) I '$P(DGID,".",2) S $P(DGID,".",2)=2359
- S (DGFL,Y,DGNOM,DGNOY)=0
- S ID=DGID S:'$E(ID,4,5) ID=$E(ID,1,3)_99_$E(ID,6,99),DGNOM=1 I '$E(ID,6,7) S ID=$E(ID,1,5)_99_$E(ID,8,99),DGNOY=1 ;end of year or end of month if nothing passed
- S ID=-ID,DGID=-DGID
- F S ID=$O(^DGPR(408.12,IEN,"E","AID",ID)) Q:'ID!DGFL!Y S MIEN=$O(^(ID,0)) D
- . S X=$G(^DGPR(408.12,IEN,"E",MIEN,0)) I 'X Q
- . ;I 'DGNOY,'DGNOM S DGFL=1 S:$P(X,"^",2) Y=1 Q
- . I $P(X,"^",2)=1 S Y=1 Q
- . I ID>DGID S DGFL=1 ;quit...already before begin date
- Q $S(Y:1,1:0)
- ;
- ;
- RESET(DFN,DGDT,DGMT) ;
- ; Sets 'NUMBER OF DEPENDENT CHILDREN' (#.13) and
- ; 'DEPENDENT CHILDREN' (#.08) in Income Relation File (#408.22)
- ; based upon the count of active child dependents in Patient
- ; Relation File (#408.12).
- ;
- ; IN: DFN - IEN of Patient File (#2)
- ; DGDT - [optional] as 'as of' date
- ; DGMT - [optional] means test IEN
- ; OUT: SETS (.08) & (.13) fields of (408.22)
- ; No Formal Output
- ;
- N DGNODE,DGDEPYN,DGDEP,DGREL,DGX,PRIEN,SPOUSE
- S (CT,IEN,PRIEN,SPOUSE,DGDEP)=0,DGDT=$S($G(DGDT):DGDT,1:$$LYR^DGMTSCU1(DT))
- D GETREL(DFN,"VSD",DGDT,$G(DGMT)) S PRIEN=+$G(DGREL("V")),SPOUSE=$S($G(DGREL("S")):1,1:0)
- S DGX=$$IAI^DGMTU3(+PRIEN,($E(DGDT,1,3)_"0000"),$S($G(DGMT):$P($G(^DGMT(408.31,DGMT,0)),"^",19),1:1)) ;408.21 IEN
- S DGX=$O(^DGMT(408.22,"AIND",+DGX,0)) ;408.22 IEN
- S DGNODE=$G(^DGMT(408.22,+DGX,0)) I DGNODE']"" Q
- S DGDEPYN=$S(DGDEP:1,1:0)
- I $P(DGNODE,"^",13)'=DGDEP!($P(DGNODE,"^",8)'=DGDEPYN)!($P(DGNODE,"^",5)'=SPOUSE) D
- .S DIE="^DGMT(408.22,",DA=+DGX,DR=".13////^S X=DGDEP"_$S(+$P(DGNODE,"^",8)=DGDEPYN:"",1:";.08////^S X=DGDEPYN")_$S($P(DGNODE,"^",5)=SPOUSE:"",1:";.05////^S X=SPOUSE")
- .D ^DIE
- .K DR,DA,DIE,DIC,Y,X
- Q
- ;
- GETINACD(DFN,DGREL) ; Get all INACTIVE dependents for a patient
- ; Input -- DFN as the IEN of file 2 (for the patient)
- ; DGREL as Array of active spouse/dependents
- ; Output -- DGIREL("S",counter) = spouse reference
- ; DGIREL("C",counter) = child reference
- N IEN,XCTR,TMPDGEL,XITYP,EDT,IFN,NODE
- K DGIREL
- Q:'$D(DGREL)
- S IEN=$P($G(DGREL("S")),U) S:IEN'="" TMPDGREL(IEN)=""
- S XCTR="" F S XCTR=$O(DGREL("C",XCTR)) Q:XCTR="" D
- . S IEN=$P(DGREL("C",XCTR),U) S:IEN'="" TMPDGREL(IEN)=""
- S IEN=0 F S IEN=$O(^DGPR(408.12,"B",DFN,IEN)) Q:IEN="" D
- . Q:($D(TMPDGREL(IEN)))!('$D(^DGPR(408.12,IEN,"E")))
- . S XITYP=$P($G(^DGPR(408.12,IEN,0)),U,2)
- . S XITYP=$S(XITYP=2:"S",((XITYP>2)&(XITYP<7)):"C",1:"") Q:XITYP=""
- . S EDT=$O(^DGPR(408.12,IEN,"E","AID","")) Q:EDT=""
- . S IFN=$O(^DGPR(408.12,IEN,"E","AID",EDT,"")) Q:IFN=""
- . Q:$P($G(^DGPR(408.12,IEN,"E",IFN,0)),U,2) ;Don't want Active
- . S NODE=$G(^DGPR(408.12,IEN,0))
- . S DGIREL(XITYP,$O(DGIREL(XITYP,""),-1)+1)=IEN_U_$P(NODE,U,3)_U_(EDT*-1)
- Q
- ;
- CNTDEPS(DFN) ;Count Dependent children
- ; DG*5.3*688 - EVC changes; GTS
- ; Called by DGDEP4 and DGRPEIS1
- ;
- ;INPUT:
- ; DFN - Patient file IEN for MT Veteran
- ;OUTPUT:
- ; Number of child dependents
- ;
- N IEN,DEPCNT,DGX
- S DEPCNT=0
- S IEN=0
- F S IEN=$O(^DGPR(408.12,"B",DFN,IEN)) Q:'IEN DO
- . S DGX=$G(^DGPR(408.12,IEN,0))
- . I ($P(DGX,U,2)>2),($P(DGX,U,2)<7) S DEPCNT=DEPCNT+1
- Q DEPCNT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTU11 5978 printed Jan 18, 2025@03:46:15 Page 2
- DGMTU11 ;ALB/MIR,TDM,GTS - Patient Relation Retrieval Utilities ; 10/30/06
- +1 ;;5.3;Registration;**33,45,182,311,688**;Aug 13, 1993;Build 29
- +2 ;
- +3 ;
- +4 ;=======================================================================
- +5 ; The following utilities will obtain data from the PATIENT RELATION
- +6 ; file
- +7 ;=======================================================================
- +8 ;
- +9 ;
- GETREL(DFN,DGTYPE,DGDT,DGMT) ; Get all active dependents for a patient
- +1 ;
- +2 ; Input -- DFN as the IEN of file 2 (for the patient)
- +3 ; DGTYPE containing the letters V, S, C, or D representing
- +4 ; the type of dependents returned
- +5 ; (C and D should be mutually exclusive)
- +6 ; DGDT [optional] as active date...DT if not defined
- +7 ; if no month/day, checks entire year/month
- +8 ; DGMT [optional] IFN of means test
- +9 ; Output -- DGREL("V") = veteran reference
- +10 ; DGREL("S") = spouse reference
- +11 ; DGREL("C",counter) = child reference (only MT dep)
- +12 ; DGREL("D",counter) = dependent reference (all deps)
- +13 ; reference=IFN of 408.12^dep file ref
- +14 ; DGDEP = number of active dependents
- +15 ;
- +16 NEW CT,DGX,IFN,IEN,REF,X,DGCD
- KILL DGREL
- +17 SET (CT,IFN,IEN)=0
- SET DGDT=$SELECT($GET(DGDT):DGDT,1:DT)
- +18 ;IFN of Means Test is supplied
- if $GET(DGMT)
- DO RELINC
- +19 ;No Means Test IFN or problem setting DGREL(V)
- if ('$GET(DGREL("V"))&(DGTYPE["V"))!('$GET(DGMT))
- DO RELFND
- +20 ; Increment the dependent count
- DO GETRELQ
- +21 QUIT
- RELINC FOR
- SET IFN=$ORDER(^DGMT(408.22,"AMT",DGMT,DFN,IFN))
- if 'IFN
- QUIT
- Begin DoDot:1
- +1 SET IEN=+$PIECE($GET(^DGMT(408.21,IFN,0)),"^",2)
- SET DGX=$GET(^DGPR(408.12,IEN,0))
- +2 DO SET
- End DoDot:1
- +3 QUIT
- RELFND SET IEN=0
- FOR
- SET IEN=$ORDER(^DGPR(408.12,"B",DFN,IEN))
- if 'IEN
- QUIT
- SET DGX=$GET(^DGPR(408.12,IEN,0))
- IF $$ACTIVE(IEN,DGDT)
- DO SET
- +1 QUIT
- GETRELQ SET DGDEP=CT
- +1 QUIT
- +2 ;
- +3 ;
- SET ; set variables into array...first subscript is relation type, second
- +1 ; is IEN of file 408.12 (patient relations file)
- +2 ;
- +3 NEW REF,TYPE
- +4 SET X=$PIECE(DGX,"^",2)
- SET REF=$PIECE(DGX,"^",3)
- SET TYPE=""
- +5 IF X=1
- IF (DGTYPE["V")
- SET TYPE="V"
- +6 IF X=2
- IF (DGTYPE["S")
- SET TYPE="S"
- +7 IF X>2
- IF (X<7)
- SET TYPE=$SELECT(DGTYPE["D":"D",DGTYPE["C":"C",1:"")
- +8 IF X>6
- IF (DGTYPE["D")
- SET TYPE="D"
- +9 ; not valid or not chosen
- IF 'X!(TYPE']"")
- QUIT
- +10 ; take first self or spouse on file
- IF "VS"[TYPE
- IF $DATA(DGREL(TYPE))
- QUIT
- +11 SET REF=IEN_"^"_REF
- +12 IF "VS"[TYPE
- SET DGREL(TYPE)=REF
- +13 IF "CD"[TYPE&('$GET(DGCD(REF)))
- SET CT=CT+1
- SET DGREL(TYPE,CT)=REF
- SET DGCD(REF)=CT
- +14 QUIT
- +15 ;
- +16 ;
- ACTIVE(IEN,DGDT) ; Extrinsic function to determine if 408.12 entry is active
- +1 ;
- +2 ; Input -- IEN as internal entry number of pt relation file
- +3 ; DGDT as 'as of' date (uses DT if undefined)
- +4 ; Output -- 1 if active, 0 otherwise
- +5 ;
- +6 NEW DGFL,DGID,MIEN,DGNOM,DGNOY,ID,Y
- +7 SET DGID=$SELECT($GET(DGDT):DGDT,1:DT)
- IF '$PIECE(DGID,".",2)
- SET $PIECE(DGID,".",2)=2359
- +8 SET (DGFL,Y,DGNOM,DGNOY)=0
- +9 ;end of year or end of month if nothing passed
- SET ID=DGID
- if '$EXTRACT(ID,4,5)
- SET ID=$EXTRACT(ID,1,3)_99_$EXTRACT(ID,6,99)
- SET DGNOM=1
- IF '$EXTRACT(ID,6,7)
- SET ID=$EXTRACT(ID,1,5)_99_$EXTRACT(ID,8,99)
- SET DGNOY=1
- +10 SET ID=-ID
- SET DGID=-DGID
- +11 FOR
- SET ID=$ORDER(^DGPR(408.12,IEN,"E","AID",ID))
- if 'ID!DGFL!Y
- QUIT
- SET MIEN=$ORDER(^(ID,0))
- Begin DoDot:1
- +12 SET X=$GET(^DGPR(408.12,IEN,"E",MIEN,0))
- IF 'X
- QUIT
- +13 ;I 'DGNOY,'DGNOM S DGFL=1 S:$P(X,"^",2) Y=1 Q
- +14 IF $PIECE(X,"^",2)=1
- SET Y=1
- QUIT
- +15 ;quit...already before begin date
- IF ID>DGID
- SET DGFL=1
- End DoDot:1
- +16 QUIT $SELECT(Y:1,1:0)
- +17 ;
- +18 ;
- RESET(DFN,DGDT,DGMT) ;
- +1 ; Sets 'NUMBER OF DEPENDENT CHILDREN' (#.13) and
- +2 ; 'DEPENDENT CHILDREN' (#.08) in Income Relation File (#408.22)
- +3 ; based upon the count of active child dependents in Patient
- +4 ; Relation File (#408.12).
- +5 ;
- +6 ; IN: DFN - IEN of Patient File (#2)
- +7 ; DGDT - [optional] as 'as of' date
- +8 ; DGMT - [optional] means test IEN
- +9 ; OUT: SETS (.08) & (.13) fields of (408.22)
- +10 ; No Formal Output
- +11 ;
- +12 NEW DGNODE,DGDEPYN,DGDEP,DGREL,DGX,PRIEN,SPOUSE
- +13 SET (CT,IEN,PRIEN,SPOUSE,DGDEP)=0
- SET DGDT=$SELECT($GET(DGDT):DGDT,1:$$LYR^DGMTSCU1(DT))
- +14 DO GETREL(DFN,"VSD",DGDT,$GET(DGMT))
- SET PRIEN=+$GET(DGREL("V"))
- SET SPOUSE=$SELECT($GET(DGREL("S")):1,1:0)
- +15 ;408.21 IEN
- SET DGX=$$IAI^DGMTU3(+PRIEN,($EXTRACT(DGDT,1,3)_"0000"),$SELECT($GET(DGMT):$PIECE($GET(^DGMT(408.31,DGMT,0)),"^",19),1:1))
- +16 ;408.22 IEN
- SET DGX=$ORDER(^DGMT(408.22,"AIND",+DGX,0))
- +17 SET DGNODE=$GET(^DGMT(408.22,+DGX,0))
- IF DGNODE']""
- QUIT
- +18 SET DGDEPYN=$SELECT(DGDEP:1,1:0)
- +19 IF $PIECE(DGNODE,"^",13)'=DGDEP!($PIECE(DGNODE,"^",8)'=DGDEPYN)!($PIECE(DGNODE,"^",5)'=SPOUSE)
- Begin DoDot:1
- +20 SET DIE="^DGMT(408.22,"
- SET DA=+DGX
- SET DR=".13////^S X=DGDEP"_$SELECT(+$PIECE(DGNODE,"^",8)=DGDEPYN:"",1:";.08////^S X=DGDEPYN")_$SELECT($PIECE(DGNODE,"^",5)=SPOUSE:"",1:";.05////^S X=SPOUSE")
- +21 DO ^DIE
- +22 KILL DR,DA,DIE,DIC,Y,X
- End DoDot:1
- +23 QUIT
- +24 ;
- GETINACD(DFN,DGREL) ; Get all INACTIVE dependents for a patient
- +1 ; Input -- DFN as the IEN of file 2 (for the patient)
- +2 ; DGREL as Array of active spouse/dependents
- +3 ; Output -- DGIREL("S",counter) = spouse reference
- +4 ; DGIREL("C",counter) = child reference
- +5 NEW IEN,XCTR,TMPDGEL,XITYP,EDT,IFN,NODE
- +6 KILL DGIREL
- +7 if '$DATA(DGREL)
- QUIT
- +8 SET IEN=$PIECE($GET(DGREL("S")),U)
- if IEN'=""
- SET TMPDGREL(IEN)=""
- +9 SET XCTR=""
- FOR
- SET XCTR=$ORDER(DGREL("C",XCTR))
- if XCTR=""
- QUIT
- Begin DoDot:1
- +10 SET IEN=$PIECE(DGREL("C",XCTR),U)
- if IEN'=""
- SET TMPDGREL(IEN)=""
- End DoDot:1
- +11 SET IEN=0
- FOR
- SET IEN=$ORDER(^DGPR(408.12,"B",DFN,IEN))
- if IEN=""
- QUIT
- Begin DoDot:1
- +12 if ($DATA(TMPDGREL(IEN)))!('$DATA(^DGPR(408.12,IEN,"E")))
- QUIT
- +13 SET XITYP=$PIECE($GET(^DGPR(408.12,IEN,0)),U,2)
- +14 SET XITYP=$SELECT(XITYP=2:"S",((XITYP>2)&(XITYP<7)):"C",1:"")
- if XITYP=""
- QUIT
- +15 SET EDT=$ORDER(^DGPR(408.12,IEN,"E","AID",""))
- if EDT=""
- QUIT
- +16 SET IFN=$ORDER(^DGPR(408.12,IEN,"E","AID",EDT,""))
- if IFN=""
- QUIT
- +17 ;Don't want Active
- if $PIECE($GET(^DGPR(408.12,IEN,"E",IFN,0)),U,2)
- QUIT
- +18 SET NODE=$GET(^DGPR(408.12,IEN,0))
- +19 SET DGIREL(XITYP,$ORDER(DGIREL(XITYP,""),-1)+1)=IEN_U_$PIECE(NODE,U,3)_U_(EDT*-1)
- End DoDot:1
- +20 QUIT
- +21 ;
- CNTDEPS(DFN) ;Count Dependent children
- +1 ; DG*5.3*688 - EVC changes; GTS
- +2 ; Called by DGDEP4 and DGRPEIS1
- +3 ;
- +4 ;INPUT:
- +5 ; DFN - Patient file IEN for MT Veteran
- +6 ;OUTPUT:
- +7 ; Number of child dependents
- +8 ;
- +9 NEW IEN,DEPCNT,DGX
- +10 SET DEPCNT=0
- +11 SET IEN=0
- +12 FOR
- SET IEN=$ORDER(^DGPR(408.12,"B",DFN,IEN))
- if 'IEN
- QUIT
- Begin DoDot:1
- +13 SET DGX=$GET(^DGPR(408.12,IEN,0))
- +14 IF ($PIECE(DGX,U,2)>2)
- IF ($PIECE(DGX,U,2)<7)
- SET DEPCNT=DEPCNT+1
- End DoDot:1
- +15 QUIT DEPCNT