Routine: PRCVRE1

PRCVRE1 ;WOIFO/VC-Transmit HL7 message to IFCAP for requisition received from DynaMed ; 11/3/04 3:13pm ; 5/6/05 3:43pm

 ;;5.1;IFCAP;**81,119**;Oct 20, 2000;Build 8

 ;Per VHA Directive 2004-038, this routine should not be modified

 ;An exemption from the 245 character length standard for a variable

 ;   has been requested from the SACC for reading HL7 segments into

 ;   a single variable.  The limit is request to be 1K and if longer

 ;   than that the system will exit with an Application ACK reject.

 ;   Submitted 4/14/05.

 ;This routine processes messages from DynaMed to IFCAP to build a RIL

 ;HL("MID") - Message Control ID

 ;HL7DT - Today's date in HL7 format

 ;PRCDT - Date value

 ;ORC Segment will repeat for each item

 ;  PRCORD - Order control should be NW for new order - ORC-1

 ;  PRCFCP - Fund control Point - ORC-3

 ;  PRCDATE - Date and time item entered - ORC-9

 ;  PRCEMP - Enter by - ORC-10 DUZ^Lname^Fname^Approving Authority

 ;  PRCCC - Cost Center - ORC-17

 ;  PRCSITE - Site Code should be 516 - ORC-21

 ;RQD Segment will repeat for each item

 ;  PRCCTR - Item counter - RQD-1

 ;  PRCDOC - DynaMed Document number - unique per item - RQD-2

 ;  PRCITM - Item number $p1 of RQD-3

 ;  PRCQTY - Item quantity - RQD-5

 ;  PRCNEED - Date Needed - RQD-10

 ;RQ1 Segment one segment for each RQD segment

 ;  PRCCOST - Estimated Unit Cost - RQ1-1

 ;  PRCBOC -  BOC Number - RQ1-3

 ;  PRCVND - Vendor number - pointer to file 440 - RQ1-4

 ;  PRCNIF - National Item File number - RQ1-5

 ;PRCTYP - Repetitive Item List type - default to blank

 ;Message builds an ^XTMP to pass data to IFCAP RIL build routine.

 ; The first node is "PRCVRE*"+the Message Control ID. The next nodes

 ; are 0,1, and 2. The 0 node is the standard ^XTMP structure plus

 ; $H. The $H is used to measure transmission timing. The 1 node holds

 ; header data common to all detail items being transmitted. The 2

 ; node holds detail information about each item ordered in a counter

 ; sub-node.

 ; Under the 1 and 2 nodes are "ERR" subnodes that hold error

 ; information about each item.  There can be multiple errors

 ; associated with each item, therefore there are multiple sub-nodes

 ; possible under each "ERR" node.

 ;Counters

 ;  PRCCNT, ACKCNT,PRCCC1,PRCFCP1,X,X1,X2,X8,X9,I,II,LL,ERRCNT

 ;ERRCOD - Error code from IFCAP

 ;ERRDAT - Error data from IFCAP

 ;ERRSTR - Error text from IFCAP

 ;ERRSUB - A substring of ERRSTR

 ;ERRS - Error substring from IFCAP

 ;SEVER - Error severity value - W or E

 ;TOT,TOTERR,TOTGOOD,TOTREC - Counters of errors returned to DM

 ;FLDNO - Field identified in an error message

 ;ERRVAL - ERROR FLAG

 ;ERRARY - Message Error array sent to Prosthetics

 ;ERRLOC - Location of error sent in ACK

 ;PRCCS, PRCFS, PRCRS - Field delimiters

 ;PRCNODE - Message segment identifier

 ;Temporary Globals

 ;  ^TMP("PRCVRIL",$J,"ACK") - Acknowledgement is ok

 ;  ^TMP("PRCVRIL",$J,"NAK") - Acknowledgement is not ok

 ;  ^TMP("HLA",$J) - Message array sent to DynaMed

 ;  ^XTMP("PRCVRE*"_Message Control ID,) - Data sent to IFCAP

 ;Temporary variables

 ;   TMP,MSGFLG,X, X1

 ;PRCHD - Array to hold map between HL7 and XTMP for Header info

 ;PRCDET - Array to hold map between HL7 and XTMP for Detail info

 ;PRCVERR - Array to hold error messages for MailMan

 ;PRCSUB - XTMP first node

 ;PRCSUB2 - Second $p of PRCSUB equal to Message Control ID

 ;PRCVRES - Return variable from GENACK - Note:this doesn't work.

 ;PRCVINDX - Index number into XTMP to keep track of number of items

