source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSDGD.m@ 862

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

initial load of WorldVistAEHR

File size: 960 bytes
RevLine 
[613]1GMTSDGD ; SLC/JER,KER - Rated Disabilities Component ; 02/27/2002
2 ;;2.7;Health Summary;**49**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10035 ^DPT(
6 ; DBIA 10015 EN^DIQ1 (file #2)
7 ; DBIA 10061 6^VADPT
8 ;
9MAIN ; Initializes Variables and Controls Looping
10 N GMW,GMTSI,VA,VADM,VAEL,VAERR,VAPA
11 D 6^VADPT I +VAEL(1) D CKP^GMTSUP Q:$D(GMTSQIT) W "Eligibility: ",$E($P(VAEL(1),U,2),1,40) W:VAEL(8)]"" ?55,$P(VAEL(8),U,2) W ! D CKP^GMTSUP Q:$D(GMTSQIT) W:+VAEL(3) "Total S/C %: ",$P(VAEL(3),U,2),! W !
12 I '$D(^DPT(DFN,.372)) Q
13 S GMTSI=0 F S GMTSI=$O(^DPT(DFN,.372,GMTSI)) Q:GMTSI'>0 D WRT
14 Q
15WRT ; Resolves pointers and prints disability record
16 N DA,DIQ,DR,DIC,GMTSDIS
17 S DIC="^DPT("_DFN_",.372,",DA=GMTSI,DR=".01;2;3",DIQ="GMTSDIS",DIQ(0)="E"
18 D EN^DIQ1
19 D CKP^GMTSUP Q:$D(GMTSQIT) W GMTSDIS(2.04,DA,.01,"E"),?55,$J(GMTSDIS(2.04,DA,2,"E"),3),"%",?75,$S(GMTSDIS(2.04,DA,3,"E")="YES":"S/C",1:"NSC"),!
20 Q
Note: See TracBrowser for help on using the repository browser.