DVBCBUL1 ;ALB/GTS - 557/THM-SEND EXAM ADD MESSAGE ; 2/7/91 6:56 AM
;;2.7;AMIE;**42,184**;Apr 10, 1995;Build 10
;
K ^TMP("DVBC","BUL1",$J),^TMP("DVBC","CMNT",$J) S DIC="^TMP(""DVBC"",""CMNT"",$J,99,",DWPK=1 W @IOF,!!,"Comments:",!! D EN^DIWE
K DWPK I $O(^TMP("DVBC","CMNT",$J,99,0))]"" S ^TMP("DVBC","BUL1",$J,98,0)=" ",^TMP("DVBC","BUL1",$J,97,0)="==========================< Additional comments >=========================="
F I=0:0 S I=$O(^TMP("DVBC","CMNT",$J,99,I)) Q:I="" S ^TMP("DVBC","BUL1",$J,(I+99),0)=^TMP("DVBC","CMNT",$J,99,I,0)
K ^TMP("DVBC","CMNT",$J) S $P(DOTS,".",45)="."
;
GO S L=1,^TMP("DVBC","BUL1",$J,L,0)="The following veteran had one or more 2507 exams added:",L=L+1
S ^TMP("DVBC","BUL1",$J,L,0)=" ",L=L+1
S ^TMP("DVBC","BUL1",$J,L,0)=" DFN: `"_DFN_$E(" ",1,20-$L(DFN))_"SITE: "_DVBCSITE,L=L+1
S ^TMP("DVBC","BUL1",$J,L,0)=" "
S Y=$P(^DVB(396.3,REQDA,0),U,2) X ^DD("DD") S ^TMP("DVBC","BUL1",$J,L,0)=" Request date: "_Y,L=L+1
S ^TMP("DVBC","BUL1",$J,L,0)=" ",L=L+1
S ^TMP("DVBC","BUL1",$J,L,0)="Note: Scheduling for this request must now be recompleted.",L=L+1
S ^TMP("DVBC","BUL1",$J,L,0)=" A new request copy will be printed tomorrow morning.",L=L+1
;
S ^TMP("DVBC","BUL1",$J,L,0)=" ",L=L+1
S ^TMP("DVBC","BUL1",$J,L,0)="** NOTE: To view the patient using the DFN, paste the DFN number into the **",L=L+1
S ^TMP("DVBC","BUL1",$J,L,0)="** CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to **",L=L+1
S ^TMP("DVBC","BUL1",$J,L,0)="** include the ' (backward-apostrophe) character. **",L=L+1
S ^TMP("DVBC","BUL1",$J,L,0)=" ",L=L+1
S ^TMP("DVBC","BUL1",$J,L,0)="** This is an auto-generated email. Do not respond to this email address. **",L=L+1
;
SEND S $P(^DVB(396.3,REQDA,0),U,6)="" ;reset date sched completed
S MG=$O(^XMB(3.8,"B","DVBA C EXAM ADDED",0)) I MG="" W !!,*7,"Bulletin not sent.",!,"DVBA C EXAM ADDED mail group not found.",!! H 3 Q
F JI=0:0 S JI=$O(^XMB(3.8,MG,1,"B",JI)) Q:JI="" S XMY(JI)=""
S XMY(DUZ)="",XMSUB="Addition of 2507 Exams",XMTEXT="^TMP(""DVBC"",""BUL1"",$J,",XMDUZ=DUZ
I '$D(^VA(200,DUZ,.15)) S XMY(XMDUZ)="" G XMD
I $D(^VA(200,DUZ,.15))&($P(^VA(200,DUZ,.15),"^",1)="") S XMY(XMDUZ)="" G XMD
I $D(^VA(200,DUZ,.15)) S XMY($P(^VA(200,DUZ,.15),"^",1))=""
XMD D ^XMD K ^TMP("DVBC","BUL1",$J),XMDUZ,DOTS,L,JI,JY,XMY,XMSUB,XMTEXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCBUL1 2435 printed Dec 13, 2024@01:43:41 Page 2
DVBCBUL1 ;ALB/GTS - 557/THM-SEND EXAM ADD MESSAGE ; 2/7/91 6:56 AM
+1 ;;2.7;AMIE;**42,184**;Apr 10, 1995;Build 10
+2 ;
+3 KILL ^TMP("DVBC","BUL1",$JOB),^TMP("DVBC","CMNT",$JOB)
SET DIC="^TMP(""DVBC"",""CMNT"",$J,99,"
SET DWPK=1
WRITE @IOF,!!,"Comments:",!!
DO EN^DIWE
+4 KILL DWPK
IF $ORDER(^TMP("DVBC","CMNT",$JOB,99,0))]""
SET ^TMP("DVBC","BUL1",$JOB,98,0)=" "
SET ^TMP("DVBC","BUL1",$JOB,97,0)="==========================< Additional comments >=========================="
+5 FOR I=0:0
SET I=$ORDER(^TMP("DVBC","CMNT",$JOB,99,I))
if I=""
QUIT
SET ^TMP("DVBC","BUL1",$JOB,(I+99),0)=^TMP("DVBC","CMNT",$JOB,99,I,0)
+6 KILL ^TMP("DVBC","CMNT",$JOB)
SET $PIECE(DOTS,".",45)="."
+7 ;
GO SET L=1
SET ^TMP("DVBC","BUL1",$JOB,L,0)="The following veteran had one or more 2507 exams added:"
SET L=L+1
+1 SET ^TMP("DVBC","BUL1",$JOB,L,0)=" "
SET L=L+1
+2 SET ^TMP("DVBC","BUL1",$JOB,L,0)=" DFN: `"_DFN_$EXTRACT(" ",1,20-$LENGTH(DFN))_"SITE: "_DVBCSITE
SET L=L+1
+3 SET ^TMP("DVBC","BUL1",$JOB,L,0)=" "
+4 SET Y=$PIECE(^DVB(396.3,REQDA,0),U,2)
XECUTE ^DD("DD")
SET ^TMP("DVBC","BUL1",$JOB,L,0)=" Request date: "_Y
SET L=L+1
+5 SET ^TMP("DVBC","BUL1",$JOB,L,0)=" "
SET L=L+1
+6 SET ^TMP("DVBC","BUL1",$JOB,L,0)="Note: Scheduling for this request must now be recompleted."
SET L=L+1
+7 SET ^TMP("DVBC","BUL1",$JOB,L,0)=" A new request copy will be printed tomorrow morning."
SET L=L+1
+8 ;
+9 SET ^TMP("DVBC","BUL1",$JOB,L,0)=" "
SET L=L+1
+10 SET ^TMP("DVBC","BUL1",$JOB,L,0)="** NOTE: To view the patient using the DFN, paste the DFN number into the **"
SET L=L+1
+11 SET ^TMP("DVBC","BUL1",$JOB,L,0)="** CAPRI Patient Selector 'Patient ID' field to find the patient. Be sure to **"
SET L=L+1
+12 SET ^TMP("DVBC","BUL1",$JOB,L,0)="** include the ' (backward-apostrophe) character. **"
SET L=L+1
+13 SET ^TMP("DVBC","BUL1",$JOB,L,0)=" "
SET L=L+1
+14 SET ^TMP("DVBC","BUL1",$JOB,L,0)="** This is an auto-generated email. Do not respond to this email address. **"
SET L=L+1
+15 ;
SEND ;reset date sched completed
SET $PIECE(^DVB(396.3,REQDA,0),U,6)=""
+1 SET MG=$ORDER(^XMB(3.8,"B","DVBA C EXAM ADDED",0))
IF MG=""
WRITE !!,*7,"Bulletin not sent.",!,"DVBA C EXAM ADDED mail group not found.",!!
HANG 3
QUIT
+2 FOR JI=0:0
SET JI=$ORDER(^XMB(3.8,MG,1,"B",JI))
if JI=""
QUIT
SET XMY(JI)=""
+3 SET XMY(DUZ)=""
SET XMSUB="Addition of 2507 Exams"
SET XMTEXT="^TMP(""DVBC"",""BUL1"",$J,"
SET XMDUZ=DUZ
+4 IF '$DATA(^VA(200,DUZ,.15))
SET XMY(XMDUZ)=""
GOTO XMD
+5 IF $DATA(^VA(200,DUZ,.15))&($PIECE(^VA(200,DUZ,.15),"^",1)="")
SET XMY(XMDUZ)=""
GOTO XMD
+6 IF $DATA(^VA(200,DUZ,.15))
SET XMY($PIECE(^VA(200,DUZ,.15),"^",1))=""
XMD DO ^XMD
KILL ^TMP("DVBC","BUL1",$JOB),XMDUZ,DOTS,L,JI,JY,XMY,XMSUB,XMTEXT
+1 QUIT
