- 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 Feb 18, 2025@23:46:20 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 ;