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 ---[H[J[2J[HDVBCAMI3 1851 printed Dec 13, 2024@01:43:27 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
