| 1 | RCCPCSV ;WASH-ISC@ALTOONA,PA/LDB-Receive and Process CCPC messages ;1/6/97 11:36 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**34,70,87**;Mar 20, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ;INPUT FROM MESSAGE
|
|---|
| 6 | RREC ;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 | ;
|
|---|
| 30 | SEG 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 | ;
|
|---|
| 36 | ERROR ;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 | ;
|
|---|
| 49 | IS ;INVALID STATEMENT
|
|---|
| 50 | D IS^RCCPCSV1
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | PA ;STATEMENT ACKNOWLEDGEMENT
|
|---|
| 54 | D PA^RCCPCSV1
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | IT ;INVALID TRANSMISSION
|
|---|
| 58 | D IT^RCCPCSV1
|
|---|
| 59 | Q
|
|---|
| 60 | ;
|
|---|
| 61 | ERRMSG ;ERROR MESSAGE
|
|---|
| 62 | S LN=LN+1,^TMP($J,"ERR",LN)=ERR
|
|---|
| 63 | Q
|
|---|
