EASECU2 ;ALB/LBD - Income Utilities ;14 AUG 2001
;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,122**;Mar 15, 2001;Build 18
;
GETIENS(DFN,DGPRI,DGDT) ;Look-up individual annual income and income relation
; Input -- DFN Patient file IEN
; DGPRI Patient Relation IEN
; DGDT Date/Time
; Output -- DGINI Individual Annual Income IEN
; DGIRI Income Relation IEN
; DGERR 1=ERROR and 0=NO ERROR
S DGERR=0
;patch EAS*1*122 adding a check for patient search of ? or ?? to remove undefined error when using the LTC Billing Clock Maintenance option
I $G(DZ)["?" Q
S DGINI=$$GETIN(DFN,DGPRI,DGDT) S:DGINI<0 DGERR=1
I 'DGERR S DGIRI=$$GETIR(DFN,DGINI) S:DGIRI<0 DGERR=1
Q
;
GETIN(DFN,DGPRI,DGDT) ;Look-up individual annual income
; Add a new entry if one is not found
; Input -- DFN Patient file IEN
; DGPRI Patient Relation IEN
; DGDT Date/Time
; Output -- Individual Annual Income IEN
N DGINI,DGYR
S DGYR=$E(DGDT,1,3)_"0000"
; get IEN of individual annual income for LTC co-pay (test type 3)
S DGINI=+$$IAI^DGMTU3(DGPRI,DGYR,3)
I '$D(^DGMT(408.21,DGINI,0)) S DGINI=$$ADDIN(DFN,DGPRI,DGYR)
GETINQ Q $S(DGINI>0:DGINI,1:-1)
;
ADDIN(DFN,DGPRI,DGYR) ;Add a new individual annual income entry
; Input -- DFN Patient file IEN
; DGPRI Patient Relation IEN
; DGYR Test Year
; Output -- New Individual Annual Income IEN
N DA,DD,DGINI,DGNOW,DIC,DIK,DINUM,DLAYGO,DO,X,Y,%
D NOW^%DTC S DGNOW=%
S X=DGYR,(DIC,DIK)="^DGMT(408.21,",DIC(0)="L",DLAYGO=408.21
D FILE^DICN S DGINI=+Y
I DGINI>0 D
.;patch EAS*1*122 correcting lock for SAC requirements
.L +^DGMT(408.21,DGINI):$G(DILOCKTM,3)
.S $P(^DGMT(408.21,DGINI,0),"^",2)=DGPRI,^("USR")=DUZ_"^"_DGNOW
.I $G(DGMTI) S ^DGMT(408.21,DGINI,"MT")=DGMTI
.S DA=DGINI D IX1^DIK L -^DGMT(408.21,DGINI)
ADDINQ Q $S(DGINI>0:DGINI,1:-1)
;
GETIR(DFN,DGINI) ;Look-up income relation
; Add a new entry if one is not found
; Input -- DFN Patient file IEN
; DGINI Individual Annual Income IEN
; Output -- Income Relation IEN
N DGIRI
S DGIRI=+$O(^DGMT(408.22,"AIND",DGINI,0))
I '$D(^DGMT(408.22,DGIRI,0)) S DGIRI=$$ADDIR(DFN,DGINI)
GETIRQ Q $S(DGIRI>0:DGIRI,1:-1)
;
ADDIR(DFN,DGINI) ;Add a new income relation entry
; Input -- DFN Patient file IEN
; DGINI Individual Annual Income IEN
; Output -- New Income Relation IEN
N DA,DD,DGIRI,DIC,DIK,DINUM,DLAYGO,DO,X,Y
S X=DFN,(DIC,DIK)="^DGMT(408.22,",DIC(0)="L",DLAYGO=408.22
D FILE^DICN S DGIRI=+Y
;patch EAS*1*122 correcting lock for SAC requirements
I DGIRI>0 L +^DGMT(408.22,DGIRI):$G(DILOCKTM,3) S $P(^DGMT(408.22,DGIRI,0),"^",2)=DGINI,DA=DGIRI D IX1^DIK L -^DGMT(408.22,DGIRI)
ADDIRQ Q $S(DGIRI>0:DGIRI,1:-1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASECU2 3167 printed Oct 16, 2024@17:55:07 Page 2
EASECU2 ;ALB/LBD - Income Utilities ;14 AUG 2001
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**5,122**;Mar 15, 2001;Build 18
+2 ;
GETIENS(DFN,DGPRI,DGDT) ;Look-up individual annual income and income relation
+1 ; Input -- DFN Patient file IEN
+2 ; DGPRI Patient Relation IEN
+3 ; DGDT Date/Time
+4 ; Output -- DGINI Individual Annual Income IEN
+5 ; DGIRI Income Relation IEN
+6 ; DGERR 1=ERROR and 0=NO ERROR
+7 SET DGERR=0
+8 ;patch EAS*1*122 adding a check for patient search of ? or ?? to remove undefined error when using the LTC Billing Clock Maintenance option
+9 IF $GET(DZ)["?"
QUIT
+10 SET DGINI=$$GETIN(DFN,DGPRI,DGDT)
if DGINI<0
SET DGERR=1
+11 IF 'DGERR
SET DGIRI=$$GETIR(DFN,DGINI)
if DGIRI<0
SET DGERR=1
+12 QUIT
+13 ;
GETIN(DFN,DGPRI,DGDT) ;Look-up individual annual income
+1 ; Add a new entry if one is not found
+2 ; Input -- DFN Patient file IEN
+3 ; DGPRI Patient Relation IEN
+4 ; DGDT Date/Time
+5 ; Output -- Individual Annual Income IEN
+6 NEW DGINI,DGYR
+7 SET DGYR=$EXTRACT(DGDT,1,3)_"0000"
+8 ; get IEN of individual annual income for LTC co-pay (test type 3)
+9 SET DGINI=+$$IAI^DGMTU3(DGPRI,DGYR,3)
+10 IF '$DATA(^DGMT(408.21,DGINI,0))
SET DGINI=$$ADDIN(DFN,DGPRI,DGYR)
GETINQ QUIT $SELECT(DGINI>0:DGINI,1:-1)
+1 ;
ADDIN(DFN,DGPRI,DGYR) ;Add a new individual annual income entry
+1 ; Input -- DFN Patient file IEN
+2 ; DGPRI Patient Relation IEN
+3 ; DGYR Test Year
+4 ; Output -- New Individual Annual Income IEN
+5 NEW DA,DD,DGINI,DGNOW,DIC,DIK,DINUM,DLAYGO,DO,X,Y,%
+6 DO NOW^%DTC
SET DGNOW=%
+7 SET X=DGYR
SET (DIC,DIK)="^DGMT(408.21,"
SET DIC(0)="L"
SET DLAYGO=408.21
+8 DO FILE^DICN
SET DGINI=+Y
+9 IF DGINI>0
Begin DoDot:1
+10 ;patch EAS*1*122 correcting lock for SAC requirements
+11 LOCK +^DGMT(408.21,DGINI):$GET(DILOCKTM,3)
+12 SET $PIECE(^DGMT(408.21,DGINI,0),"^",2)=DGPRI
SET ^("USR")=DUZ_"^"_DGNOW
+13 IF $GET(DGMTI)
SET ^DGMT(408.21,DGINI,"MT")=DGMTI
+14 SET DA=DGINI
DO IX1^DIK
LOCK -^DGMT(408.21,DGINI)
End DoDot:1
ADDINQ QUIT $SELECT(DGINI>0:DGINI,1:-1)
+1 ;
GETIR(DFN,DGINI) ;Look-up income relation
+1 ; Add a new entry if one is not found
+2 ; Input -- DFN Patient file IEN
+3 ; DGINI Individual Annual Income IEN
+4 ; Output -- Income Relation IEN
+5 NEW DGIRI
+6 SET DGIRI=+$ORDER(^DGMT(408.22,"AIND",DGINI,0))
+7 IF '$DATA(^DGMT(408.22,DGIRI,0))
SET DGIRI=$$ADDIR(DFN,DGINI)
GETIRQ QUIT $SELECT(DGIRI>0:DGIRI,1:-1)
+1 ;
ADDIR(DFN,DGINI) ;Add a new income relation entry
+1 ; Input -- DFN Patient file IEN
+2 ; DGINI Individual Annual Income IEN
+3 ; Output -- New Income Relation IEN
+4 NEW DA,DD,DGIRI,DIC,DIK,DINUM,DLAYGO,DO,X,Y
+5 SET X=DFN
SET (DIC,DIK)="^DGMT(408.22,"
SET DIC(0)="L"
SET DLAYGO=408.22
+6 DO FILE^DICN
SET DGIRI=+Y
+7 ;patch EAS*1*122 correcting lock for SAC requirements
+8 IF DGIRI>0
LOCK +^DGMT(408.22,DGIRI):$GET(DILOCKTM,3)
SET $PIECE(^DGMT(408.22,DGIRI,0),"^",2)=DGINI
SET DA=DGIRI
DO IX1^DIK
LOCK -^DGMT(408.22,DGIRI)
ADDIRQ QUIT $SELECT(DGIRI>0:DGIRI,1:-1)
