source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCBUL1.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 1.8 KB
RevLine 
[613]1DVBCBUL1 ;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 ;
8GO 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 ;
17SEND 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))=""
24XMD D ^XMD K ^TMP("DVBC","BUL1",$J),XMDUZ,DOTS,L,JI,JY,XMY,XMSUB,XMTEXT
25 Q
Note: See TracBrowser for help on using the repository browser.