DVBCAMI3.m

DVBCAMI3 ;ALB/GTS-557/THM-HOSPITAL AMIS 290 PRINTING, BULLETIN SEND ; 7/16/91  8:55 AM

 ;;2.7;AMIE;**149,184**;Apr 10, 1995;Build 10

 ;Per VHA Directive 2004-038, this routine should not be modified.

 ;

 ;Input: DVBALRPT - boolean value indicating if this is the last report

 ;       DVBACDE  - Priority of Exam code for report

 ;                   [ALL (Original Report),AO,BDD,QS,IDES]

EN(DVBALRPT,DVBACDE) ;

 U IO D HDR F JI=0.9:0 S JI=$O(^TMP($J,JI)) Q:JI=""  W ^(JI,0),! I IOST?1"C-".E,$Y>19 D PAUSE G:$D(OUT) EXIT D HDR

 D PAUSE I $D(OUT)!(ANS=U) W:SBULL="Y" !!,*7,"Bulletin will NOT be sent!!",*7,! H 2 G EXIT

 S:'$D(XMY) SBULL="N" I SBULL="Y" D SEND

 ;

EXIT ;

 Q:('DVBALRPT)

 D ^%ZISC

 K TFIND,PG,OUT,PREVMO,UPDATE,DTTRET,DTTRIN,DTTROUT,TROUT,XI,XMY

 D:$D(ZTQUEUED) KILL^%ZTLOAD G KILL^DVBCUTIL

 ;

BULL W ! S XMDUZ=DUZ,XMMG=$S($D(^VA(200,DUZ,0)):$P(^(0),U,1),1:"") D DES^XMA21

 Q

 ;

SEND ;send AMIS 290 report in bulletin

 N DVBAXMY M DVBAXMY=XMY

 I IOST'?1"P-",'$D(ZTQUEUED) W !!,"Loading AMIS 290 bulletin ..." H 1

 S XMSUB="AMIS 290 report "_$S((($G(DVBACDE)]"")&($G(DVBACDE)'="ALL")):"("_$G(DVBACDE)_" Exam Priority) ",1:"")_"for "

 S Y=BDATE1 X ^DD("DD") S XMSUB=XMSUB_Y S Y=EDATE1 X ^DD("DD") S XMSUB=XMSUB_" to "_Y,XMTEXT="^TMP($J,"

 D ^XMD K XMTEXT,XMSUB K ^TMP($J),^TMP("DVBC",$J)

 I '$D(ZTQUEUED) W !!,*7,">> Mail message transmitted <<",!! H 2

 M XMY=DVBAXMY  ;restore address list for subsequent bulletins

 Q

 ;

HDR S PG=PG+1 W:(IOST?1"C-".E) @IOF

 W "AMIS 290 Report for "_$$SITE^DVBCUTL4,?(IOM-9),"Page: ",PG,!

 W $$PRHD^DVBCIUTL(DVBACDE),!

 W "For date range: " S Y=BDATE1 X ^DD("DD") W Y W " to " S Y=EDATE1 X ^DD("DD") W Y,!

 F LINE=1:1:80 W "-"

 W !!

 Q

 ;

PAUSE K OUT S ANS="" I IOST?1"C-".E W *7,!!,"Press RETURN to continue or ""^"" to exit  " R ANS:DTIME I '$T!(ANS[U) S OUT=1

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBCAMI3   1851     printed  Mar 13, 2025@20:48:09                                                                                                                                                                                                    Page 2

DVBCAMI3  ;ALB/GTS-557/THM-HOSPITAL AMIS 290 PRINTING, BULLETIN SEND ; 7/16/91  8:55 AM

 +1       ;;2.7;AMIE;**149,184**;Apr 10, 1995;Build 10

 +2       ;Per VHA Directive 2004-038, this routine should not be modified.

 +3       ;

 +4       ;Input: DVBALRPT - boolean value indicating if this is the last report

 +5       ;       DVBACDE  - Priority of Exam code for report

 +6       ;                   [ALL (Original Report),AO,BDD,QS,IDES]

EN(DVBALRPT,DVBACDE) ;

 +1        USE IO

           DO HDR

           FOR JI=0.9:0

               SET JI=$ORDER(^TMP($JOB,JI))

               if JI=""

                   QUIT 

               WRITE ^(JI,0),!

               IF IOST?1"C-".E

                   IF $Y>19

                       DO PAUSE

                       if $DATA(OUT)

                           GOTO EXIT

                       DO HDR

 +2        DO PAUSE

           IF $DATA(OUT)!(ANS=U)

               if SBULL="Y"

                   WRITE !!,*7,"Bulletin will NOT be sent!!",*7,!

               HANG 2

               GOTO EXIT

 +3        if '$DATA(XMY)

               SET SBULL="N"

           IF SBULL="Y"

               DO SEND

 +4       ;

EXIT      ;

 +1        if ('DVBALRPT)

               QUIT 

 +2        DO ^%ZISC

 +3        KILL TFIND,PG,OUT,PREVMO,UPDATE,DTTRET,DTTRIN,DTTROUT,TROUT,XI,XMY

 +4        if $DATA(ZTQUEUED)

               DO KILL^%ZTLOAD

           GOTO KILL^DVBCUTIL

 +5       ;

BULL       WRITE !

           SET XMDUZ=DUZ

           SET XMMG=$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U,1),1:"")

           DO DES^XMA21

 +1        QUIT 

 +2       ;

SEND      ;send AMIS 290 report in bulletin

 +1        NEW DVBAXMY

           MERGE DVBAXMY=XMY

 +2        IF IOST'?1"P-"

               IF '$DATA(ZTQUEUED)

                   WRITE !!,"Loading AMIS 290 bulletin ..."

                   HANG 1

 +3        SET XMSUB="AMIS 290 report "_$SELECT((($GET(DVBACDE)]"")&($GET(DVBACDE)'="ALL")):"("_$GET(DVBACDE)_" Exam Priority) ",1:"")_"for "

 +4        SET Y=BDATE1

           XECUTE ^DD("DD")

           SET XMSUB=XMSUB_Y

           SET Y=EDATE1

           XECUTE ^DD("DD")

           SET XMSUB=XMSUB_" to "_Y

           SET XMTEXT="^TMP($J,"

 +5        DO ^XMD

           KILL XMTEXT,XMSUB

           KILL ^TMP($JOB),^TMP("DVBC",$JOB)

 +6        IF '$DATA(ZTQUEUED)

               WRITE !!,*7,">> Mail message transmitted <<",!!

               HANG 2

 +7       ;restore address list for subsequent bulletins

           MERGE XMY=DVBAXMY

 +8        QUIT 

 +9       ;

HDR        SET PG=PG+1

           if (IOST?1"C-".E)

               WRITE @IOF

 +1        WRITE "AMIS 290 Report for "_$$SITE^DVBCUTL4,?(IOM-9),"Page: ",PG,!

 +2        WRITE $$PRHD^DVBCIUTL(DVBACDE),!

 +3        WRITE "For date range: "

           SET Y=BDATE1

           XECUTE ^DD("DD")

           WRITE Y

           WRITE " to "

           SET Y=EDATE1

           XECUTE ^DD("DD")

           WRITE Y,!

 +4        FOR LINE=1:1:80

               WRITE "-"

 +5        WRITE !!

 +6        QUIT 

 +7       ;

PAUSE      KILL OUT

           SET ANS=""

           IF IOST?1"C-".E

               WRITE *7,!!,"Press RETURN to continue or ""^"" to exit  "

               READ ANS:DTIME

               IF '$TEST!(ANS[U)

                   SET OUT=1

 +1        QUIT