RCCPCSV.m

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 ---RCCPCSV   1852     printed  Mar 13, 2025@20:47:56                                                                                                                                                                                                     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