DVBCAMIS ;ALB/GTS-557/THM-2507 AMIS REPORT ;21 MAY 89@0822 ; 5/23/91 1:30 PM
;;2.7;AMIE;**17,149,184,192**;Apr 10, 1995;Build 15
;Per VHA Directive 2004-038, this routine should not be modified.
;
SETUP ;
;
; Check for AMIS 290 replacement URL
;
; Input:
; RTN - Return value, current URL
; WHICH - index of URL to retrieve
;
; Output:
; RTN - URL of location to replace this report
;
N RTN,WHICH
S RTN="",WHICH=7
D URL^DVBABURL(.RTN,WHICH)
I RTN'="" W !,"The AMIS 290 Report is no longer available here.",!," Please go to: ",RTN Q
N DVBAPRTY,DVBAEXMP,DVBAP
S UPDATE="N",HD="AMIS 290 REPORT" I '$D(DT) S X="T" D ^%DT S DT=Y
S DVBCDT(0)=$$FMTE^XLFDT(DT,"5DZ")
D HOME^%ZIS S FF=IOF
;prompt for priority of exam
S DVBAPRTY=$$EXMPRTY^DVBCIUTL("Select the Priority of Exam for the AMIS 290 Report")
G:('(DVBAPRTY?.A)!(DVBAPRTY']"")) EXIT ;quit if no priority of exam selected
;
INIT ;initialize counter arrays
S DVBAEXMP=$S($G(DVBAPRTY)["BDD":"BDD,QS",($G(DVBAPRTY)["IDES"):"IDES",($G(DVBAPRTY)["AO"):"AO",1:"ALL")
F JI="3DAYSCH","30DAYEX","PENDADJ","TRANSIN","TRNRETTO","TRNPNDTO","TRANSOUT","TRNRETFR","TRNPNDFR","INSUFF" D
.F DVBAP=1:1:$L(DVBAEXMP,",") S TOT($P(DVBAEXMP,",",DVBAP),JI)=0
F JI="RECEIVED","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
;
EN W @IOF,!?(IOM-$L(HD)\2),HD,!!!
S %DT(0)=-DT,%DT="AE",%DT("A")="Enter STARTING DATE: " D ^%DT G:Y<0 EXIT S BDATE1=Y,BDATE=Y-.1
S %DT="AE",%DT("A")=" and ENDING DATE: " D ^%DT G:Y<0 EN S EDATE1=Y,EDATE=Y+.5
I EDATE1<BDATE1 W *7,!!,"Invalid date sequence - ending date is before starting date.",!! H 3 G EN
ASK0 ;prompt for previous month pending count
N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DVBATXT
S DIR(0)="N^0:9999:0"
S DIR("?",1)="Enter the totals for the month previous to the one you are processing."
S DIR("?")="Must be a number from 0 to 9999."
S DIR("T")=DTIME ;time-out value specified by system
W !!
;get previous month pending count for each priority of exam to run
F DVBAP=1:1:$L(DVBAEXMP,",") Q:($G(DIRUT)!($G(DIROUT))) D
.S DVBATXT=$$GPTYPE($P(DVBAEXMP,",",DVBAP))
.S DIR("A",1)="Please enter the total pending, "_DVBATXT
.S DIR("A")=" exam priorities, from the previous month"
.D ^DIR
.S:$L(DVBAEXMP,",")=1 PREVMO=$G(Y)
.S:$L(DVBAEXMP,",")>1 PREVMO($P(DVBAEXMP,",",DVBAP))=$G(Y)
G:($G(DIRUT)!($G(DIROUT))) EXIT ;user timed/exited out
;
ASK K %DT S SBULL="Y"
W !!!,"Do you want to send a bulletin when processing is done"
S %=1 D YN^DICN G:$D(DTOUT)!(%<0) EXIT
I %=0 W !!,"Enter Y to send a bulletin to selected recipients or N not to send it at all.",!! G ASK
I %'=1 S SBULL="N"
I SBULL="Y" D BULL^DVBCAMI3
W ! S %ZIS="AEQ",%ZIS("A")="Output device: " D ^%ZIS G:POP EXIT
I $D(IO("Q")) S ZTRTN="GO^DVBCAMI2",ZTDESC="2507 Amis Report",ZTIO=ION F I="PREVMO*","RO*","BDATE*","TOT*","EDATE*","SBULL","DUZ","DVBCDT(0)","XM*","DVBAPRTY" S ZTSAVE(I)=""
I $D(IO("Q")) D ^%ZTLOAD W:$D(ZTSK) !!,"Request queued",!! H 1 K ZTSK G EXIT
G GO^DVBCAMI2
;
EXIT K PREVMO,UPDATE G KILL^DVBCUTIL
;
;
;Input : DVBACDE - Code to get description for
; [BDD,QS,IDES,AO]
;Ouput : Corresponding description for code
GPTYPE(DVBACDE) ;get exam priority desc
N DVBATXT
Q:($G(DVBACDE)']"") ""
S DVBATXT=$S(DVBACDE="BDD":"'Benefits Delivery at Discharge ("_DVBACDE_")'",1:"")
S:(DVBATXT']"") DVBATXT=$S(DVBACDE="QS":"'Quick Start ("_DVBACDE_")'",1:"")
S:(DVBATXT']"") DVBATXT=$S(DVBACDE="IDES":"'Integrated Disability Evaluation System ("_DVBACDE_")'",1:"")
S:(DVBATXT']"") DVBATXT=$S(DVBACDE="AO":"'Agent Orange ("_DVBACDE_")'",1:"")
S:(DVBATXT']"") DVBATXT=$S(DVBACDE="ALL":"excluding BDD,QS,IDES and AO",1:"")
Q DVBATXT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCAMIS 3903 printed Sep 23, 2025@19:19:30 Page 2
DVBCAMIS ;ALB/GTS-557/THM-2507 AMIS REPORT ;21 MAY 89@0822 ; 5/23/91 1:30 PM
+1 ;;2.7;AMIE;**17,149,184,192**;Apr 10, 1995;Build 15
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
SETUP ;
+1 ;
+2 ; Check for AMIS 290 replacement URL
+3 ;
+4 ; Input:
+5 ; RTN - Return value, current URL
+6 ; WHICH - index of URL to retrieve
+7 ;
+8 ; Output:
+9 ; RTN - URL of location to replace this report
+10 ;
+11 NEW RTN,WHICH
+12 SET RTN=""
SET WHICH=7
+13 DO URL^DVBABURL(.RTN,WHICH)
+14 IF RTN'=""
WRITE !,"The AMIS 290 Report is no longer available here.",!," Please go to: ",RTN
QUIT
+15 NEW DVBAPRTY,DVBAEXMP,DVBAP
+16 SET UPDATE="N"
SET HD="AMIS 290 REPORT"
IF '$DATA(DT)
SET X="T"
DO ^%DT
SET DT=Y
+17 SET DVBCDT(0)=$$FMTE^XLFDT(DT,"5DZ")
+18 DO HOME^%ZIS
SET FF=IOF
+19 ;prompt for priority of exam
+20 SET DVBAPRTY=$$EXMPRTY^DVBCIUTL("Select the Priority of Exam for the AMIS 290 Report")
+21 ;quit if no priority of exam selected
if ('(DVBAPRTY?.A)!(DVBAPRTY']""))
GOTO EXIT
+22 ;
INIT ;initialize counter arrays
+1 SET DVBAEXMP=$SELECT($GET(DVBAPRTY)["BDD":"BDD,QS",($GET(DVBAPRTY)["IDES"):"IDES",($GET(DVBAPRTY)["AO"):"AO",1:"ALL")
+2 FOR JI="3DAYSCH","30DAYEX","PENDADJ","TRANSIN","TRNRETTO","TRNPNDTO","TRANSOUT","TRNRETFR","TRNPNDFR","INSUFF"
Begin DoDot:1
+3 FOR DVBAP=1:1:$LENGTH(DVBAEXMP,",")
SET TOT($PIECE(DVBAEXMP,",",DVBAP),JI)=0
End DoDot:1
+4 FOR JI="RECEIVED","INCOMPLETE","DAYS","COMPLETED"
Begin DoDot:1
+5 FOR DVBAP=1:1:$LENGTH(DVBAEXMP,",")
SET TOT($PIECE(DVBAEXMP,",",DVBAP),JI)=0
End DoDot:1
+6 FOR JI="P90","P121","P151","P181","P365","P366"
Begin DoDot:1
+7 FOR DVBAP=1:1:$LENGTH(DVBAEXMP,",")
SET TOT($PIECE(DVBAEXMP,",",DVBAP),JI)=0
End DoDot:1
+8 ;
EN WRITE @IOF,!?(IOM-$LENGTH(HD)\2),HD,!!!
+1 SET %DT(0)=-DT
SET %DT="AE"
SET %DT("A")="Enter STARTING DATE: "
DO ^%DT
if Y<0
GOTO EXIT
SET BDATE1=Y
SET BDATE=Y-.1
+2 SET %DT="AE"
SET %DT("A")=" and ENDING DATE: "
DO ^%DT
if Y<0
GOTO EN
SET EDATE1=Y
SET EDATE=Y+.5
+3 IF EDATE1<BDATE1
WRITE *7,!!,"Invalid date sequence - ending date is before starting date.",!!
HANG 3
GOTO EN
ASK0 ;prompt for previous month pending count
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,DVBATXT
+2 SET DIR(0)="N^0:9999:0"
+3 SET DIR("?",1)="Enter the totals for the month previous to the one you are processing."
+4 SET DIR("?")="Must be a number from 0 to 9999."
+5 ;time-out value specified by system
SET DIR("T")=DTIME
+6 WRITE !!
+7 ;get previous month pending count for each priority of exam to run
+8 FOR DVBAP=1:1:$LENGTH(DVBAEXMP,",")
if ($GET(DIRUT)!($GET(DIROUT)))
QUIT
Begin DoDot:1
+9 SET DVBATXT=$$GPTYPE($PIECE(DVBAEXMP,",",DVBAP))
+10 SET DIR("A",1)="Please enter the total pending, "_DVBATXT
+11 SET DIR("A")=" exam priorities, from the previous month"
+12 DO ^DIR
+13 if $LENGTH(DVBAEXMP,",")=1
SET PREVMO=$GET(Y)
+14 if $LENGTH(DVBAEXMP,",")>1
SET PREVMO($PIECE(DVBAEXMP,",",DVBAP))=$GET(Y)
End DoDot:1
+15 ;user timed/exited out
if ($GET(DIRUT)!($GET(DIROUT)))
GOTO EXIT
+16 ;
ASK KILL %DT
SET SBULL="Y"
+1 WRITE !!!,"Do you want to send a bulletin when processing is done"
+2 SET %=1
DO YN^DICN
if $DATA(DTOUT)!(%<0)
GOTO EXIT
+3 IF %=0
WRITE !!,"Enter Y to send a bulletin to selected recipients or N not to send it at all.",!!
GOTO ASK
+4 IF %'=1
SET SBULL="N"
+5 IF SBULL="Y"
DO BULL^DVBCAMI3
+6 WRITE !
SET %ZIS="AEQ"
SET %ZIS("A")="Output device: "
DO ^%ZIS
if POP
GOTO EXIT
+7 IF $DATA(IO("Q"))
SET ZTRTN="GO^DVBCAMI2"
SET ZTDESC="2507 Amis Report"
SET ZTIO=ION
FOR I="PREVMO*","RO*","BDATE*","TOT*","EDATE*","SBULL","DUZ","DVBCDT(0)","XM*","DVBAPRTY"
SET ZTSAVE(I)=""
+8 IF $DATA(IO("Q"))
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !!,"Request queued",!!
HANG 1
KILL ZTSK
GOTO EXIT
+9 GOTO GO^DVBCAMI2
+10 ;
EXIT KILL PREVMO,UPDATE
GOTO KILL^DVBCUTIL
+1 ;
+2 ;
+3 ;Input : DVBACDE - Code to get description for
+4 ; [BDD,QS,IDES,AO]
+5 ;Ouput : Corresponding description for code
GPTYPE(DVBACDE) ;get exam priority desc
+1 NEW DVBATXT
+2 if ($GET(DVBACDE)']"")
QUIT ""
+3 SET DVBATXT=$SELECT(DVBACDE="BDD":"'Benefits Delivery at Discharge ("_DVBACDE_")'",1:"")
+4 if (DVBATXT']"")
SET DVBATXT=$SELECT(DVBACDE="QS":"'Quick Start ("_DVBACDE_")'",1:"")
+5 if (DVBATXT']"")
SET DVBATXT=$SELECT(DVBACDE="IDES":"'Integrated Disability Evaluation System ("_DVBACDE_")'",1:"")
+6 if (DVBATXT']"")
SET DVBATXT=$SELECT(DVBACDE="AO":"'Agent Orange ("_DVBACDE_")'",1:"")
+7 if (DVBATXT']"")
SET DVBATXT=$SELECT(DVBACDE="ALL":"excluding BDD,QS,IDES and AO",1:"")
+8 QUIT DVBATXT
