Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGMTU2

DGMTU2.m

Go to the documentation of this file.
  1. DGMTU2 ;ALB/RMO - Income Utilities ; 6/18/09 6:48pm
  1. ;;5.3;Registration;**33,688,805**;Aug 13, 1993;Build 4
  1. ;
  1. GETIENS(DFN,DGPRI,DGDT) ;Look-up individual annual income and income relation
  1. ; Input -- DFN Patient file IEN
  1. ; DGPRI Patient Relation IEN
  1. ; DGDT Date/Time
  1. ; Output -- DGINI Individual Annual Income IEN
  1. ; DGIRI Income Relation IEN
  1. ; DGERR 1=ERROR and 0=NO ERROR
  1. S DGERR=0
  1. S DGINI=$$GETIN(DFN,DGPRI,DGDT) S:DGINI<0 DGERR=1
  1. I 'DGERR S DGIRI=$$GETIR(DFN,DGINI) S:DGIRI<0 DGERR=1
  1. Q
  1. ;
  1. GETIN(DFN,DGPRI,DGDT) ;Look-up individual annual income
  1. ; Add a new entry if one is not found
  1. ; Input -- DFN Patient file IEN
  1. ; DGPRI Patient Relation IEN
  1. ; DGDT Date/Time
  1. ; Output -- Individual Annual Income IEN
  1. N DGINI,DGLY
  1. S DGLY=$$LYR^DGMTSCU1(DGDT)
  1. S DGINI=+$$IAI^DGMTU3(DGPRI,DGLY)
  1. I '$D(^DGMT(408.21,DGINI,0)) S DGINI=$$ADDIN(DFN,DGPRI,DGLY)
  1. GETINQ Q $S(DGINI>0:DGINI,1:-1)
  1. ;
  1. ADDIN(DFN,DGPRI,DGLY) ;Add a new individual annual income entry
  1. ; Input -- DFN Patient file IEN
  1. ; DGPRI Patient Relation IEN
  1. ; DGLY Last Year
  1. ; Output -- New Individual Annual Income IEN
  1. N DA,DD,DGINI,DGNOW,DIC,DIK,DINUM,DLAYGO,DO,X,Y,%
  1. D NOW^%DTC S DGNOW=%
  1. S X=DGLY,(DIC,DIK)="^DGMT(408.21,",DIC(0)="L",DLAYGO=408.21
  1. S DIC("DR")=".02////"_DGPRI_";101////"_DUZ_";102////"_DGNOW
  1. D FILE^DICN S DGINI=+Y
  1. ADDINQ Q $S(DGINI>0:DGINI,1:-1)
  1. ;
  1. GETIR(DFN,DGINI) ;Look-up income relation
  1. ; Add a new entry if one is not found
  1. ; Input -- DFN Patient file IEN
  1. ; DGINI Individual Annual Income IEN
  1. ; Output -- Income Relation IEN
  1. N DGIRI
  1. S DGIRI=+$O(^DGMT(408.22,"AIND",DGINI,0))
  1. I '$D(^DGMT(408.22,DGIRI,0)) S DGIRI=$$ADDIR(DFN,DGINI)
  1. GETIRQ Q $S(DGIRI>0:DGIRI,1:-1)
  1. ;
  1. ADDIR(DFN,DGINI) ;Add a new income relation entry
  1. ; Input -- DFN Patient file IEN
  1. ; DGINI Individual Annual Income IEN
  1. ; Output -- New Income Relation IEN
  1. N DA,DD,DGIRI,DIC,DIK,DINUM,DLAYGO,DO,X,Y
  1. S X=DFN,(DIC,DIK)="^DGMT(408.22,",DIC(0)="L",DLAYGO=408.22
  1. S DIC("DR")=".02////"_DGINI
  1. D FILE^DICN S DGIRI=+Y
  1. ADDIRQ Q $S(DGIRI>0:DGIRI,1:-1)
  1. ;
  1. ; GTS - DG*5.3*688
  1. VRCHKUP(DGMTYPT,TYPE,DGOLDDT,DGNWDT) ;Check the version and convert IAI records, as needed
  1. ; Input -- DGMTYPT : Type of test being processed
  1. ; TYPE : Optional - used when called from COPYRX^DGMTR1
  1. ; to indicate existing MT or LTC
  1. ; DGOLDDT : Optional - Date of Test for Old MT/CP test
  1. ; DGNWDT : Optional - Date of Test for New MT/CP test
  1. ; Output -- CONVRTD : 1 - IAI Records converted
  1. ; : 0 - IAI Records not converted
  1. ;
  1. N CONVRTD,DGMTLST,DGOTHIEN,DGSAMEYR,DGDEC31D,DGERR,DGMTRT,DGMTRT2
  1. S CONVRTD=0
  1. S DGSAMEYR=0
  1. ;
  1. I +$G(DGOLDDT)=0 S DGOLDDT=DT ;When DGOLDDT is not defined, default today's date
  1. I +$G(DGNWDT)'=0 S:($E(DGOLDDT,1,3)=$E(DGNWDT,1,3)) DGSAMEYR=1 ;If have New and Old test dates, check for same yr
  1. S DGDEC31D=$E(DGOLDDT,1,3)_"1231" ;Set search date of Dec 31 of Old Test year
  1. ;
  1. ; Check type of test being added or edited and then check for another test in the current year
  1. ; If Same year, get new test
  1. I DGSAMEYR DO
  1. .; NOTE: MT can not be created from a LTC CP Exempt test
  1. .I DGMTYPT=1 DO
  1. . . S DGMTLST=$$LST^DGMTU(DFN,DGNWDT,2) ;Find existing CP test - MT required
  1. . . S:($E($P(DGMTLST,"^",2),1,3)'=$E(DGOLDDT,1,3)) DGMTLST=$$LSTNP^DGMTU21(DFN,DGNWDT,2) ; Last primary test is previous YR
  1. . ; When updating CP test find either MT or LTC CP Exemption test
  1. .I DGMTYPT=2 DO
  1. . . IF '$D(TYPE) S DGMTLST=$$LST^DGMTU(DFN,DGNWDT,1) ;Find existing MT test - CP required
  1. . . IF $D(TYPE) S DGMTLST=$$LST^DGMTU(DFN,DGNWDT,TYPE) ;Find existing MT or LTC - CP Exempt
  1. .I DGMTYPT=4 DO
  1. . . IF '$D(TYPE) S DGMTLST=$$LST^DGMTU(DFN,DGNWDT,1) ;Find existing MT test - CP required
  1. . . IF $D(TYPE) S DGMTLST=$$LST^DGMTU(DFN,DGNWDT,TYPE) ;Find existing MT - CP req.
  1. . . ; If Last primary test is previous YR, look for last [may not be primary] (to check current year)
  1. . . I $E($P(DGMTLST,"^",2),1,3)'=$E(DGOLDDT,1,3) DO
  1. . . . S:'$D(TYPE) DGMTLST=$$LSTNP^DGMTU21(DFN,DGNWDT,1)
  1. . . . S:$D(TYPE) DGMTLST=$$LSTNP^DGMTU21(DFN,DGNWDT,TYPE)
  1. ;If not same year, search for new test in old test year
  1. I 'DGSAMEYR DO
  1. .; NOTE: MT can not be created from a LTC CP Exempt test
  1. .I DGMTYPT=1 DO
  1. . . S DGMTLST=$$LST^DGMTU(DFN,DGDEC31D,2) ;Find existing CP test - MT required
  1. .; When updating CP test find either MT or LTC CP Exemption test
  1. .I DGMTYPT=2 DO
  1. . . IF '$D(TYPE) S DGMTLST=$$LST^DGMTU(DFN,DGDEC31D,1) ;Find existing MT test - CP required
  1. . . IF $D(TYPE) S DGMTLST=$$LST^DGMTU(DFN,DGDEC31D,TYPE) ;Find existing MT or LTC - CP Exempt
  1. .I DGMTYPT=4 DO
  1. . . IF '$D(TYPE) S DGMTLST=$$LST^DGMTU(DFN,DGDEC31D,1) ;Find existing MT test - CP required
  1. . . IF $D(TYPE) S DGMTLST=$$LST^DGMTU(DFN,DGDEC31D,TYPE) ;Find existing MT test - CP req.
  1. . . ; If Last primary test is previous YR, look for last [may not be primary] (to check current year)
  1. . . I $E($P(DGMTLST,"^",2),1,3)'=$E(DGOLDDT,1,3) DO
  1. . . . S:'$D(TYPE) DGMTLST=$$LSTNP^DGMTU21(DFN,DGDEC31D,1)
  1. . . . S:$D(TYPE) DGMTLST=$$LSTNP^DGMTU21(DFN,DGDEC31D,TYPE)
  1. ;
  1. ; LTC4 test does not require a record in 408.31, 408.21 records can exist without MT/CP records
  1. ; If 408.31 entry is not found and LTC4 is being added
  1. I (+$G(DGMTLST)'>0),(+DGMTYPT=4) DO
  1. . N DGINC2,DGREL2,DGINR2,DGDEP2
  1. . M:$D(DGINC) DGINC2=DGINC
  1. . M:$D(DGREL) DGREL2=DGREL
  1. . M:$D(DGINR) DGINR2=DGINR
  1. . M:$D(DGDEP) DGDEP2=DGDEP
  1. . ; Search IAI records in 408.21; If found convert to 1, as necessary
  1. . D ALL^DGMTU21(DFN,"VSD",DT,"IPR")
  1. . I $D(DGINC) DO
  1. . . N OTHRTST
  1. . . D ISCNVRT^DGMTUTL(.DGINC)
  1. . . S OTHRTST=$$UPDTTSTS^DGMTU21(DFN,$E($P(DGMTLST,"^",2),1,3))
  1. . . S CONVRTD=1
  1. . ; Restore DGINC, DGREL, DGINR, and DGDEP
  1. . K DGINC,DGREL,DGINR,DGDEP
  1. . M:$D(DGINC2) DGINC=DGINC2
  1. . M:$D(DGREL2) DGREL=DGREL2
  1. . M:$D(DGINR2) DGINR=DGINR2
  1. . M:$D(DGDEP2) DGDEP=DGDEP2
  1. ;
  1. ; If another test is found
  1. I $D(DGMTLST),(+DGMTLST>0) DO
  1. . ; if the year of the test that have = year of test with IAI records to analyze
  1. . I ($E($P(DGMTLST,"^",2),1,3)=$E(DGOLDDT,1,3)) DO
  1. . . S DGOTHIEN=+DGMTLST
  1. . . ;
  1. . . ; If the other test was not entered in Version 1 format
  1. . . I +$P($G(^DGMT(408.31,DGOTHIEN,2)),"^",11)'=1 DO
  1. . . . ; Save values of DGINC, DGREL, DGINR, and DGDEP
  1. . . . N DGINC2,DGREL2,DGINR2,DGDEP2
  1. . . . M:$D(DGINC) DGINC2=DGINC
  1. . . . M:$D(DGREL) DGREL2=DGREL
  1. . . . M:$D(DGINR) DGINR2=DGINR
  1. . . . M:$D(DGDEP) DGDEP2=DGDEP
  1. . . . ;
  1. . . . ; Get IAI records from 408.21 and convert them from version 0 to 1
  1. . . . D:(+$P(DGMTLST,"^",2)>0) ALL^DGMTU21(DFN,"VSD",+$P(DGMTLST,"^",2),"IPR")
  1. . . . D:(+$P(DGMTLST,"^",2)'>0) ALL^DGMTU21(DFN,"VSD",DT,"IPR")
  1. . . . D ISCNVRT^DGMTUTL(.DGINC)
  1. . . . ;
  1. . . . ; Update 2.11 in all (1, 2 and 4 type) 408.31 records for DFN and IY
  1. . . . N OTHRTST
  1. . . . S OTHRTST=$$UPDTTSTS^DGMTU21(DFN,$E($P(DGMTLST,"^",2),1,3))
  1. . . . ;
  1. . . . ; Restore DGINC, DGREL, DGINR, and DGDEP
  1. . . . K DGINC,DGREL,DGINR,DGDEP
  1. . . . M:$D(DGINC2) DGINC=DGINC2
  1. . . . M:$D(DGREL2) DGREL=DGREL2
  1. . . . M:$D(DGINR2) DGINR=DGINR2
  1. . . . M:$D(DGDEP2) DGDEP=DGDEP2
  1. . . . S CONVRTD=1
  1. VRCHKQ Q CONVRTD