1 | DVBCBUL1 ;ALB/GTS-557/THM-SEND EXAM ADD MESSAGE ; 2/7/91 6:56 AM
|
---|
2 | ;;2.7;AMIE;**42**;Apr 10, 1995
|
---|
3 | K ^TMP("DVBC","BUL1",$J),^TMP("DVBC","CMNT",$J) S DIC="^TMP(""DVBC"",""CMNT"",$J,99,",DWPK=1 W @IOF,!!,"Comments:",!! D EN^DIWE
|
---|
4 | 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 >=========================="
|
---|
5 | 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)
|
---|
6 | K ^TMP("DVBC","CMNT",$J) S $P(DOTS,".",45)="."
|
---|
7 | ;
|
---|
8 | GO S L=1,^TMP("DVBC","BUL1",$J,L,0)="The following veteran had one or more 2507 exams added:",L=L+1
|
---|
9 | S ^TMP("DVBC","BUL1",$J,L,0)=" ",L=L+1
|
---|
10 | S ^TMP("DVBC","BUL1",$J,L,0)=" Name: "_PNAM_" SSN: "_"XXXXX"_$E(SSN,6,9)_" "_"C-Number: "_CNUM,L=L+1
|
---|
11 | S ^TMP("DVBC","BUL1",$J,L,0)=" "
|
---|
12 | 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
|
---|
13 | S ^TMP("DVBC","BUL1",$J,L,0)=" ",L=L+1
|
---|
14 | S ^TMP("DVBC","BUL1",$J,L,0)="Note: Scheduling for this request must now be recompleted.",L=L+1,^TMP("DVBC","BUL1",$J,L,0)=" A new request copy will be printed tomorrow morning.",L=L+1
|
---|
15 | S ^TMP("DVBC","BUL1",$J,L,0)=" ",L=L+1
|
---|
16 | ;
|
---|
17 | SEND S $P(^DVB(396.3,REQDA,0),U,6)="" ;reset date sched completed
|
---|
18 | 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
|
---|
19 | F JI=0:0 S JI=$O(^XMB(3.8,MG,1,"B",JI)) Q:JI="" S XMY(JI)=""
|
---|
20 | S XMY(DUZ)="",XMSUB="Addition of 2507 Exams",XMTEXT="^TMP(""DVBC"",""BUL1"",$J,",XMDUZ=DUZ
|
---|
21 | I '$D(^VA(200,DUZ,.15)) S XMY(XMDUZ)="" G XMD
|
---|
22 | I $D(^VA(200,DUZ,.15))&($P(^VA(200,DUZ,.15),"^",1)="") S XMY(XMDUZ)="" G XMD
|
---|
23 | I $D(^VA(200,DUZ,.15)) S XMY($P(^VA(200,DUZ,.15),"^",1))=""
|
---|
24 | XMD D ^XMD K ^TMP("DVBC","BUL1",$J),XMDUZ,DOTS,L,JI,JY,XMY,XMSUB,XMTEXT
|
---|
25 | Q
|
---|