Routine: DVBCAMIS

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  Apr 23, 2025@17:57:56                                                                                                                                                                                                    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

DVBCAMIS.m