DVBCXFRD ;ALB/GTS-557/THM-MISCELLANOUS TRANSFER BULLETINS ; 4/17/91 10:59 AM
;;2.7;AMIE;**18,193**;Apr 10, 1995;Build 84
;
BULL1 S FREAS="Addition of C&P request record at target site failed." K MCP D PAR Q
;
BULL2 ; ** Adding exams failed & request deleted **
N FREAS,FREAS1
S FREAS="Addition of C&P exams for request record at target site failed."
S FREAS1="Therefore, the C&P request record was deleted."
K MCP D PAR
Q
;
BULL3 ; ** Bulletin for creating New Patient record failed
N FREAS,FREAS1
S FREAS="Addition of veteran in Patient file at target site failed. "
S FREAS1=$P($G(RET(1)),"^",2)
K MCP,DVBCNEW D PAR
Q
;
BULL4 S FREAS="Missing C&P request for transfer in - pointer="_REQDA_".",MCP=1 D PAR Q
;
BULL5 S FREAS="Missing C&P exams for transfer in",MCP=1 D PAR Q
;
BULL6 S FREAS="Local unload of MailMan message failed." K MCP D PAR Q
;
BULL7 ; ** Bulletin for failed address edit **
S FREAS="Edit of veteran address in patient file at target site failed."
K MCP D PAR
Q
;
BULL8 ; ** Target site has no primary division **
N FREAS,FREAS1
S FREAS="Addition of C&P request record at target site failed."
S FREAS1="Could not determine primary medical center division."
D PAR
Q
;
BULL9 ; ** Duplicate SSNs exist or other problem in file #2 **
N ERR,FREAS,FREAS1
S FREAS="Update of patient data at target site failed."
;if duplicate ssn, then send in error msg
I $D(DVBCERR("DIERR","E",299)) D
.S ERR=$O(DVBCERR("DIERR","E",299,0)) I ERR S FREAS1=DVBCERR("DIERR",ERR,"TEXT",1)
;if other problem, then just send the first error msg available
I '$D(DVBCERR("DIERR","E",299)) D
.S FREAS1=DVBCERR("DIERR",1,"TEXT",1)
D PAR
Q
;
BULL10 ; ** Same SSN but possibly different patient in file #2 **
N FREAS,FREAS1,FREAS2,FREAS3
S FREAS="Update of patient data at target site failed for SSN "_SSN_"."
;if error returned from fm, just send the first error msg available
I $D(DVBCERR("DIERR")) S FREAS1=DVBCERR("DIERR",1,"TEXT",1)
;if name or dob didn't match, then send back that info
I $D(DVBCERR(1)) S FREAS1=DVBCERR(1),FREAS2="At target site --",FREAS3=DVBCERR(2)
D PAR
Q
;
BULL11 ; ** Regional office station# doesn't exist or not unique **
N FREAS,FREAS1,FREAS2
S FREAS="Addition of C&P request record at target site failed."
I RO="" S FREAS1="Your Regional Office station # ("_RONAM_") is not unique"
I RO=0 S FREAS1="Your Regional Office station # ("_RONAM_") could not be found"
S FREAS2="in the Institution file of the target site."
D PAR
Q
;
PAR K ^TMP("DVBC","BULL",$J)
S XMSUB="C&P Request Reroute Failure",XMDUZ=.5,XMTEXT="^TMP(""DVBC"",""BULL"",$J,",L=0
I $D(MCP) S USR=$S($D(^DVB(396.3,REQDA,4)):$P(^(4),U,2),1:0) I USR>0 S XMY(USR)="" D PAR1
S XMY("G.DVBA C 2507 REROUTE")=SITE
;
PAR1 S XMY(XMDUZ)="",L=1,^TMP("DVBC","BULL",$J,L,0)="The reroute of a C&P request "_$S($D(MCP):"from ",1:"to ")_$P(^DVB(396.1,1,0),U,1),L=L+1
K MCP S ^TMP("DVBC","BULL",$J,L,0)="for the following veteran has failed:",L=L+1
S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
S ^TMP("DVBC","BULL",$J,L,0)=" Name: "_PNAM_" SSN: "_SSN_" "_"C-Number: "_CNUM,L=L+1
S Y=DOB X ^DD("DD") S DOB2=Y
S ^TMP("DVBC","BULL",$J,L,0)=" DOB: "_DOB2,L=L+1
S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
S ^TMP("DVBC","BULL",$J,L,0)="Reason for failure: ",L=L+1
S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
S ^TMP("DVBC","BULL",$J,L,0)=" "_FREAS,L=L+1
I $D(FREAS1) S ^TMP("DVBC","BULL",$J,L,0)=" "_FREAS1,L=L+1
I $D(FREAS2) S ^TMP("DVBC","BULL",$J,L,0)=" "_FREAS2,L=L+1
I $D(FREAS3) S ^TMP("DVBC","BULL",$J,L,0)=" "_FREAS3,L=L+1
S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
S ^TMP("DVBC","BULL",$J,L,0)="Original sender: "_USER_" at "_SITE1,L=L+1
S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCXFRD 3872 printed Dec 13, 2024@01:54:30 Page 2
DVBCXFRD ;ALB/GTS-557/THM-MISCELLANOUS TRANSFER BULLETINS ; 4/17/91 10:59 AM
+1 ;;2.7;AMIE;**18,193**;Apr 10, 1995;Build 84
+2 ;
BULL1 SET FREAS="Addition of C&P request record at target site failed."
KILL MCP
DO PAR
QUIT
+1 ;
BULL2 ; ** Adding exams failed & request deleted **
+1 NEW FREAS,FREAS1
+2 SET FREAS="Addition of C&P exams for request record at target site failed."
+3 SET FREAS1="Therefore, the C&P request record was deleted."
+4 KILL MCP
DO PAR
+5 QUIT
+6 ;
BULL3 ; ** Bulletin for creating New Patient record failed
+1 NEW FREAS,FREAS1
+2 SET FREAS="Addition of veteran in Patient file at target site failed. "
+3 SET FREAS1=$PIECE($GET(RET(1)),"^",2)
+4 KILL MCP,DVBCNEW
DO PAR
+5 QUIT
+6 ;
BULL4 SET FREAS="Missing C&P request for transfer in - pointer="_REQDA_"."
SET MCP=1
DO PAR
QUIT
+1 ;
BULL5 SET FREAS="Missing C&P exams for transfer in"
SET MCP=1
DO PAR
QUIT
+1 ;
BULL6 SET FREAS="Local unload of MailMan message failed."
KILL MCP
DO PAR
QUIT
+1 ;
BULL7 ; ** Bulletin for failed address edit **
+1 SET FREAS="Edit of veteran address in patient file at target site failed."
+2 KILL MCP
DO PAR
+3 QUIT
+4 ;
BULL8 ; ** Target site has no primary division **
+1 NEW FREAS,FREAS1
+2 SET FREAS="Addition of C&P request record at target site failed."
+3 SET FREAS1="Could not determine primary medical center division."
+4 DO PAR
+5 QUIT
+6 ;
BULL9 ; ** Duplicate SSNs exist or other problem in file #2 **
+1 NEW ERR,FREAS,FREAS1
+2 SET FREAS="Update of patient data at target site failed."
+3 ;if duplicate ssn, then send in error msg
+4 IF $DATA(DVBCERR("DIERR","E",299))
Begin DoDot:1
+5 SET ERR=$ORDER(DVBCERR("DIERR","E",299,0))
IF ERR
SET FREAS1=DVBCERR("DIERR",ERR,"TEXT",1)
End DoDot:1
+6 ;if other problem, then just send the first error msg available
+7 IF '$DATA(DVBCERR("DIERR","E",299))
Begin DoDot:1
+8 SET FREAS1=DVBCERR("DIERR",1,"TEXT",1)
End DoDot:1
+9 DO PAR
+10 QUIT
+11 ;
BULL10 ; ** Same SSN but possibly different patient in file #2 **
+1 NEW FREAS,FREAS1,FREAS2,FREAS3
+2 SET FREAS="Update of patient data at target site failed for SSN "_SSN_"."
+3 ;if error returned from fm, just send the first error msg available
+4 IF $DATA(DVBCERR("DIERR"))
SET FREAS1=DVBCERR("DIERR",1,"TEXT",1)
+5 ;if name or dob didn't match, then send back that info
+6 IF $DATA(DVBCERR(1))
SET FREAS1=DVBCERR(1)
SET FREAS2="At target site --"
SET FREAS3=DVBCERR(2)
+7 DO PAR
+8 QUIT
+9 ;
BULL11 ; ** Regional office station# doesn't exist or not unique **
+1 NEW FREAS,FREAS1,FREAS2
+2 SET FREAS="Addition of C&P request record at target site failed."
+3 IF RO=""
SET FREAS1="Your Regional Office station # ("_RONAM_") is not unique"
+4 IF RO=0
SET FREAS1="Your Regional Office station # ("_RONAM_") could not be found"
+5 SET FREAS2="in the Institution file of the target site."
+6 DO PAR
+7 QUIT
+8 ;
PAR KILL ^TMP("DVBC","BULL",$JOB)
+1 SET XMSUB="C&P Request Reroute Failure"
SET XMDUZ=.5
SET XMTEXT="^TMP(""DVBC"",""BULL"",$J,"
SET L=0
+2 IF $DATA(MCP)
SET USR=$SELECT($DATA(^DVB(396.3,REQDA,4)):$PIECE(^(4),U,2),1:0)
IF USR>0
SET XMY(USR)=""
DO PAR1
+3 SET XMY("G.DVBA C 2507 REROUTE")=SITE
+4 ;
PAR1 SET XMY(XMDUZ)=""
SET L=1
SET ^TMP("DVBC","BULL",$JOB,L,0)="The reroute of a C&P request "_$SELECT($DATA(MCP):"from ",1:"to ")_$PIECE(^DVB(396.1,1,0),U,1)
SET L=L+1
+1 KILL MCP
SET ^TMP("DVBC","BULL",$JOB,L,0)="for the following veteran has failed:"
SET L=L+1
+2 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
SET L=L+1
+3 SET ^TMP("DVBC","BULL",$JOB,L,0)=" Name: "_PNAM_" SSN: "_SSN_" "_"C-Number: "_CNUM
SET L=L+1
+4 SET Y=DOB
XECUTE ^DD("DD")
SET DOB2=Y
+5 SET ^TMP("DVBC","BULL",$JOB,L,0)=" DOB: "_DOB2
SET L=L+1
+6 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
SET L=L+1
+7 SET ^TMP("DVBC","BULL",$JOB,L,0)="Reason for failure: "
SET L=L+1
+8 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
SET L=L+1
+9 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "_FREAS
SET L=L+1
+10 IF $DATA(FREAS1)
SET ^TMP("DVBC","BULL",$JOB,L,0)=" "_FREAS1
SET L=L+1
+11 IF $DATA(FREAS2)
SET ^TMP("DVBC","BULL",$JOB,L,0)=" "_FREAS2
SET L=L+1
+12 IF $DATA(FREAS3)
SET ^TMP("DVBC","BULL",$JOB,L,0)=" "_FREAS3
SET L=L+1
+13 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
SET L=L+1
+14 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
SET L=L+1
+15 SET ^TMP("DVBC","BULL",$JOB,L,0)="Original sender: "_USER_" at "_SITE1
SET L=L+1
+16 SET ^TMP("DVBC","BULL",$JOB,L,0)=" "
SET L=L+1
+17 DO ^XMD
+18 QUIT
