DGCVEXP ;ALB/ERC - FIND VETS WIITH EXPIRED CV STATUS; 12/11/02
;;5.3;Registration;**576**; Aug 13, 1993
;
;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGCVEXP 637 printed Nov 22, 2024@17:51:47 Page 2
DGCVEXP ;ALB/ERC - FIND VETS WIITH EXPIRED CV STATUS; 12/11/02
+1 ;;5.3;Registration;**576**; Aug 13, 1993
+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
