source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCXFRD.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1DVBCXFRD ;ALB/GTS-557/THM-MISCELLANOUS TRANSFER BULLETINS ; 4/17/91 10:59 AM
2 ;;2.7;AMIE;**18**;Apr 10, 1995
3 ;
4BULL1 S FREAS="Addition of C&P request record at target site failed." K MCP D PAR Q
5 ;
6BULL2 ; ** Adding exams failed & request deleted **
7 N FREAS,FREAS1
8 S FREAS="Addition of C&P exams for request record at target site failed."
9 S FREAS1="Therefore, the C&P request record was deleted."
10 K MCP D PAR
11 Q
12 ;
13BULL3 S FREAS="Addition of veteran in Patient file at target site failed." K MCP,DVBCNEW D PAR Q
14 ;
15BULL4 S FREAS="Missing C&P request for transfer in - pointer="_REQDA_".",MCP=1 D PAR Q
16 ;
17BULL5 S FREAS="Missing C&P exams for transfer in",MCP=1 D PAR Q
18 ;
19BULL6 S FREAS="Local unload of MailMan message failed." K MCP D PAR Q
20 ;
21BULL7 ; ** Bulletin for failed address edit **
22 S FREAS="Edit of veteran address in patient file at target site failed."
23 K MCP D PAR
24 Q
25 ;
26BULL8 ; ** Target site has no primary division **
27 N FREAS,FREAS1
28 S FREAS="Addition of C&P request record at target site failed."
29 S FREAS1="Could not determine primary medical center division."
30 D PAR
31 Q
32 ;
33BULL9 ; ** Duplicate SSNs exist or other problem in file #2 **
34 N ERR,FREAS,FREAS1
35 S FREAS="Update of patient data at target site failed."
36 ;if duplicate ssn, then send in error msg
37 I $D(DVBCERR("DIERR","E",299)) D
38 .S ERR=$O(DVBCERR("DIERR","E",299,0)) I ERR S FREAS1=DVBCERR("DIERR",ERR,"TEXT",1)
39 ;if other problem, then just send the first error msg available
40 I '$D(DVBCERR("DIERR","E",299)) D
41 .S FREAS1=DVBCERR("DIERR",1,"TEXT",1)
42 D PAR
43 Q
44 ;
45BULL10 ; ** Same SSN but possibly different patient in file #2 **
46 N FREAS,FREAS1,FREAS2,FREAS3
47 S FREAS="Update of patient data at target site failed for SSN "_SSN_"."
48 ;if error returned from fm, just send the first error msg available
49 I $D(DVBCERR("DIERR")) S FREAS1=DVBCERR("DIERR",1,"TEXT",1)
50 ;if name or dob didn't match, then send back that info
51 I $D(DVBCERR(1)) S FREAS1=DVBCERR(1),FREAS2="At target site --",FREAS3=DVBCERR(2)
52 D PAR
53 Q
54 ;
55BULL11 ; ** Regional office station# doesn't exist or not unique **
56 N FREAS,FREAS1,FREAS2
57 S FREAS="Addition of C&P request record at target site failed."
58 I RO="" S FREAS1="Your Regional Office station # ("_RONAM_") is not unique"
59 I RO=0 S FREAS1="Your Regional Office station # ("_RONAM_") could not be found"
60 S FREAS2="in the Institution file of the target site."
61 D PAR
62 Q
63 ;
64PAR K ^TMP("DVBC","BULL",$J) S XMSUB="C&P Request Transfer 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)="" G PAR1
65 S XMY(USER_"@"_SITE1)=SITE
66 ;
67PAR1 S XMY(XMDUZ)="",L=1,^TMP("DVBC","BULL",$J,L,0)="The transfer of a C&P request "_$S($D(MCP):"from ",1:"to ")_$P(^DVB(396.1,1,0),U,1),L=L+1
68 K MCP S ^TMP("DVBC","BULL",$J,L,0)="for the following veteran has failed:",L=L+1
69 S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
70 S ^TMP("DVBC","BULL",$J,L,0)=" Name: "_PNAM_" SSN: "_SSN_" "_"C-Number: "_CNUM,L=L+1
71 S Y=DOB X ^DD("DD") S DOB2=Y
72 S ^TMP("DVBC","BULL",$J,L,0)=" DOB: "_DOB2,L=L+1
73 S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
74 S ^TMP("DVBC","BULL",$J,L,0)="Reason for failure: ",L=L+1
75 S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
76 S ^TMP("DVBC","BULL",$J,L,0)=" "_FREAS,L=L+1
77 I $D(FREAS1) S ^TMP("DVBC","BULL",$J,L,0)=" "_FREAS1,L=L+1
78 I $D(FREAS2) S ^TMP("DVBC","BULL",$J,L,0)=" "_FREAS2,L=L+1
79 I $D(FREAS3) S ^TMP("DVBC","BULL",$J,L,0)=" "_FREAS3,L=L+1
80 S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
81 S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
82 S ^TMP("DVBC","BULL",$J,L,0)="Original sender: "_USER_" at "_SITE1,L=L+1
83 S ^TMP("DVBC","BULL",$J,L,0)=" ",L=L+1
84 D ^XMD
85 Q
Note: See TracBrowser for help on using the repository browser.