source: FOIAVistA/trunk/r/ACCOUNTS_RECEIVABLE-PRCA-PRY-RC/RCCPCSV.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1RCCPCSV ;WASH-ISC@ALTOONA,PA/LDB-Receive and Process CCPC messages ;1/6/97 11:36 AM
2V ;;4.5;Accounts Receivable;**34,70,87**;Mar 20, 1995
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ;INPUT FROM MESSAGE
6RREC ;READ INCOMING MESSAGE
7 N DAT,DEB,END,ERR,ERROR,EVN,KEY,LABEL,LN,MSG,P,RCMSG,RCTR,RCX,RCX1,RE,SBAL,STOT,TR,TR0,TR1,TXT
8 K ^TMP($J)
9 S (LN,MSG,RCX,RE)=0
10 S TXT=0 F X XMREC Q:XMER<0!(XMRG="") S TXT=TXT+1,^TMP($J,"MSG",TXT)=XMRG
11 S DA(1)=""
12 S TXT=1 F S TXT=$O(^TMP($J,"MSG",TXT)) Q:'TXT D
13 .S:^TMP($J,"MSG",TXT)?1"PA^".E DA(1)=4 S:^TMP($J,"MSG",TXT)?1"IS".E DA(1)=3
14 .I $G(XMZ)=""!('DA(1)) Q
15 .S RCX=RCX+1
16 .I "PAISADID"[$E(^TMP($J,"MSG",TXT),1,2) S ^RCT(349.1,DA(1),5,+$G(XMZ)_RCX,0)=$P(^TMP($J,"MSG",TXT),"^",1,3)
17 K DA(1)
18 D SEG,KILL^XM
19 I $O(^TMP($J,"ERR",0)) D
20 .S XMSUB="CCPC ERROR MESSAGE TO STATION"
21 .S XMDUZ="AR PACKAGE"
22 .S XMTEXT="^TMP($J,"_"""ERR"","
23 .I $O(^XMB(3.8,"B","RCCPC STATEMENTS",0)) S XMY("G.RCCPC STATEMENTS")=""
24 .D ^XMD
25 .K ^TMP($J)
26 .D:$G(RE)="R" ^RCCPCML
27 E S XMZ=XQMSG,XMSER="S."_XQSOP D REMSBMSG^XMA1C
28 Q
29 ;
30SEG S RCMSG=1 S RCMSG=$O(^TMP($J,"MSG",RCMSG)) D
31 .S RCTR=^TMP($J,"MSG",RCMSG)
32 .S LABEL=$S(($P(RCTR,"^")]"")&($T(@($P(RCTR,"^")))]""):$P(RCTR,"^"),1:"ERROR")
33 .D @(LABEL)
34 Q
35 ;
36ERROR ;SEND ERROR MESSAGE TO MAIL GROUP
37 ;
38 S ERR="CCPC ERROR - CANNOT READ MESSAGE FROM CCPC" D ERRMSG
39 S ERR="An error has occurred in reading a message from the CCPC."
40 D ERRMSG
41 S ERR="Please contact your IRM for assistance."
42 D ERRMSG
43 S ERR="The MESSAGE WAS AS FOLLOWS:"
44 D ERRMSG
45 S ERR=^TMP($J,"MSG",RCMSG)
46 D ERRMSG
47 Q
48 ;
49IS ;INVALID STATEMENT
50 D IS^RCCPCSV1
51 Q
52 ;
53PA ;STATEMENT ACKNOWLEDGEMENT
54 D PA^RCCPCSV1
55 Q
56 ;
57IT ;INVALID TRANSMISSION
58 D IT^RCCPCSV1
59 Q
60 ;
61ERRMSG ;ERROR MESSAGE
62 S LN=LN+1,^TMP($J,"ERR",LN)=ERR
63 Q
Note: See TracBrowser for help on using the repository browser.