DVBCBUL1.m

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 ---DVBCBUL1   2435     printed  Apr 09, 2024@20:48:14                                                                                                                                                                                                    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