RCCPCSV ;WASH-ISC@ALTOONA,PA/LDB-Receive and Process CCPC messages ;1/6/97 11:36 AM
V ;;4.5;Accounts Receivable;**34,70,87**;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
EN ;INPUT FROM MESSAGE
RREC ;READ INCOMING MESSAGE
N DAT,DEB,END,ERR,ERROR,EVN,KEY,LABEL,LN,MSG,P,RCMSG,RCTR,RCX,RCX1,RE,SBAL,STOT,TR,TR0,TR1,TXT
K ^TMP($J)
S (LN,MSG,RCX,RE)=0
S TXT=0 F X XMREC Q:XMER<0!(XMRG="") S TXT=TXT+1,^TMP($J,"MSG",TXT)=XMRG
S DA(1)=""
S TXT=1 F S TXT=$O(^TMP($J,"MSG",TXT)) Q:'TXT D
.S:^TMP($J,"MSG",TXT)?1"PA^".E DA(1)=4 S:^TMP($J,"MSG",TXT)?1"IS".E DA(1)=3
.I $G(XMZ)=""!('DA(1)) Q
.S RCX=RCX+1
.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)
K DA(1)
D SEG,KILL^XM
I $O(^TMP($J,"ERR",0)) D
.S XMSUB="CCPC ERROR MESSAGE TO STATION"
.S XMDUZ="AR PACKAGE"
.S XMTEXT="^TMP($J,"_"""ERR"","
.I $O(^XMB(3.8,"B","RCCPC STATEMENTS",0)) S XMY("G.RCCPC STATEMENTS")=""
.D ^XMD
.K ^TMP($J)
.D:$G(RE)="R" ^RCCPCML
E S XMZ=XQMSG,XMSER="S."_XQSOP D REMSBMSG^XMA1C
Q
;
SEG S RCMSG=1 S RCMSG=$O(^TMP($J,"MSG",RCMSG)) D
.S RCTR=^TMP($J,"MSG",RCMSG)
.S LABEL=$S(($P(RCTR,"^")]"")&($T(@($P(RCTR,"^")))]""):$P(RCTR,"^"),1:"ERROR")
.D @(LABEL)
Q
;
ERROR ;SEND ERROR MESSAGE TO MAIL GROUP
;
S ERR="CCPC ERROR - CANNOT READ MESSAGE FROM CCPC" D ERRMSG
S ERR="An error has occurred in reading a message from the CCPC."
D ERRMSG
S ERR="Please contact your IRM for assistance."
D ERRMSG
S ERR="The MESSAGE WAS AS FOLLOWS:"
D ERRMSG
S ERR=^TMP($J,"MSG",RCMSG)
D ERRMSG
Q
;
IS ;INVALID STATEMENT
D IS^RCCPCSV1
Q
;
PA ;STATEMENT ACKNOWLEDGEMENT
D PA^RCCPCSV1
Q
;
IT ;INVALID TRANSMISSION
D IT^RCCPCSV1
Q
;
ERRMSG ;ERROR MESSAGE
S LN=LN+1,^TMP($J,"ERR",LN)=ERR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCCPCSV 1852 printed Dec 13, 2024@01:43:16 Page 2
RCCPCSV ;WASH-ISC@ALTOONA,PA/LDB-Receive and Process CCPC messages ;1/6/97 11:36 AM
V ;;4.5;Accounts Receivable;**34,70,87**;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;
EN ;INPUT FROM MESSAGE
RREC ;READ INCOMING MESSAGE
+1 NEW DAT,DEB,END,ERR,ERROR,EVN,KEY,LABEL,LN,MSG,P,RCMSG,RCTR,RCX,RCX1,RE,SBAL,STOT,TR,TR0,TR1,TXT
+2 KILL ^TMP($JOB)
+3 SET (LN,MSG,RCX,RE)=0
+4 SET TXT=0
FOR
XECUTE XMREC
if XMER<0!(XMRG="")
QUIT
SET TXT=TXT+1
SET ^TMP($JOB,"MSG",TXT)=XMRG
+5 SET DA(1)=""
+6 SET TXT=1
FOR
SET TXT=$ORDER(^TMP($JOB,"MSG",TXT))
if 'TXT
QUIT
Begin DoDot:1
+7 if ^TMP($JOB,"MSG",TXT)?1"PA^".E
SET DA(1)=4
if ^TMP($JOB,"MSG",TXT)?1"IS".E
SET DA(1)=3
+8 IF $GET(XMZ)=""!('DA(1))
QUIT
+9 SET RCX=RCX+1
+10 IF "PAISADID"[$EXTRACT(^TMP($JOB,"MSG",TXT),1,2)
SET ^RCT(349.1,DA(1),5,+$GET(XMZ)_RCX,0)=$PIECE(^TMP($JOB,"MSG",TXT),"^",1,3)
End DoDot:1
+11 KILL DA(1)
+12 DO SEG
DO KILL^XM
+13 IF $ORDER(^TMP($JOB,"ERR",0))
Begin DoDot:1
+14 SET XMSUB="CCPC ERROR MESSAGE TO STATION"
+15 SET XMDUZ="AR PACKAGE"
+16 SET XMTEXT="^TMP($J,"_"""ERR"","
+17 IF $ORDER(^XMB(3.8,"B","RCCPC STATEMENTS",0))
SET XMY("G.RCCPC STATEMENTS")=""
+18 DO ^XMD
+19 KILL ^TMP($JOB)
+20 if $GET(RE)="R"
DO ^RCCPCML
End DoDot:1
+21 IF '$TEST
SET XMZ=XQMSG
SET XMSER="S."_XQSOP
DO REMSBMSG^XMA1C
+22 QUIT
+23 ;
SEG SET RCMSG=1
SET RCMSG=$ORDER(^TMP($JOB,"MSG",RCMSG))
Begin DoDot:1
+1 SET RCTR=^TMP($JOB,"MSG",RCMSG)
+2 SET LABEL=$SELECT(($PIECE(RCTR,"^")]"")&($TEXT(@($PIECE(RCTR,"^")))]""):$PIECE(RCTR,"^"),1:"ERROR")
+3 DO @(LABEL)
End DoDot:1
+4 QUIT
+5 ;
ERROR ;SEND ERROR MESSAGE TO MAIL GROUP
+1 ;
+2 SET ERR="CCPC ERROR - CANNOT READ MESSAGE FROM CCPC"
DO ERRMSG
+3 SET ERR="An error has occurred in reading a message from the CCPC."
+4 DO ERRMSG
+5 SET ERR="Please contact your IRM for assistance."
+6 DO ERRMSG
+7 SET ERR="The MESSAGE WAS AS FOLLOWS:"
+8 DO ERRMSG
+9 SET ERR=^TMP($JOB,"MSG",RCMSG)
+10 DO ERRMSG
+11 QUIT
+12 ;
IS ;INVALID STATEMENT
+1 DO IS^RCCPCSV1
+2 QUIT
+3 ;
PA ;STATEMENT ACKNOWLEDGEMENT
+1 DO PA^RCCPCSV1
+2 QUIT
+3 ;
IT ;INVALID TRANSMISSION
+1 DO IT^RCCPCSV1
+2 QUIT
+3 ;
ERRMSG ;ERROR MESSAGE
+1 SET LN=LN+1
SET ^TMP($JOB,"ERR",LN)=ERR
+2 QUIT
