| 1 | DGENRDUA ;ALB/TDM - ENROLLMENT RATED DISABILITY UPLOAD AUDIT file (#390) APIs ; 11/14/07 3:11pm
|
|---|
| 2 | ;;5.3;REGISTRATION;**763**;Aug 13,1993;Build 9
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | RDCHG(DFN,FDT,TDT) ; API to return Rated Disability changes for Veterans
|
|---|
| 7 | ;****************************************************************
|
|---|
| 8 | ; NOTE: It is the responsibility of the calling application to
|
|---|
| 9 | ; kill the ^TMP($J,"RDCHG") global reference prior to
|
|---|
| 10 | ; calling this api and also after the calling routine is
|
|---|
| 11 | ; done with the global reference.
|
|---|
| 12 | ;****************************************************************
|
|---|
| 13 | ; Input
|
|---|
| 14 | ; DFN - Patients DFN (Optional, If not passed return all vets)
|
|---|
| 15 | ; FDT - Beginning Date Range (Optional)
|
|---|
| 16 | ; TDT - Ending Date Range (Optional)
|
|---|
| 17 | ;
|
|---|
| 18 | ; Output
|
|---|
| 19 | ; DFN = Pointer to PATIENT file (#2)
|
|---|
| 20 | ; OCC = Single occurrence of a Rated Disability change for Veteran
|
|---|
| 21 | ;
|
|---|
| 22 | ; ^TMP($J,"RDCHG",DFN,OCC)=P1^P2^P3^...etc
|
|---|
| 23 | ; Where: P1 = DATE/TIME OF CHANGE (fileman format)
|
|---|
| 24 | ; P2 = RATED DISABILITIES CODE (external value)
|
|---|
| 25 | ; P3 = RATED DISABILITIES NAME (external value)
|
|---|
| 26 | ; P4 = DISABILITY % (numeric value)
|
|---|
| 27 | ; P5 = EXTREMITY AFFECTED (internal code)
|
|---|
| 28 | ; P6 = EXTREMITY AFFECTED (external code)
|
|---|
| 29 | ; P7 = ORIGINAL EFFECTIVE DATE (fileman format)
|
|---|
| 30 | ; P8 = CURRENT EFFECTIVE DATE (fileman format)
|
|---|
| 31 | ;
|
|---|
| 32 | N XDT,IEN
|
|---|
| 33 | K ^TMP($J,"RDCHG")
|
|---|
| 34 | S DFN=$G(DFN),IEN=""
|
|---|
| 35 | S:$G(FDT)="" FDT=$$FMADD^XLFDT(DT,-365)
|
|---|
| 36 | S:$G(TDT)="" TDT=DT
|
|---|
| 37 | S XDT=$$FMADD^XLFDT(FDT,-1),XDT=XDT_".999999"
|
|---|
| 38 | S TDT=$$FMADD^XLFDT(TDT,1),TDT=TDT_".000001"
|
|---|
| 39 | I DFN D Q
|
|---|
| 40 | .F S XDT=$O(^DGRDUA(390,"APTDATE",DFN,XDT)) Q:((XDT<1)!(XDT>TDT)) D
|
|---|
| 41 | ..F S IEN=$O(^DGRDUA(390,"APTDATE",DFN,XDT,IEN)) Q:IEN="" D
|
|---|
| 42 | ...D BLDTMP(IEN)
|
|---|
| 43 | I 'DFN D Q
|
|---|
| 44 | .F S XDT=$O(^DGRDUA(390,"ADATEPT",XDT)) Q:((XDT<1)!(XDT>TDT)) D
|
|---|
| 45 | ..F S DFN=$O(^DGRDUA(390,"ADATEPT",XDT,DFN)) Q:DFN="" D
|
|---|
| 46 | ...F S IEN=$O(^DGRDUA(390,"ADATEPT",XDT,DFN,IEN)) Q:IEN="" D
|
|---|
| 47 | ....D BLDTMP(IEN)
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | BLDTMP(IEN) ; Build ^TMP global containing data for calling routine.
|
|---|
| 51 | Q:$G(IEN)=""
|
|---|
| 52 | N RDFN,OCC,DISCOD,RETURN,RETARY
|
|---|
| 53 | D GETS^DIQ(390,IEN,"*","IE","RETARY")
|
|---|
| 54 | S RDFN=$G(RETARY(390,IEN_",",2,"I")) Q:RDFN=""
|
|---|
| 55 | S OCC=$O(^TMP($J,"RDCHG",RDFN,""),-1)+1
|
|---|
| 56 | S DISCOD=$G(RETARY(390,IEN_",",3,"I"))_","
|
|---|
| 57 | S RETURN=$G(RETARY(390,IEN_",",.01,"I"))
|
|---|
| 58 | S $P(RETURN,U,2)=$$GET1^DIQ(31,DISCOD,.001)
|
|---|
| 59 | S $P(RETURN,U,3)=$$GET1^DIQ(31,DISCOD,.01)
|
|---|
| 60 | S $P(RETURN,U,4)=$G(RETARY(390,IEN_",",4,"E"))
|
|---|
| 61 | S $P(RETURN,U,5)=$G(RETARY(390,IEN_",",5,"I"))
|
|---|
| 62 | S $P(RETURN,U,6)=$G(RETARY(390,IEN_",",5,"E"))
|
|---|
| 63 | S $P(RETURN,U,7)=$G(RETARY(390,IEN_",",6,"I"))
|
|---|
| 64 | S $P(RETURN,U,8)=$G(RETARY(390,IEN_",",7,"I"))
|
|---|
| 65 | S ^TMP($J,"RDCHG",RDFN,OCC)=RETURN
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | PURGE ; Purge entries in file #390 that are over 365 days old.
|
|---|
| 69 | N PDT,DA,EDT,DIK
|
|---|
| 70 | S (PDT,DA)=0,EDT=$$FMADD^XLFDT(DT,-366)_".999999",DIK="^DGRDUA(390,"
|
|---|
| 71 | F S PDT=$O(^DGRDUA(390,"B",PDT)) Q:((PDT="")!(PDT>EDT)) D
|
|---|
| 72 | .F S DA=$O(^DGRDUA(390,"B",PDT,DA)) Q:DA="" D
|
|---|
| 73 | ..D ^DIK
|
|---|
| 74 | Q
|
|---|
