GMTSDGD.m

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 ---GMTSDGD   980     printed  Feb 18, 2025@23:23:47                                                                                                                                                                                                      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