| 1 | DGMTU11 ;ALB/MIR - Patient Relation Retrieval Utilities ; 24 MAR 92
|
|---|
| 2 | ;;5.3;Registration;**33,45,182,311**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | ;=======================================================================
|
|---|
| 6 | ; The following utilities will obtain data from the PATIENT RELATION
|
|---|
| 7 | ; file
|
|---|
| 8 | ;=======================================================================
|
|---|
| 9 | ;
|
|---|
| 10 | ;
|
|---|
| 11 | GETREL(DFN,DGTYPE,DGDT,DGMT) ; Get all active dependents for a patient
|
|---|
| 12 | ;
|
|---|
| 13 | ; Input -- DFN as the IEN of file 2 (for the patient)
|
|---|
| 14 | ; DGTYPE containing the letters V, S, C, or D representing
|
|---|
| 15 | ; the type of dependents returned
|
|---|
| 16 | ; (C and D should be mutually exclusive)
|
|---|
| 17 | ; DGDT [optional] as active date...DT if not defined
|
|---|
| 18 | ; if no month/day, checks entire year/month
|
|---|
| 19 | ; DGMT [optional] IFN of means test
|
|---|
| 20 | ; Output -- DGREL("V") = veteran reference
|
|---|
| 21 | ; DGREL("S") = spouse reference
|
|---|
| 22 | ; DGREL("C",counter) = child reference (only MT dep)
|
|---|
| 23 | ; DGREL("D",counter) = dependent reference (all deps)
|
|---|
| 24 | ; reference=IFN of 408.12^dep file ref
|
|---|
| 25 | ; DGDEP = number of active dependents
|
|---|
| 26 | ;
|
|---|
| 27 | N CT,DGX,IFN,IEN,REF,X,DGCD K DGREL
|
|---|
| 28 | S (CT,IFN,IEN)=0,DGDT=$S($G(DGDT):DGDT,1:DT)
|
|---|
| 29 | D:$G(DGMT) RELINC ;IFN of Means Test is supplied
|
|---|
| 30 | D:('$G(DGREL("V"))&(DGTYPE["V"))!('$G(DGMT)) RELFND ;No Means Test IFN or problem setting DGREL(V)
|
|---|
| 31 | D GETRELQ ; Increment the dependent count
|
|---|
| 32 | Q
|
|---|
| 33 | RELINC F S IFN=$O(^DGMT(408.22,"AMT",DGMT,DFN,IFN)) Q:'IFN D
|
|---|
| 34 | .S IEN=+$P($G(^DGMT(408.21,IFN,0)),"^",2),DGX=$G(^DGPR(408.12,IEN,0))
|
|---|
| 35 | .D SET
|
|---|
| 36 | Q
|
|---|
| 37 | 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
|
|---|
| 38 | Q
|
|---|
| 39 | GETRELQ S DGDEP=CT
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | ;
|
|---|
| 43 | SET ; set variables into array...first subscript is relation type, second
|
|---|
| 44 | ; is IEN of file 408.12 (patient relations file)
|
|---|
| 45 | ;
|
|---|
| 46 | N REF,TYPE
|
|---|
| 47 | S X=$P(DGX,"^",2),REF=$P(DGX,"^",3),TYPE=""
|
|---|
| 48 | I X=1,(DGTYPE["V") S TYPE="V"
|
|---|
| 49 | I X=2,(DGTYPE["S") S TYPE="S"
|
|---|
| 50 | I X>2,(X<7) S TYPE=$S(DGTYPE["D":"D",DGTYPE["C":"C",1:"")
|
|---|
| 51 | I X>6,(DGTYPE["D") S TYPE="D"
|
|---|
| 52 | I 'X!(TYPE']"") Q ; not valid or not chosen
|
|---|
| 53 | I "VS"[TYPE,$D(DGREL(TYPE)) Q ; take first self or spouse on file
|
|---|
| 54 | S REF=IEN_"^"_REF
|
|---|
| 55 | I "VS"[TYPE S DGREL(TYPE)=REF
|
|---|
| 56 | I "CD"[TYPE&('$G(DGCD(REF))) S CT=CT+1,DGREL(TYPE,CT)=REF,DGCD(REF)=CT
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | ;
|
|---|
| 60 | ACTIVE(IEN,DGDT) ; Extrinsic function to determine if 408.12 entry is active
|
|---|
| 61 | ;
|
|---|
| 62 | ; Input -- IEN as internal entry number of pt relation file
|
|---|
| 63 | ; DGDT as 'as of' date (uses DT if undefined)
|
|---|
| 64 | ; Output -- 1 if active, 0 otherwise
|
|---|
| 65 | ;
|
|---|
| 66 | N DGFL,DGID,MIEN,DGNOM,DGNOY,ID,Y
|
|---|
| 67 | S DGID=$S($G(DGDT):DGDT,1:DT) I '$P(DGID,".",2) S $P(DGID,".",2)=2359
|
|---|
| 68 | S (DGFL,Y,DGNOM,DGNOY)=0
|
|---|
| 69 | 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
|
|---|
| 70 | S ID=-ID,DGID=-DGID
|
|---|
| 71 | F S ID=$O(^DGPR(408.12,IEN,"E","AID",ID)) Q:'ID!DGFL!Y S MIEN=$O(^(ID,0)) D
|
|---|
| 72 | . S X=$G(^DGPR(408.12,IEN,"E",MIEN,0)) I 'X Q
|
|---|
| 73 | . ;I 'DGNOY,'DGNOM S DGFL=1 S:$P(X,"^",2) Y=1 Q
|
|---|
| 74 | . I $P(X,"^",2)=1 S Y=1 Q
|
|---|
| 75 | . I ID>DGID S DGFL=1 ;quit...already before begin date
|
|---|
| 76 | Q $S(Y:1,1:0)
|
|---|
| 77 | ;
|
|---|
| 78 | ;
|
|---|
| 79 | RESET(DFN,DGDT,DGMT) ;
|
|---|
| 80 | ; Sets 'NUMBER OF DEPENDENT CHILDREN' (#.13) and
|
|---|
| 81 | ; 'DEPENDENT CHILDREN' (#.08) in Income Relation File (#408.22)
|
|---|
| 82 | ; based upon the count of active child dependents in Patient
|
|---|
| 83 | ; Relation File (#408.12).
|
|---|
| 84 | ;
|
|---|
| 85 | ; IN: DFN - IEN of Patient File (#2)
|
|---|
| 86 | ; DGDT - [optional] as 'as of' date
|
|---|
| 87 | ; DGMT - [optional] means test IEN
|
|---|
| 88 | ; OUT: SETS (.08) & (.13) fields of (408.22)
|
|---|
| 89 | ; No Formal Output
|
|---|
| 90 | ;
|
|---|
| 91 | N DGNODE,DGDEPYN,DGDEP,DGREL,DGX,PRIEN,SPOUSE
|
|---|
| 92 | S (CT,IEN,PRIEN,SPOUSE,DGDEP)=0,DGDT=$S($G(DGDT):DGDT,1:$$LYR^DGMTSCU1(DT))
|
|---|
| 93 | D GETREL(DFN,"VSD",DGDT,$G(DGMT)) S PRIEN=+$G(DGREL("V")),SPOUSE=$S($G(DGREL("S")):1,1:0)
|
|---|
| 94 | 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
|
|---|
| 95 | S DGX=$O(^DGMT(408.22,"AIND",+DGX,0)) ;408.22 IEN
|
|---|
| 96 | S DGNODE=$G(^DGMT(408.22,+DGX,0)) I DGNODE']"" Q
|
|---|
| 97 | S DGDEPYN=$S(DGDEP:1,1:0)
|
|---|
| 98 | I $P(DGNODE,"^",13)'=DGDEP!($P(DGNODE,"^",8)'=DGDEPYN)!($P(DGNODE,"^",5)'=SPOUSE) D
|
|---|
| 99 | .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")
|
|---|
| 100 | .D ^DIE
|
|---|
| 101 | .K DR,DA,DIE,DIC,Y,X
|
|---|
| 102 | Q
|
|---|