BEGIN N PRCORD,DYNADATE,PRCDATE,PRCEMP,PRCSITE

 N PRCDOC,PRCITM,PRCQTY,PRCFCP,PRCCC

 N PRCCOST,PRCVND,PRCBOC,PRCNEED,PRCNIF

 N PRCSUB,PRCSUB2,PRCDT,PRCVINDX

 N ERRARY,PRCCS,PRCFS,PRCRS,PRCNODE,PRCNODE2

 N ACKCNT,NODE1,NODE2,PRCCTR,PRCCNT,PRCI,PRCJ,MID

 N X,X1,X2,X8,X9,XX,TMP,PRCCC1,PRCFCP1,LENVAL

 ; Fields used in PRCVREA are NEWed and KILLed here

 N MSG,MSGFLG,DOCID,ERRCNT,ERRCOD,ERRDAT,ERRS,ERRSTR,ERRSUB,FLDNO

 N I,IL,ERRTXT,I,II,III,J,SEVER,TOT,TOTERR,TOTGOOD,TOTREC

 N PRCDET,PRCHD,PRCVERR,MYRESULT,ERRLOC,PRCVRES

 D:'$D(U) DT^DICRW

 S PRCDT=$$NOW^XLFDT

 S HL7DT=$$FMTHL7^XLFDT(PRCDT),PRCDT=HL7DT

 S PRCSUB="PRCVRE*"_HL("MID") K ^XTMP(PRCSUB)

 D BUILD

 S PRCCNT=0

 S PRCFS=$G(HL("FS")),PRCCS=$E($G(HL("ECH"))),PRCRS=$E($G(HL("ECH")),2)

 D START

 D CLEANUP

START ;This will read the incoming message from DynaMed and build ^TMP

SETACK ; Set up information for the ACK or NAK

 K ^TMP("PRCVRIL",$J)

 S ^TMP("PRCVRIL",$J,"ACK",1)="MSA"_PRCFS_"AA"_PRCFS_HL("MID")

 S ^TMP("PRCVRIL",$J,"NAK",1)="MSA"_PRCFS_"AE"_PRCFS_HL("MID")

 S ^TMP("PRCVRIL",$J,"NAK",2)="ERR"_PRCFS

 S ACKCNT=2

 ;If this is not the right message quit

 I HL("MTN")'="OMN" D  Q

 .S $P(^TMP("PRCVRIL",$J,"NAK",ACKCNT),PRCFS,2)="Wrong Message Type: "_HL("MTN")

 .D NAKIT^PRCVREA

 I HL("ETN")'="O07" D  Q

 .S $P(^TMP("PRCVRIL",$J,"NAK",ACKCNT),PRCFS,2)="Wrong Event Type: "_HL("ETN")

 .D NAKIT^PRCVREA

 S ERRARY(1)="OK"

 ;Read the message and build the ^TMP global

 K ^TMP("PRCVRE",$J)

 S PRCI=""

 F PRCI=1:1 X HLNEXT Q:HLQUIT'>0  D

 .S ^TMP("PRCVRE",$J,PRCSUB,PRCI)=HLNODE,PRCJ=0

 .F  S PRCJ=$O(HLNODE(PRCJ)) Q:'PRCJ  S ^TMP("PRCVRE",$J,PRCSUB,PRCI,PRCJ)=HLNODE(PRCJ)

 .I $E(HLNODE,1,3)="ORC" D

 ..S PRCFCP=$P(HLNODE,PRCFS,4),PRCCC=$P(HLNODE,PRCFS,18)

 ..S TMP($J,PRCFCP,PRCCC)=""

 ;Validate that there is only one FCP and CC

 S PRCFCP="",PRCFCP1=""

 ; Prevent PRCCC1 undefined   PRC*5.1*119

 S PRCCC1=""

 F X8=1:1 S PRCFCP=$O(TMP($J,PRCFCP)) Q:PRCFCP=""  D

 .S PRCFCP1=X8

 .S PRCCC=""

 .F X9=1:1 S PRCCC=$O(TMP($J,PRCFCP,PRCCC)) Q:PRCCC=""  D

 ..S PRCCC1=X9

 I (PRCFCP1>1)!(PRCCC1>1) D  Q

 .S $P(^TMP("PRCVRIL",$J,"NAK",2),PRCFS,2)="Message contains multiple FCP's or CC's: "_HL("ETN") D NAKIT^PRCVREA

