DGCVEXP.m

DGCVEXP ;ALB/ERC - FIND VETS WIITH EXPIRED CV STATUS; 12/11/02

 ;;5.3;Registration;**576,1015**; Aug 13, 1993;Build 21

 ;

 ;this API will list any veterans who have Combat Vet status that has

 ;expired.  This API will be called by IB to look for any vets who have

 ;been billed for treatment on the last day of their CV eligibility.

 ;

EN ;

 N DGC,DGE,DGEX,DGFILE

 K ^TMP("DGCVEX")

 S DGC=""

 S DGFILE=2

 F  S DGC=$O(^DPT("E",DGC)) Q:DGC'>0  D

 . S DGE=""

 . F  S DGE=$O(^DPT("E",DGC,DGE)) Q:DGE'>0  D

 . . S DGEX=$$GET1^DIQ(DGFILE,DGE_",",.5295,"I")

 . . I $G(DGEX)']"" Q

 . . I DT'>DGEX Q

 . . S ^TMP("DGCVEX",$J,DGE,DGEX)=""

 Q

DGCVEXP   ;ALB/ERC - FIND VETS WIITH EXPIRED CV STATUS; 12/11/02

 +1       ;;5.3;Registration;**576,1015**; Aug 13, 1993;Build 21

 +2       ;

 +3       ;this API will list any veterans who have Combat Vet status that has

 +4       ;expired.  This API will be called by IB to look for any vets who have

 +5       ;been billed for treatment on the last day of their CV eligibility.

 +6       ;

EN        ;

 +1        NEW DGC,DGE,DGEX,DGFILE

 +2        KILL ^TMP("DGCVEX")

 +3        SET DGC=""

 +4        SET DGFILE=2

 +5        FOR 

               SET DGC=$ORDER(^DPT("E",DGC))

               IF DGC'>0

                   QUIT 

               Begin DoDot:1

 +6                SET DGE=""

 +7                FOR 

                       SET DGE=$ORDER(^DPT("E",DGC,DGE))

                       IF DGE'>0

                           QUIT 

                       Begin DoDot:2

 +8                        SET DGEX=$$GET1^DIQ(DGFILE,DGE_",",.5295,"I")

 +9                        IF $GET(DGEX)']""

                               QUIT 

 +10                       IF DT'>DGEX

                               QUIT 

 +11                       SET ^TMP("DGCVEX",$JOB,DGE,DGEX)=""

                       End DoDot:2

               End DoDot:1

 +12       QUIT