DVBAB3 ;ALB/KLB - CAPRI Amis Report ;05/01/00
;;2.7;AMIE;**35,42,149,184**;Apr 10, 1995;Build 10
;Per VHA Directive 2004-038, this routine should not be modified.
;
;Input: MSG - Array with report contents/error message
; (By Ref)
; BDATE - Beginning date in a date range to use
; for retrieving results for the report.
; EDATE - Ending date in a date range to use for
; retrieving results for the report.
; RONUMB - Regional Office number '^' Division to
; filter result set on (Both Optional)
; SBULL - A Y/N value indicating whether a bulletin
; (Report Contents) will be generated when
; processing completes.
; DUZ - IEN of the individual in File #200 to send
; bulletin to.
; DVBAPRTY - Priority of Exam code that indicates which
; priorities to filter on.
; AO - Agent Orange (A0)
; BDD - Benefits Delivery at Discharge (BDD)
; Quick Start (QS)
; IDES - Integrated Disability Evaluation System (IDES)
; ALL - All others (Excludes AO,BDD,IDES,QS)
STRT(MSG,BDATE,EDATE,RONUMB,SBULL,DUZ,DVBAPRTY) ;
S BDATE=BDATE+".0000"
S EDATE=EDATE+".2359"
S DVBDIV=$P($G(RONUMB),"^",2)
S RONUMB=$P($G(RONUMB),"^",1)
S CNT=0
K ^TMP($J)
S RONUM=0
SETUP S UPDATE="N",PREVMO=$P(^DVB(396.1,1,0),U,11)
I '$D(DT) S DT=$$DT^XLFDT
S DVBCDT(0)=$$FMTE^XLFDT(DT,"5DZ")
INITCNTR ;initialize counter arrays
N DVBAEXMP,DVBAP
S DVBAEXMP=$S($G(DVBAPRTY)["BDD":"BDD,QS",($G(DVBAPRTY)["IDES"):"IDES",($G(DVBAPRTY)["AO"):"AO",1:"ALL")
F JI="3DAYSCH","30DAYEX","PENDADJ" D
.F DVBAP=1:1:$L(DVBAEXMP,",") S TOT($P(DVBAEXMP,",",DVBAP),JI)=0
F JI="INSUFF","SENT","INCOMPLETE","DAYS","COMPLETED" D
.F DVBAP=1:1:$L(DVBAEXMP,",") S TOT($P(DVBAEXMP,",",DVBAP),JI)=0
F JI="P90","P121","P151","P181","P365","P366" D
.F DVBAP=1:1:$L(DVBAEXMP,",") S TOT($P(DVBAEXMP,",",DVBAP),JI)=0
S ^TMP($J,CNT)="REGIONAL OFFICE 2507 AMIS REPORT",CNT=CNT+1
;
EN ;
N DVBAERR
S ^TMP($J,CNT)="",CNT=CNT+1,^TMP($J,CNT)="",CNT=CNT+1,^TMP($J,CNT)="",CNT=CNT+1
S:'$D(EDATE) MSG(1)="Please enter a ending date"
G:'$D(EDATE) EXIT
S:'$D(BDATE) MSG(1)="Please enter a starting date"
G:'$D(BDATE) EXIT
S BDATE1=BDATE-.1,EDATE1=EDATE+.5
S:EDATE<BDATE MSG(1)="Beginning date must be before ending date"
G:EDATE<BDATE EXIT
I (RONUMB]"") D G:DVBAERR EXIT
.S DVBAERR=0
.S RONUM=$O(^DIC(4,"B",RONUMB,RONUM))
.I RONUM="" S MSG(1)="Invalid Regional Office number",DVBAERR=1 Q
.S:'$D(^DIC(4,RONUM,99)) MSG(1)="Invalid Regional Office number",DVBAERR=1
.Q:'$D(^DIC(4,RONUM,99))
.S RONUM=$S($D(^DIC(4,RONUM,99)):$P(^(99),U,1),1:"000")
.S RONAME=RONUMB
D:(RONUMB']"")
.S (RONUM,RONAME)="ALL"
;validate Priority of Exam (Null Allowed and will default to ALL)
I ((";AO;BDD;IDES;ALL;;")'[(";"_$G(DVBAPRTY)_";")) D G EXIT
.S MSG(1)="Invalid Priority of Exam Code"
S:'$D(SBULL) MSG(1)="You need to say if you want a Bulletin or not"
G:'$D(SBULL) EXIT
I SBULL="Y" D BULL^DVBAB2
;
D GO^DVBAB2
EXIT K BDATE,BDATE1,DVBCDT,EDATE,CNT,EDATE1,JI,PREVMO,RONAME,RONUM,RONUMB,SBULL,TOT,UPDATE,X,Y,^TMP($J)
Q
INIT(Y) ;
; INITS MAILMAN VARIABLES
D INIT^XMVVITAE
S Y=XMV("NETNAME")_"^"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAB3 3429 printed Dec 13, 2024@01:40:23 Page 2
DVBAB3 ;ALB/KLB - CAPRI Amis Report ;05/01/00
+1 ;;2.7;AMIE;**35,42,149,184**;Apr 10, 1995;Build 10
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;Input: MSG - Array with report contents/error message
+5 ; (By Ref)
+6 ; BDATE - Beginning date in a date range to use
+7 ; for retrieving results for the report.
+8 ; EDATE - Ending date in a date range to use for
+9 ; retrieving results for the report.
+10 ; RONUMB - Regional Office number '^' Division to
+11 ; filter result set on (Both Optional)
+12 ; SBULL - A Y/N value indicating whether a bulletin
+13 ; (Report Contents) will be generated when
+14 ; processing completes.
+15 ; DUZ - IEN of the individual in File #200 to send
+16 ; bulletin to.
+17 ; DVBAPRTY - Priority of Exam code that indicates which
+18 ; priorities to filter on.
+19 ; AO - Agent Orange (A0)
+20 ; BDD - Benefits Delivery at Discharge (BDD)
+21 ; Quick Start (QS)
+22 ; IDES - Integrated Disability Evaluation System (IDES)
+23 ; ALL - All others (Excludes AO,BDD,IDES,QS)
STRT(MSG,BDATE,EDATE,RONUMB,SBULL,DUZ,DVBAPRTY) ;
+1 SET BDATE=BDATE+".0000"
+2 SET EDATE=EDATE+".2359"
+3 SET DVBDIV=$PIECE($GET(RONUMB),"^",2)
+4 SET RONUMB=$PIECE($GET(RONUMB),"^",1)
+5 SET CNT=0
+6 KILL ^TMP($JOB)
+7 SET RONUM=0
SETUP SET UPDATE="N"
SET PREVMO=$PIECE(^DVB(396.1,1,0),U,11)
+1 IF '$DATA(DT)
SET DT=$$DT^XLFDT
+2 SET DVBCDT(0)=$$FMTE^XLFDT(DT,"5DZ")
INITCNTR ;initialize counter arrays
+1 NEW DVBAEXMP,DVBAP
+2 SET DVBAEXMP=$SELECT($GET(DVBAPRTY)["BDD":"BDD,QS",($GET(DVBAPRTY)["IDES"):"IDES",($GET(DVBAPRTY)["AO"):"AO",1:"ALL")
+3 FOR JI="3DAYSCH","30DAYEX","PENDADJ"
Begin DoDot:1
+4 FOR DVBAP=1:1:$LENGTH(DVBAEXMP,",")
SET TOT($PIECE(DVBAEXMP,",",DVBAP),JI)=0
End DoDot:1
+5 FOR JI="INSUFF","SENT","INCOMPLETE","DAYS","COMPLETED"
Begin DoDot:1
+6 FOR DVBAP=1:1:$LENGTH(DVBAEXMP,",")
SET TOT($PIECE(DVBAEXMP,",",DVBAP),JI)=0
End DoDot:1
+7 FOR JI="P90","P121","P151","P181","P365","P366"
Begin DoDot:1
+8 FOR DVBAP=1:1:$LENGTH(DVBAEXMP,",")
SET TOT($PIECE(DVBAEXMP,",",DVBAP),JI)=0
End DoDot:1
+9 SET ^TMP($JOB,CNT)="REGIONAL OFFICE 2507 AMIS REPORT"
SET CNT=CNT+1
+10 ;
EN ;
+1 NEW DVBAERR
+2 SET ^TMP($JOB,CNT)=""
SET CNT=CNT+1
SET ^TMP($JOB,CNT)=""
SET CNT=CNT+1
SET ^TMP($JOB,CNT)=""
SET CNT=CNT+1
+3 if '$DATA(EDATE)
SET MSG(1)="Please enter a ending date"
+4 if '$DATA(EDATE)
GOTO EXIT
+5 if '$DATA(BDATE)
SET MSG(1)="Please enter a starting date"
+6 if '$DATA(BDATE)
GOTO EXIT
+7 SET BDATE1=BDATE-.1
SET EDATE1=EDATE+.5
+8 if EDATE<BDATE
SET MSG(1)="Beginning date must be before ending date"
+9 if EDATE<BDATE
GOTO EXIT
+10 IF (RONUMB]"")
Begin DoDot:1
+11 SET DVBAERR=0
+12 SET RONUM=$ORDER(^DIC(4,"B",RONUMB,RONUM))
+13 IF RONUM=""
SET MSG(1)="Invalid Regional Office number"
SET DVBAERR=1
QUIT
+14 if '$DATA(^DIC(4,RONUM,99))
SET MSG(1)="Invalid Regional Office number"
SET DVBAERR=1
+15 if '$DATA(^DIC(4,RONUM,99))
QUIT
+16 SET RONUM=$SELECT($DATA(^DIC(4,RONUM,99)):$PIECE(^(99),U,1),1:"000")
+17 SET RONAME=RONUMB
End DoDot:1
if DVBAERR
GOTO EXIT
+18 if (RONUMB']"")
Begin DoDot:1
+19 SET (RONUM,RONAME)="ALL"
End DoDot:1
+20 ;validate Priority of Exam (Null Allowed and will default to ALL)
+21 IF ((";AO;BDD;IDES;ALL;;")'[(";"_$GET(DVBAPRTY)_";"))
Begin DoDot:1
+22 SET MSG(1)="Invalid Priority of Exam Code"
End DoDot:1
GOTO EXIT
+23 if '$DATA(SBULL)
SET MSG(1)="You need to say if you want a Bulletin or not"
+24 if '$DATA(SBULL)
GOTO EXIT
+25 IF SBULL="Y"
DO BULL^DVBAB2
+26 ;
+27 DO GO^DVBAB2
EXIT KILL BDATE,BDATE1,DVBCDT,EDATE,CNT,EDATE1,JI,PREVMO,RONAME,RONUM,RONUMB,SBULL,TOT,UPDATE,X,Y,^TMP($JOB)
+1 QUIT
INIT(Y) ;
+1 ; INITS MAILMAN VARIABLES
+2 DO INIT^XMVVITAE
+3 SET Y=XMV("NETNAME")_"^"
+4 QUIT