PARSIT ;Read the ^TMP global and build the ^XTMP global to pass to IFCAP

 S PRCI=0,PRCJ=0,LENVAL="OK"

 F  S PRCI=$O(^TMP("PRCVRE",$J,PRCSUB,PRCI)) Q:PRCI=""  Q:LENVAL="NOTOK"  D

 .S NODE1=$G(^TMP("PRCVRE",$J,PRCSUB,PRCI)) Q:NODE1=""

 .F PRCJ=1:1 D  Q:$G(^TMP("PRCVRE",$J,PRCSUB,PRCI,PRCJ))=""

 ..S NODE2=$G(^TMP("PRCVRE",$J,PRCSUB,PRCI,PRCJ))

 ..I $L(NODE1)+$L(NODE2)>1024 S LENVAL="NOTOK" Q

 ..S NODE1=NODE1_NODE2

 .Q:LENVAL="NOTOK"

 .S PRCNODE=$E(NODE1,1,3)

.;

 .; IF MSH segment ignore the record

.;

 .I PRCNODE="MSH" Q

 .S PRCNODE2=$E(NODE1,5,$L(NODE1))

.;

 .; If ORC segment process the record

.;

 .I PRCNODE="ORC" D  Q

 ..I $D(^XTMP(PRCSUB,1))'=0 Q

 ..S PRCORD=$P(PRCNODE2,PRCFS,1),DYNADATE=$P(PRCNODE2,PRCFS,9),PRCEMP=$P($P(PRCNODE2,PRCFS,10),PRCCS,1,3),PRCSITE=$P(PRCNODE2,PRCFS,21)

 ..S PRCFCP=$P(PRCNODE2,PRCFS,3),PRCCC=$P(PRCNODE2,PRCFS,17)

 ..S PRCDATE=$$HL7TFM^XLFDT(DYNADATE)

 ..S $P(^XTMP(PRCSUB,1),U,1)=0

 ..S $P(^XTMP(PRCSUB,1),U,4)=PRCORD,$P(^XTMP(PRCSUB,1),U,5)=PRCSITE

 ..S $P(^XTMP(PRCSUB,1),U,6)=PRCDATE,$P(^XTMP(PRCSUB,1),U,7)=PRCEMP

.;

 .; If RQD segment process the record

.;

 .I PRCNODE="RQD" D  Q

 ..S PRCCTR=$P(PRCNODE2,PRCFS,1)

 ..S PRCDOC=$P(PRCNODE2,PRCFS,2),PRCITM=$P(PRCNODE2,PRCFS,3)

 ..S PRCQTY=$P(PRCNODE2,PRCFS,5),DYNADATE=$P(PRCNODE2,PRCFS,10)

 ..S PRCNEED=$$HL7TFM^XLFDT(DYNADATE)

.;

 .;If RQ1 segment process the record and build the XTMP global record

.;

 .I PRCNODE="RQ1" D  Q

 ..S PRCCOST=$P(PRCNODE2,PRCFS,1),PRCBOC=$P(PRCNODE2,PRCFS,3),PRCVND=$P(PRCNODE2,PRCFS,4),PRCNIF=$P(PRCNODE2,PRCFS,5)

..;

 ..; Now build the XTMP record

