- 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 Feb 18, 2025@23:20:56 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