source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGENRDUA.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 2.9 KB
Line 
1DGENRDUA ;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 ;
6RDCHG(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 ;
50BLDTMP(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 ;
68PURGE ; 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
Note: See TracBrowser for help on using the repository browser.