..;

 ..S PRCVINDX=$P($G(^XTMP(PRCSUB,1)),U,1)

 ..I PRCCTR>PRCVINDX S $P(^XTMP(PRCSUB,1),U,1)=PRCCTR

 ..S $P(^XTMP(PRCSUB,1),U,2)=PRCFCP

 ..S $P(^XTMP(PRCSUB,1),U,3)=PRCCC

 ..S ^XTMP(PRCSUB,2,PRCCTR)=PRCITM_U_PRCQTY_U_PRCVND_U_PRCCOST_U_PRCNEED_U_PRCDOC_U_PRCNIF_U_PRCBOC

 I LENVAL="NOTOK" D  Q

 .S $P(^TMP("PRCVRIL",$J,"NAK",2),PRCFS,2)="HL7 Segment length greater than 1K"

 .D NAKIT^PRCVREA

 .K ^XTMP(PRCSUB)

 D CALLIT^PRCVREA

BUILD ;Build the ^XTMP global zero node record.

 S XX=$$HTFM^XLFDT($H,1)

 S X1=$$FMADD^XLFDT(XX,5)

 S ^XTMP(PRCSUB,0)=X1_U_XX_"^Transmit message to IFCAP to build the RIL"_U_$H

CLEANUP ;This area will kill all temporary globals and variables

 K ^TMP("PRCVRE",$J),TMP($J)

 K ^TMP("HLA",$J)

 K ^TMP("PRCVRIL",$J)

 K PRCCTR,PRCCNT,PRCORD,DYNADATE,PRCDATE,PRCEMP,PRCSITE,PRCDOC

 K PRCITM,PRCQTY,PRCFCP,PRCCC,PRCNIF,PRCBOC

 K PRCCOST,PRCVND,PRCSUB,PRCSUB2,PRCDT,PRCNEED

 K PRCFS,PRCCS,PRCRS,PRCVINDX

 K ERRARY

 K PRCFS,PRCRS,PRCNODE,PRCNODE2,PRCI,PRCJ

 K ACKCNT,NODE1,NODE2,LENVAL

 K X,X1,X2,X8,X9,XX,TMP,PRCCC1,PRCFCP1

 ;Fields killed here are used in PRCVREA

 K MID,MSG,MSGFLG,MYRESULT,PRCDET,PRCHD,ERRLOC,ERRSUB

 K DOCID,ERRCNT,ERRCOD,ERRDAT,ERRS,ERRSTR,I,II,III,IL,J,ERRTXT,SEVER

 K TOT,TOTERR,TOTGOOD,TOTREC,FLDNO,PRCVERR,PRCVRES

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCVRE1   8803     printed  Feb 18, 2025@23:46:39                                                                                                                                                                                                     Page 2

