GMTSDGD ; SLC/JER,KER - Rated Disabilities Component ; 02/27/2002
;;2.7;Health Summary;**49**;Oct 20, 1995
;
; External References
; DBIA 10035 ^DPT(
; DBIA 10015 EN^DIQ1 (file #2)
; DBIA 10061 6^VADPT
;
MAIN ; Initializes Variables and Controls Looping
N GMW,GMTSI,VA,VADM,VAEL,VAERR,VAPA
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 !
I '$D(^DPT(DFN,.372)) Q
S GMTSI=0 F S GMTSI=$O(^DPT(DFN,.372,GMTSI)) Q:GMTSI'>0 D WRT
Q
WRT ; Resolves pointers and prints disability record
N DA,DIQ,DR,DIC,GMTSDIS
S DIC="^DPT("_DFN_",.372,",DA=GMTSI,DR=".01;2;3",DIQ="GMTSDIS",DIQ(0)="E"
D EN^DIQ1
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"),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSDGD 980 printed Dec 13, 2024@01:57:25 Page 2
GMTSDGD ; SLC/JER,KER - Rated Disabilities Component ; 02/27/2002
+1 ;;2.7;Health Summary;**49**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10035 ^DPT(
+5 ; DBIA 10015 EN^DIQ1 (file #2)
+6 ; DBIA 10061 6^VADPT
+7 ;
MAIN ; Initializes Variables and Controls Looping
+1 NEW GMW,GMTSI,VA,VADM,VAEL,VAERR,VAPA
+2 DO 6^VADPT
IF +VAEL(1)
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Eligibility: ",$EXTRACT($PIECE(VAEL(1),U,2),1,40)
if VAEL(8)]""
WRITE ?55,$PIECE(VAEL(8),U,2)
WRITE !
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if +VAEL(3)
WRITE "Total S/C %: ",$PIECE(VAEL(3),U,2),!
WRITE !
+3 IF '$DATA(^DPT(DFN,.372))
QUIT
+4 SET GMTSI=0
FOR
SET GMTSI=$ORDER(^DPT(DFN,.372,GMTSI))
if GMTSI'>0
QUIT
DO WRT
+5 QUIT
WRT ; Resolves pointers and prints disability record
+1 NEW DA,DIQ,DR,DIC,GMTSDIS
+2 SET DIC="^DPT("_DFN_",.372,"
SET DA=GMTSI
SET DR=".01;2;3"
SET DIQ="GMTSDIS"
SET DIQ(0)="E"
+3 DO EN^DIQ1
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE GMTSDIS(2.04,DA,.01,"E"),?55,$JUSTIFY(GMTSDIS(2.04,DA,2,"E"),3),"%",?75,$SELECT(GMTSDIS(2.04,DA,3,"E")="YES":"S/C",1:"NSC"),!
+5 QUIT
