PRCVEE1 ;WOIFO/VAC-EDIT/CANCELLATION FOR RIL/2237 FROM IFCAP TO DYNAMED ; 5/4/05 10:41am
;;5.1;IFCAP;**81**;Oct 20, 2000
;PER VHA Directive 10-93-142, this routine should not be modified
;
;This routine will pass changes, cancellations and approvals from
;IFCAP to DynaMed because of changes in RIL's or 2237's
BEGIN(REF,PRCVDT) ;
; REF is passed in as node for ^XTMP(REF)
; PRCVDT is passed in as node for ^XTMP(REF,PRCVDT)
; Note: PRCVDT is really two data elements $H and comma delimited
; There are two XTMP structures for this process. The first is
; for the original message sent from IFCAP. The first node is
; "PRCVUP*"+the RIL or 2237 number. The second node is $H. The third
; node is either 0,1 or 2. Zero is the standard ^XTMP structure
; plus $H. The 1 node contains header information common to all
; items. The 2 node contains detail information to be sent.
; Subordinate to the 2 node is a counter node unique for each item.
; Under the 1 and 2 nodes, will reside an "ERR" node with
; subordinate counters for multiple errors per item. The second
; ^XTMP is a pointer to the PRCVUP*xxx node. The first node is
; "PRCVMID*"+the Message Control ID for the original message.
; The 1 node contains the PRCVUP*+xxx and $H to point back to the
; original XTMP("PRCVUP*"+RIL/2237)
; PRCPRO - Procedure call ID
; PRCERR - Error array for processing message errors
; PRCFS - Field separator
; PRCCS - Component separator
; PRCRS - Repetition separator
; PRCEE - Escape separator
; PRCSC - Sub-component separator
; PRCMID - Message Control ID for sent message
; ORCDAT - a single field that holds an ORC Segment
; RQD - an array of fields for the RQD segment
; RQ1 - an array of fields for the RQ1 segment
; ORC - an array of fields for the ORC segment
; PRCCNT - a record counter
; PRCVY - Loop counter
N PRCPRO,PRCERR,PRCFS,PRCCS,PRCRS,PRCEE,PRCSC,PRCDP
N ORCDAT,I,J,K,Y,X,X1,X2,XX,RQD,ORC,PRCCNT,RQ1
N ODATE,PRCDTS,PRCDT,PRCMID,PRCVMID,DETAIL,HLA,HL,ERRCNT
N PRCVERR,PRCVY,PRCDATA,PRCSITE,PRCFCP
S PRCDATA=$P(REF,"*",2)
S PRCSITE=$P(PRCDATA,"-",1),PRCFCP=$P(PRCDATA,"-",4)
S PRCERR="OK"
I REF="" Q
S PRCDTS=$$NOW^XLFDT
S PRCDT=$$FMTHL7^XLFDT(PRCDTS),ERRCNT=1
D BUILD
D SEND
D CLEAN
Q
BUILD ;Create the ORC record for the message
S PRCCNT=1
S PRCPRO="PRCV_IFCAP_01_EV_DYNAMED_UPDATE"
K HL D INIT^HLFNC2(PRCPRO,.HL)
I $G(HL) S PRCVERR(ERRCNT)="Error Generating Message to DynaMed" D MSGRTN Q
S PRCFS=HL("FS"),PRCCS=$E(HL("ECH"),1),PRCRS=$E(HL("ECH"),2),PRCEE=$E(HL("ECH"),3),PRCSC=$E(HL("ECH"),4)
;
ORC ;Build ORC Segment
S ORCDAT=$G(^XTMP(REF,PRCVDT,1))
Q:ORCDAT=""
F I=1:1:21 S ORC(I)=""
;Convert a $H node value to a HL7 date format
S ODATE=$$HTFM^XLFDT(PRCVDT) S ORC(9)=$$FMTHL7^XLFDT(ODATE)
S ORC(21)=$P(ORCDAT,U,2)
S ORC(10)=$P(ORCDAT,U,3)_PRCCS_$P(ORCDAT,U,4)_PRCCS_$P(ORCDAT,U,5)
S $P(ORC(10),PRCCS,9)=ORC(21)
;S HLA("HLS",PRCCNT)="ORC"_PRCFS
;
RQD ;Build RQD segment
S PRCVY=0 F K=1:1 S PRCVY=$O(^XTMP(REF,PRCVDT,2,PRCVY)) Q:PRCVY="" D
.S DETAIL=$G(^XTMP(REF,PRCVDT,2,PRCVY))
.Q:DETAIL=""
.S ORC(1)=$P(DETAIL,PRCCS,1)
.S HLA("HLS",PRCCNT)="ORC"_PRCFS
.F I=1:1:10 S RQD(I)=""
.F I=1:1:20 S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_ORC(I)_PRCFS
.S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_ORC(21)
.S PRCCNT=PRCCNT+1
.S HLA("HLS",PRCCNT)="RQD"_PRCFS
.S RQD(1)=PRCVY
.S RQD(2)=$P(DETAIL,U,7)
.S RQD(3)=$P(DETAIL,U,2)
.S RQD(4)=$P(DETAIL,U,11)
.S RQD(5)=$P(DETAIL,U,3)
.S RQD(6)=$P(DETAIL,U,9)
.S RQD(9)=$P(REF,"*",2)
.S RQD(10)=$P(DETAIL,U,8)
.S RQD(10)=$$FMTHL7^XLFDT(RQD(10))
.F J=1:1:9 S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQD(J)_PRCFS
.S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQD(10)
.S PRCCNT=PRCCNT+1
.;Build RQ1 segment
.F I=1:1:5 S RQ1(I)=""
.S HLA("HLS",PRCCNT)="RQ1"_PRCFS
.S RQ1(1)=$P(DETAIL,U,6)
.S RQ1(2)=$P(DETAIL,U,10)
.S RQ1(3)=$P(DETAIL,U,12)
.S RQ1(4)=$P(DETAIL,U,4)_PRCCS_PRCCS_PRCCS_$P(DETAIL,U,5)
.S RQ1(5)=$P(DETAIL,U,15)
.F J=1:1:4 S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQ1(J)_PRCFS
.S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQ1(5)
.S PRCCNT=PRCCNT+1
Q
SEND ;Send record to HL7 interface to DynaMed
S PRCDP="" D GENERATE^HLMA(PRCPRO,"LM",1,.PRCDP)
I $P(PRCDP,PRCCS,2)'="" S PRCVERR(ERRCNT)="Generated "_$P(PRCDP,U,3) D MSGRTN
;
;Get the Message Control ID
S PRCMID=$P(PRCDP,U,1)
S XX=$$HTFM^XLFDT($H,1)
S X1=$$FMADD^XLFDT(XX,5)
S PRCVMID="PRCVMID*"_PRCMID
S ^XTMP(PRCVMID,0)=X1_U_XX_"^ACK 2237/RIL message from DynaMed"
S ^XTMP(PRCVMID,1)=REF_U_PRCVDT
Q
MSGRTN ;Send message to Fund Control Point users for update
N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
S XMSUB="TRANSMISSION ERRORS FOR "_$P(REF,"*",2)
S XMDUZ="IFCAP OUTBOUND ERROR MESSAGE FOR RIL/2237"
S XMTEXT="PRCVERR("
D GETFCPU^PRCVLIC(.XMY,PRCSITE,PRCFCP)
D ^XMD
K XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
Q
CLEAN ;Clean up variables
K ODATE,PRCPRO,PRCERR,PRCFS,PRCCS,PRCRS,PRCEE,PRCSC
K DETAIL,HLA("HLS"),PRCDP,PRCERR,PRCMID,PRCVMID,PRCDT,PRCDTS
K ORCDAT,I,J,K,Y,X,X1,X2,XX,HLA,RQD,RQ1,ORC,PRCCNT,PRCVY
K XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,ERRCNT,PRCVERR
K PRCDATA,PRCSITE,PRCFCP
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCVEE1 5228 printed Nov 22, 2024@17:30:02 Page 2
PRCVEE1 ;WOIFO/VAC-EDIT/CANCELLATION FOR RIL/2237 FROM IFCAP TO DYNAMED ; 5/4/05 10:41am
+1 ;;5.1;IFCAP;**81**;Oct 20, 2000
+2 ;PER VHA Directive 10-93-142, this routine should not be modified
+3 ;
+4 ;This routine will pass changes, cancellations and approvals from
+5 ;IFCAP to DynaMed because of changes in RIL's or 2237's
BEGIN(REF,PRCVDT) ;
+1 ; REF is passed in as node for ^XTMP(REF)
+2 ; PRCVDT is passed in as node for ^XTMP(REF,PRCVDT)
+3 ; Note: PRCVDT is really two data elements $H and comma delimited
+4 ; There are two XTMP structures for this process. The first is
+5 ; for the original message sent from IFCAP. The first node is
+6 ; "PRCVUP*"+the RIL or 2237 number. The second node is $H. The third
+7 ; node is either 0,1 or 2. Zero is the standard ^XTMP structure
+8 ; plus $H. The 1 node contains header information common to all
+9 ; items. The 2 node contains detail information to be sent.
+10 ; Subordinate to the 2 node is a counter node unique for each item.
+11 ; Under the 1 and 2 nodes, will reside an "ERR" node with
+12 ; subordinate counters for multiple errors per item. The second
+13 ; ^XTMP is a pointer to the PRCVUP*xxx node. The first node is
+14 ; "PRCVMID*"+the Message Control ID for the original message.
+15 ; The 1 node contains the PRCVUP*+xxx and $H to point back to the
+16 ; original XTMP("PRCVUP*"+RIL/2237)
+17 ; PRCPRO - Procedure call ID
+18 ; PRCERR - Error array for processing message errors
+19 ; PRCFS - Field separator
+20 ; PRCCS - Component separator
+21 ; PRCRS - Repetition separator
+22 ; PRCEE - Escape separator
+23 ; PRCSC - Sub-component separator
+24 ; PRCMID - Message Control ID for sent message
+25 ; ORCDAT - a single field that holds an ORC Segment
+26 ; RQD - an array of fields for the RQD segment
+27 ; RQ1 - an array of fields for the RQ1 segment
+28 ; ORC - an array of fields for the ORC segment
+29 ; PRCCNT - a record counter
+30 ; PRCVY - Loop counter
+31 NEW PRCPRO,PRCERR,PRCFS,PRCCS,PRCRS,PRCEE,PRCSC,PRCDP
+32 NEW ORCDAT,I,J,K,Y,X,X1,X2,XX,RQD,ORC,PRCCNT,RQ1
+33 NEW ODATE,PRCDTS,PRCDT,PRCMID,PRCVMID,DETAIL,HLA,HL,ERRCNT
+34 NEW PRCVERR,PRCVY,PRCDATA,PRCSITE,PRCFCP
+35 SET PRCDATA=$PIECE(REF,"*",2)
+36 SET PRCSITE=$PIECE(PRCDATA,"-",1)
SET PRCFCP=$PIECE(PRCDATA,"-",4)
+37 SET PRCERR="OK"
+38 IF REF=""
QUIT
+39 SET PRCDTS=$$NOW^XLFDT
+40 SET PRCDT=$$FMTHL7^XLFDT(PRCDTS)
SET ERRCNT=1
+41 DO BUILD
+42 DO SEND
+43 DO CLEAN
+44 QUIT
BUILD ;Create the ORC record for the message
+1 SET PRCCNT=1
+2 SET PRCPRO="PRCV_IFCAP_01_EV_DYNAMED_UPDATE"
+3 KILL HL
DO INIT^HLFNC2(PRCPRO,.HL)
+4 IF $GET(HL)
SET PRCVERR(ERRCNT)="Error Generating Message to DynaMed"
DO MSGRTN
QUIT
+5 SET PRCFS=HL("FS")
SET PRCCS=$EXTRACT(HL("ECH"),1)
SET PRCRS=$EXTRACT(HL("ECH"),2)
SET PRCEE=$EXTRACT(HL("ECH"),3)
SET PRCSC=$EXTRACT(HL("ECH"),4)
+6 ;
ORC ;Build ORC Segment
+1 SET ORCDAT=$GET(^XTMP(REF,PRCVDT,1))
+2 if ORCDAT=""
QUIT
+3 FOR I=1:1:21
SET ORC(I)=""
+4 ;Convert a $H node value to a HL7 date format
+5 SET ODATE=$$HTFM^XLFDT(PRCVDT)
SET ORC(9)=$$FMTHL7^XLFDT(ODATE)
+6 SET ORC(21)=$PIECE(ORCDAT,U,2)
+7 SET ORC(10)=$PIECE(ORCDAT,U,3)_PRCCS_$PIECE(ORCDAT,U,4)_PRCCS_$PIECE(ORCDAT,U,5)
+8 SET $PIECE(ORC(10),PRCCS,9)=ORC(21)
+9 ;S HLA("HLS",PRCCNT)="ORC"_PRCFS
+10 ;
RQD ;Build RQD segment
+1 SET PRCVY=0
FOR K=1:1
SET PRCVY=$ORDER(^XTMP(REF,PRCVDT,2,PRCVY))
if PRCVY=""
QUIT
Begin DoDot:1
+2 SET DETAIL=$GET(^XTMP(REF,PRCVDT,2,PRCVY))
+3 if DETAIL=""
QUIT
+4 SET ORC(1)=$PIECE(DETAIL,PRCCS,1)
+5 SET HLA("HLS",PRCCNT)="ORC"_PRCFS
+6 FOR I=1:1:10
SET RQD(I)=""
+7 FOR I=1:1:20
SET HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_ORC(I)_PRCFS
+8 SET HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_ORC(21)
+9 SET PRCCNT=PRCCNT+1
+10 SET HLA("HLS",PRCCNT)="RQD"_PRCFS
+11 SET RQD(1)=PRCVY
+12 SET RQD(2)=$PIECE(DETAIL,U,7)
+13 SET RQD(3)=$PIECE(DETAIL,U,2)
+14 SET RQD(4)=$PIECE(DETAIL,U,11)
+15 SET RQD(5)=$PIECE(DETAIL,U,3)
+16 SET RQD(6)=$PIECE(DETAIL,U,9)
+17 SET RQD(9)=$PIECE(REF,"*",2)
+18 SET RQD(10)=$PIECE(DETAIL,U,8)
+19 SET RQD(10)=$$FMTHL7^XLFDT(RQD(10))
+20 FOR J=1:1:9
SET HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQD(J)_PRCFS
+21 SET HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQD(10)
+22 SET PRCCNT=PRCCNT+1
+23 ;Build RQ1 segment
+24 FOR I=1:1:5
SET RQ1(I)=""
+25 SET HLA("HLS",PRCCNT)="RQ1"_PRCFS
+26 SET RQ1(1)=$PIECE(DETAIL,U,6)
+27 SET RQ1(2)=$PIECE(DETAIL,U,10)
+28 SET RQ1(3)=$PIECE(DETAIL,U,12)
+29 SET RQ1(4)=$PIECE(DETAIL,U,4)_PRCCS_PRCCS_PRCCS_$PIECE(DETAIL,U,5)
+30 SET RQ1(5)=$PIECE(DETAIL,U,15)
+31 FOR J=1:1:4
SET HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQ1(J)_PRCFS
+32 SET HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQ1(5)
+33 SET PRCCNT=PRCCNT+1
End DoDot:1
+34 QUIT
SEND ;Send record to HL7 interface to DynaMed
+1 SET PRCDP=""
DO GENERATE^HLMA(PRCPRO,"LM",1,.PRCDP)
+2 IF $PIECE(PRCDP,PRCCS,2)'=""
SET PRCVERR(ERRCNT)="Generated "_$PIECE(PRCDP,U,3)
DO MSGRTN
+3 ;
+4 ;Get the Message Control ID
+5 SET PRCMID=$PIECE(PRCDP,U,1)
+6 SET XX=$$HTFM^XLFDT($HOROLOG,1)
+7 SET X1=$$FMADD^XLFDT(XX,5)
+8 SET PRCVMID="PRCVMID*"_PRCMID
+9 SET ^XTMP(PRCVMID,0)=X1_U_XX_"^ACK 2237/RIL message from DynaMed"
+10 SET ^XTMP(PRCVMID,1)=REF_U_PRCVDT
+11 QUIT
MSGRTN ;Send message to Fund Control Point users for update
+1 NEW XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
+2 SET XMSUB="TRANSMISSION ERRORS FOR "_$PIECE(REF,"*",2)
+3 SET XMDUZ="IFCAP OUTBOUND ERROR MESSAGE FOR RIL/2237"
+4 SET XMTEXT="PRCVERR("
+5 DO GETFCPU^PRCVLIC(.XMY,PRCSITE,PRCFCP)
+6 DO ^XMD
+7 KILL XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
+8 QUIT
CLEAN ;Clean up variables
+1 KILL ODATE,PRCPRO,PRCERR,PRCFS,PRCCS,PRCRS,PRCEE,PRCSC
+2 KILL DETAIL,HLA("HLS"),PRCDP,PRCERR,PRCMID,PRCVMID,PRCDT,PRCDTS
+3 KILL ORCDAT,I,J,K,Y,X,X1,X2,XX,HLA,RQD,RQ1,ORC,PRCCNT,PRCVY
+4 KILL XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,ERRCNT,PRCVERR
+5 KILL PRCDATA,PRCSITE,PRCFCP
+6 QUIT
+7 ;