PRCVRE1   ;WOIFO/VC-Transmit HL7 message to IFCAP for requisition received from DynaMed ; 11/3/04 3:13pm ; 5/6/05 3:43pm

 +1       ;;5.1;IFCAP;**81,119**;Oct 20, 2000;Build 8

 +2       ;Per VHA Directive 2004-038, this routine should not be modified

 +3       ;

 +4       ;An exemption from the 245 character length standard for a variable

 +5       ;   has been requested from the SACC for reading HL7 segments into

 +6       ;   a single variable.  The limit is request to be 1K and if longer

 +7       ;   than that the system will exit with an Application ACK reject.

 +8       ;   Submitted 4/14/05.

 +9       ;

 +10      ;This routine processes messages from DynaMed to IFCAP to build a RIL

 +11      ;

 +12      ;HL("MID") - Message Control ID

 +13      ;HL7DT - Today's date in HL7 format

 +14      ;PRCDT - Date value

 +15      ;ORC Segment will repeat for each item

 +16      ;  PRCORD - Order control should be NW for new order - ORC-1

 +17      ;  PRCFCP - Fund control Point - ORC-3

 +18      ;  PRCDATE - Date and time item entered - ORC-9

 +19      ;  PRCEMP - Enter by - ORC-10 DUZ^Lname^Fname^Approving Authority

 +20      ;  PRCCC - Cost Center - ORC-17

 +21      ;  PRCSITE - Site Code should be 516 - ORC-21

 +22      ;RQD Segment will repeat for each item

 +23      ;  PRCCTR - Item counter - RQD-1

 +24      ;  PRCDOC - DynaMed Document number - unique per item - RQD-2

 +25      ;  PRCITM - Item number $p1 of RQD-3

 +26      ;  PRCQTY - Item quantity - RQD-5

 +27      ;  PRCNEED - Date Needed - RQD-10

 +28      ;RQ1 Segment one segment for each RQD segment

 +29      ;  PRCCOST - Estimated Unit Cost - RQ1-1

 +30      ;  PRCBOC -  BOC Number - RQ1-3

 +31      ;  PRCVND - Vendor number - pointer to file 440 - RQ1-4

 +32      ;  PRCNIF - National Item File number - RQ1-5

 +33      ;PRCTYP - Repetitive Item List type - default to blank

 +34      ;Message builds an ^XTMP to pass data to IFCAP RIL build routine.

 +35      ; The first node is "PRCVRE*"+the Message Control ID. The next nodes

 +36      ; are 0,1, and 2. The 0 node is the standard ^XTMP structure plus

 +37      ; $H. The $H is used to measure transmission timing. The 1 node holds

 +38      ; header data common to all detail items being transmitted. The 2

 +39      ; node holds detail information about each item ordered in a counter

 +40      ; sub-node.

 +41      ; Under the 1 and 2 nodes are "ERR" subnodes that hold error

 +42      ; information about each item.  There can be multiple errors

 +43      ; associated with each item, therefore there are multiple sub-nodes

 +44      ; possible under each "ERR" node.

 +45      ;Counters

 +46      ;  PRCCNT, ACKCNT,PRCCC1,PRCFCP1,X,X1,X2,X8,X9,I,II,LL,ERRCNT

 +47      ;ERRCOD - Error code from IFCAP

 +48      ;ERRDAT - Error data from IFCAP

 +49      ;ERRSTR - Error text from IFCAP

 +50      ;ERRSUB - A substring of ERRSTR

 +51      ;ERRS - Error substring from IFCAP

 +52      ;SEVER - Error severity value - W or E

 +53      ;TOT,TOTERR,TOTGOOD,TOTREC - Counters of errors returned to DM

 +54      ;FLDNO - Field identified in an error message

 +55      ;ERRVAL - ERROR FLAG

 +56      ;ERRARY - Message Error array sent to Prosthetics

 +57      ;ERRLOC - Location of error sent in ACK

 +58      ;PRCCS, PRCFS, PRCRS - Field delimiters

 +59      ;PRCNODE - Message segment identifier

 +60      ;Temporary Globals

 +61      ;  ^TMP("PRCVRIL",$J,"ACK") - Acknowledgement is ok

 +62      ;  ^TMP("PRCVRIL",$J,"NAK") - Acknowledgement is not ok

 +63      ;  ^TMP("HLA",$J) - Message array sent to DynaMed

 +64      ;  ^XTMP("PRCVRE*"_Message Control ID,) - Data sent to IFCAP

 +65      ;Temporary variables

 +66      ;   TMP,MSGFLG,X, X1

 +67      ;PRCHD - Array to hold map between HL7 and XTMP for Header info

 +68      ;PRCDET - Array to hold map between HL7 and XTMP for Detail info

 +69      ;PRCVERR - Array to hold error messages for MailMan

 +70      ;PRCSUB - XTMP first node

 +71      ;PRCSUB2 - Second $p of PRCSUB equal to Message Control ID

 +72      ;PRCVRES - Return variable from GENACK - Note:this doesn't work.

 +73      ;PRCVINDX - Index number into XTMP to keep track of number of items

 +74      ;

 +75       QUIT

 +76      ;

BEGIN      NEW PRCORD,DYNADATE,PRCDATE,PRCEMP,PRCSITE

 +1        NEW PRCDOC,PRCITM,PRCQTY,PRCFCP,PRCCC

 +2        NEW PRCCOST,PRCVND,PRCBOC,PRCNEED,PRCNIF

 +3        NEW PRCSUB,PRCSUB2,PRCDT,PRCVINDX

 +4        NEW ERRARY,PRCCS,PRCFS,PRCRS,PRCNODE,PRCNODE2

 +5        NEW ACKCNT,NODE1,NODE2,PRCCTR,PRCCNT,PRCI,PRCJ,MID

 +6        NEW X,X1,X2,X8,X9,XX,TMP,PRCCC1,PRCFCP1,LENVAL

 +7       ; Fields used in PRCVREA are NEWed and KILLed here

 +8        NEW MSG,MSGFLG,DOCID,ERRCNT,ERRCOD,ERRDAT,ERRS,ERRSTR,ERRSUB,FLDNO

 +9        NEW I,IL,ERRTXT,I,II,III,J,SEVER,TOT,TOTERR,TOTGOOD,TOTREC

 +10       NEW PRCDET,PRCHD,PRCVERR,MYRESULT,ERRLOC,PRCVRES

 +11       if '$DATA(U)

               DO DT^DICRW

 +12       SET PRCDT=$$NOW^XLFDT

 +13       SET HL7DT=$$FMTHL7^XLFDT(PRCDT)

           SET PRCDT=HL7DT

 +14       SET PRCSUB="PRCVRE*"_HL("MID")

           KILL ^XTMP(PRCSUB)

 +15       DO BUILD

 +16       SET PRCCNT=0

 +17       SET PRCFS=$GET(HL("FS"))

           SET PRCCS=$EXTRACT($GET(HL("ECH")))

           SET PRCRS=$EXTRACT($GET(HL("ECH")),2)

 +18       DO START

 +19       DO CLEANUP

 +20       QUIT

 +21      ;

START     ;This will read the incoming message from DynaMed and build ^TMP

 +1       ;

SETACK    ; Set up information for the ACK or NAK

 +1       ;

 +2        KILL ^TMP("PRCVRIL",$JOB)

 +3        SET ^TMP("PRCVRIL",$JOB,"ACK",1)="MSA"_PRCFS_"AA"_PRCFS_HL("MID")

 +4        SET ^TMP("PRCVRIL",$JOB,"NAK",1)="MSA"_PRCFS_"AE"_PRCFS_HL("MID")

 +5        SET ^TMP("PRCVRIL",$JOB,"NAK",2)="ERR"_PRCFS

 +6        SET ACKCNT=2

 +7       ;

 +8       ;If this is not the right message quit

 +9       ;

 +10       IF HL("MTN")'="OMN"

               Begin DoDot:1

 +11               SET $PIECE(^TMP("PRCVRIL",$JOB,"NAK",ACKCNT),PRCFS,2)="Wrong Message Type: "_HL("MTN")

 +12               DO NAKIT^PRCVREA

               End DoDot:1

               QUIT

 +13       IF HL("ETN")'="O07"

               Begin DoDot:1

 +14               SET $PIECE(^TMP("PRCVRIL",$JOB,"NAK",ACKCNT),PRCFS,2)="Wrong Event Type: "_HL("ETN")

 +15               DO NAKIT^PRCVREA

               End DoDot:1

               QUIT

 +16      ;

 +17       SET ERRARY(1)="OK"

 +18      ;

 +19      ;Read the message and build the ^TMP global

 +20      ;

 +21       KILL ^TMP("PRCVRE",$JOB)

 +22       SET PRCI=""

 +23       FOR PRCI=1:1

               XECUTE HLNEXT

               if HLQUIT'>0

                   QUIT

               Begin DoDot:1

 +24               SET ^TMP("PRCVRE",$JOB,PRCSUB,PRCI)=HLNODE

                   SET PRCJ=0

 +25               FOR

                       SET PRCJ=$ORDER(HLNODE(PRCJ))

                       if 'PRCJ

                           QUIT

                       SET ^TMP("PRCVRE",$JOB,PRCSUB,PRCI,PRCJ)=HLNODE(PRCJ)

 +26               IF $EXTRACT(HLNODE,1,3)="ORC"

                       Begin DoDot:2

 +27                       SET PRCFCP=$PIECE(HLNODE,PRCFS,4)

                           SET PRCCC=$PIECE(HLNODE,PRCFS,18)

 +28                       SET TMP($JOB,PRCFCP,PRCCC)=""

                       End DoDot:2

               End DoDot:1

 +29      ;

 +30      ;Validate that there is only one FCP and CC

 +31       SET PRCFCP=""

           SET PRCFCP1=""

 +32      ; Prevent PRCCC1 undefined   PRC*5.1*119

 +33       SET PRCCC1=""

 +34       FOR X8=1:1

               SET PRCFCP=$ORDER(TMP($JOB,PRCFCP))

               if PRCFCP=""

                   QUIT

               Begin DoDot:1

 +35               SET PRCFCP1=X8

 +36               SET PRCCC=""

 +37               FOR X9=1:1

                       SET PRCCC=$ORDER(TMP($JOB,PRCFCP,PRCCC))

                       if PRCCC=""

                           QUIT

                       Begin DoDot:2

 +38                       SET PRCCC1=X9

                       End DoDot:2

               End DoDot:1

 +39       IF (PRCFCP1>1)!(PRCCC1>1)

               Begin DoDot:1

 +40               SET $PIECE(^TMP("PRCVRIL",$JOB,"NAK",2),PRCFS,2)="Message contains multiple FCP's or CC's: "_HL("ETN")

                   DO NAKIT^PRCVREA

               End DoDot:1

               QUIT

 +41      ;

PARSIT    ;Read the ^TMP global and build the ^XTMP global to pass to IFCAP

 +1       ;

 +2        SET PRCI=0

           SET PRCJ=0

           SET LENVAL="OK"

 +3        FOR

               SET PRCI=$ORDER(^TMP("PRCVRE",$JOB,PRCSUB,PRCI))

               if PRCI=""

                   QUIT

               if LENVAL="NOTOK"

                   QUIT

               Begin DoDot:1

 +4                SET NODE1=$GET(^TMP("PRCVRE",$JOB,PRCSUB,PRCI))

                   if NODE1=""

                       QUIT

 +5                FOR PRCJ=1:1

                       Begin DoDot:2

 +6                        SET NODE2=$GET(^TMP("PRCVRE",$JOB,PRCSUB,PRCI,PRCJ))

 +7                        IF $LENGTH(NODE1)+$LENGTH(NODE2)>1024

                               SET LENVAL="NOTOK"

                               QUIT

 +8                        SET NODE1=NODE1_NODE2

                       End DoDot:2

                       if $GET(^TMP("PRCVRE",$JOB,PRCSUB,PRCI,PRCJ))=""

                           QUIT

 +9                if LENVAL="NOTOK"

                       QUIT

 +10               SET PRCNODE=$EXTRACT(NODE1,1,3)

 +11      ;

 +12      ; IF MSH segment ignore the record

 +13      ;

 +14               IF PRCNODE="MSH"

                       QUIT

 +15               SET PRCNODE2=$EXTRACT(NODE1,5,$LENGTH(NODE1))

 +16      ;

 +17      ; If ORC segment process the record

 +18      ;

 +19               IF PRCNODE="ORC"

                       Begin DoDot:2

 +20                       IF $DATA(^XTMP(PRCSUB,1))'=0

                               QUIT

 +21                       SET PRCORD=$PIECE(PRCNODE2,PRCFS,1)

                           SET DYNADATE=$PIECE(PRCNODE2,PRCFS,9)

                           SET PRCEMP=$PIECE($PIECE(PRCNODE2,PRCFS,10),PRCCS,1,3)

                           SET PRCSITE=$PIECE(PRCNODE2,PRCFS,21)

 +22                       SET PRCFCP=$PIECE(PRCNODE2,PRCFS,3)

                           SET PRCCC=$PIECE(PRCNODE2,PRCFS,17)

 +23                       SET PRCDATE=$$HL7TFM^XLFDT(DYNADATE)

 +24                       SET $PIECE(^XTMP(PRCSUB,1),U,1)=0

 +25                       SET $PIECE(^XTMP(PRCSUB,1),U,4)=PRCORD

                           SET $PIECE(^XTMP(PRCSUB,1),U,5)=PRCSITE

 +26                       SET $PIECE(^XTMP(PRCSUB,1),U,6)=PRCDATE

                           SET $PIECE(^XTMP(PRCSUB,1),U,7)=PRCEMP

                       End DoDot:2

                       QUIT

 +27      ;

 +28      ; If RQD segment process the record

 +29      ;

 +30               IF PRCNODE="RQD"

                       Begin DoDot:2

 +31                       SET PRCCTR=$PIECE(PRCNODE2,PRCFS,1)

 +32                       SET PRCDOC=$PIECE(PRCNODE2,PRCFS,2)

                           SET PRCITM=$PIECE(PRCNODE2,PRCFS,3)

 +33                       SET PRCQTY=$PIECE(PRCNODE2,PRCFS,5)

                           SET DYNADATE=$PIECE(PRCNODE2,PRCFS,10)

 +34                       SET PRCNEED=$$HL7TFM^XLFDT(DYNADATE)

                       End DoDot:2

                       QUIT

 +35      ;

 +36      ;If RQ1 segment process the record and build the XTMP global record

 +37      ;

 +38               IF PRCNODE="RQ1"

                       Begin DoDot:2

 +39                       SET PRCCOST=$PIECE(PRCNODE2,PRCFS,1)

                           SET PRCBOC=$PIECE(PRCNODE2,PRCFS,3)

                           SET PRCVND=$PIECE(PRCNODE2,PRCFS,4)

                           SET PRCNIF=$PIECE(PRCNODE2,PRCFS,5)

 +40      ;

 +41      ; Now build the XTMP record

 +42      ;

 +43                       SET PRCVINDX=$PIECE($GET(^XTMP(PRCSUB,1)),U,1)

 +44                       IF PRCCTR>PRCVINDX

                               SET $PIECE(^XTMP(PRCSUB,1),U,1)=PRCCTR

 +45                       SET $PIECE(^XTMP(PRCSUB,1),U,2)=PRCFCP

 +46                       SET $PIECE(^XTMP(PRCSUB,1),U,3)=PRCCC

 +47                       SET ^XTMP(PRCSUB,2,PRCCTR)=PRCITM_U_PRCQTY_U_PRCVND_U_PRCCOST_U_PRCNEED_U_PRCDOC_U_PRCNIF_U_PRCBOC

                       End DoDot:2

                       QUIT

               End DoDot:1

 +48      ;

 +49       IF LENVAL="NOTOK"

               Begin DoDot:1

 +50               SET $PIECE(^TMP("PRCVRIL",$JOB,"NAK",2),PRCFS,2)="HL7 Segment length greater than 1K"

 +51               DO NAKIT^PRCVREA

 +52               KILL ^XTMP(PRCSUB)

               End DoDot:1

               QUIT

 +53       DO CALLIT^PRCVREA

 +54       QUIT

 +55      ;

BUILD     ;Build the ^XTMP global zero node record.

 +1       ;

 +2        SET XX=$$HTFM^XLFDT($HOROLOG,1)

 +3        SET X1=$$FMADD^XLFDT(XX,5)

 +4        SET ^XTMP(PRCSUB,0)=X1_U_XX_"^Transmit message to IFCAP to build the RIL"_U_$HOROLOG

 +5        QUIT

 +6       ;

CLEANUP   ;This area will kill all temporary globals and variables

 +1       ;

 +2        KILL ^TMP("PRCVRE",$JOB),TMP($JOB)

 +3        KILL ^TMP("HLA",$JOB)

 +4        KILL ^TMP("PRCVRIL",$JOB)

 +5        KILL PRCCTR,PRCCNT,PRCORD,DYNADATE,PRCDATE,PRCEMP,PRCSITE,PRCDOC

 +6        KILL PRCITM,PRCQTY,PRCFCP,PRCCC,PRCNIF,PRCBOC

 +7        KILL PRCCOST,PRCVND,PRCSUB,PRCSUB2,PRCDT,PRCNEED

 +8        KILL PRCFS,PRCCS,PRCRS,PRCVINDX

 +9        KILL ERRARY

 +10       KILL PRCFS,PRCRS,PRCNODE,PRCNODE2,PRCI,PRCJ

 +11       KILL ACKCNT,NODE1,NODE2,LENVAL

 +12       KILL X,X1,X2,X8,X9,XX,TMP,PRCCC1,PRCFCP1

 +13      ;Fields killed here are used in PRCVREA

 +14       KILL MID,MSG,MSGFLG,MYRESULT,PRCDET,PRCHD,ERRLOC,ERRSUB

 +15       KILL DOCID,ERRCNT,ERRCOD,ERRDAT,ERRS,ERRSTR,I,II,III,IL,J,ERRTXT,SEVER

 +16       KILL TOT,TOTERR,TOTGOOD,TOTREC,FLDNO,PRCVERR,PRCVRES

 +17       QUIT

PRCVRE1.m