Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCVEE1

PRCVEE1.m

Go to the documentation of this file.
  1. 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
  1. ;PER VHA Directive 10-93-142, this routine should not be modified
  1. ;
  1. ;This routine will pass changes, cancellations and approvals from
  1. ;IFCAP to DynaMed because of changes in RIL's or 2237's
  1. BEGIN(REF,PRCVDT) ;
  1. ; REF is passed in as node for ^XTMP(REF)
  1. ; PRCVDT is passed in as node for ^XTMP(REF,PRCVDT)
  1. ; Note: PRCVDT is really two data elements $H and comma delimited
  1. ; There are two XTMP structures for this process. The first is
  1. ; for the original message sent from IFCAP. The first node is
  1. ; "PRCVUP*"+the RIL or 2237 number. The second node is $H. The third
  1. ; node is either 0,1 or 2. Zero is the standard ^XTMP structure
  1. ; plus $H. The 1 node contains header information common to all
  1. ; items. The 2 node contains detail information to be sent.
  1. ; Subordinate to the 2 node is a counter node unique for each item.
  1. ; Under the 1 and 2 nodes, will reside an "ERR" node with
  1. ; subordinate counters for multiple errors per item. The second
  1. ; ^XTMP is a pointer to the PRCVUP*xxx node. The first node is
  1. ; "PRCVMID*"+the Message Control ID for the original message.
  1. ; The 1 node contains the PRCVUP*+xxx and $H to point back to the
  1. ; original XTMP("PRCVUP*"+RIL/2237)
  1. ; PRCPRO - Procedure call ID
  1. ; PRCERR - Error array for processing message errors
  1. ; PRCFS - Field separator
  1. ; PRCCS - Component separator
  1. ; PRCRS - Repetition separator
  1. ; PRCEE - Escape separator
  1. ; PRCSC - Sub-component separator
  1. ; PRCMID - Message Control ID for sent message
  1. ; ORCDAT - a single field that holds an ORC Segment
  1. ; RQD - an array of fields for the RQD segment
  1. ; RQ1 - an array of fields for the RQ1 segment
  1. ; ORC - an array of fields for the ORC segment
  1. ; PRCCNT - a record counter
  1. ; PRCVY - Loop counter
  1. N PRCPRO,PRCERR,PRCFS,PRCCS,PRCRS,PRCEE,PRCSC,PRCDP
  1. N ORCDAT,I,J,K,Y,X,X1,X2,XX,RQD,ORC,PRCCNT,RQ1
  1. N ODATE,PRCDTS,PRCDT,PRCMID,PRCVMID,DETAIL,HLA,HL,ERRCNT
  1. N PRCVERR,PRCVY,PRCDATA,PRCSITE,PRCFCP
  1. S PRCDATA=$P(REF,"*",2)
  1. S PRCSITE=$P(PRCDATA,"-",1),PRCFCP=$P(PRCDATA,"-",4)
  1. S PRCERR="OK"
  1. I REF="" Q
  1. S PRCDTS=$$NOW^XLFDT
  1. S PRCDT=$$FMTHL7^XLFDT(PRCDTS),ERRCNT=1
  1. D BUILD
  1. D SEND
  1. D CLEAN
  1. Q
  1. BUILD ;Create the ORC record for the message
  1. S PRCCNT=1
  1. S PRCPRO="PRCV_IFCAP_01_EV_DYNAMED_UPDATE"
  1. K HL D INIT^HLFNC2(PRCPRO,.HL)
  1. I $G(HL) S PRCVERR(ERRCNT)="Error Generating Message to DynaMed" D MSGRTN Q
  1. S PRCFS=HL("FS"),PRCCS=$E(HL("ECH"),1),PRCRS=$E(HL("ECH"),2),PRCEE=$E(HL("ECH"),3),PRCSC=$E(HL("ECH"),4)
  1. ;
  1. ORC ;Build ORC Segment
  1. S ORCDAT=$G(^XTMP(REF,PRCVDT,1))
  1. Q:ORCDAT=""
  1. F I=1:1:21 S ORC(I)=""
  1. ;Convert a $H node value to a HL7 date format
  1. S ODATE=$$HTFM^XLFDT(PRCVDT) S ORC(9)=$$FMTHL7^XLFDT(ODATE)
  1. S ORC(21)=$P(ORCDAT,U,2)
  1. S ORC(10)=$P(ORCDAT,U,3)_PRCCS_$P(ORCDAT,U,4)_PRCCS_$P(ORCDAT,U,5)
  1. S $P(ORC(10),PRCCS,9)=ORC(21)
  1. ;S HLA("HLS",PRCCNT)="ORC"_PRCFS
  1. ;
  1. RQD ;Build RQD segment
  1. S PRCVY=0 F K=1:1 S PRCVY=$O(^XTMP(REF,PRCVDT,2,PRCVY)) Q:PRCVY="" D
  1. .S DETAIL=$G(^XTMP(REF,PRCVDT,2,PRCVY))
  1. .Q:DETAIL=""
  1. .S ORC(1)=$P(DETAIL,PRCCS,1)
  1. .S HLA("HLS",PRCCNT)="ORC"_PRCFS
  1. .F I=1:1:10 S RQD(I)=""
  1. .F I=1:1:20 S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_ORC(I)_PRCFS
  1. .S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_ORC(21)
  1. .S PRCCNT=PRCCNT+1
  1. .S HLA("HLS",PRCCNT)="RQD"_PRCFS
  1. .S RQD(1)=PRCVY
  1. .S RQD(2)=$P(DETAIL,U,7)
  1. .S RQD(3)=$P(DETAIL,U,2)
  1. .S RQD(4)=$P(DETAIL,U,11)
  1. .S RQD(5)=$P(DETAIL,U,3)
  1. .S RQD(6)=$P(DETAIL,U,9)
  1. .S RQD(9)=$P(REF,"*",2)
  1. .S RQD(10)=$P(DETAIL,U,8)
  1. .S RQD(10)=$$FMTHL7^XLFDT(RQD(10))
  1. .F J=1:1:9 S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQD(J)_PRCFS
  1. .S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQD(10)
  1. .S PRCCNT=PRCCNT+1
  1. .;Build RQ1 segment
  1. .F I=1:1:5 S RQ1(I)=""
  1. .S HLA("HLS",PRCCNT)="RQ1"_PRCFS
  1. .S RQ1(1)=$P(DETAIL,U,6)
  1. .S RQ1(2)=$P(DETAIL,U,10)
  1. .S RQ1(3)=$P(DETAIL,U,12)
  1. .S RQ1(4)=$P(DETAIL,U,4)_PRCCS_PRCCS_PRCCS_$P(DETAIL,U,5)
  1. .S RQ1(5)=$P(DETAIL,U,15)
  1. .F J=1:1:4 S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQ1(J)_PRCFS
  1. .S HLA("HLS",PRCCNT)=HLA("HLS",PRCCNT)_RQ1(5)
  1. .S PRCCNT=PRCCNT+1
  1. Q
  1. SEND ;Send record to HL7 interface to DynaMed
  1. S PRCDP="" D GENERATE^HLMA(PRCPRO,"LM",1,.PRCDP)
  1. I $P(PRCDP,PRCCS,2)'="" S PRCVERR(ERRCNT)="Generated "_$P(PRCDP,U,3) D MSGRTN
  1. ;
  1. ;Get the Message Control ID
  1. S PRCMID=$P(PRCDP,U,1)
  1. S XX=$$HTFM^XLFDT($H,1)
  1. S X1=$$FMADD^XLFDT(XX,5)
  1. S PRCVMID="PRCVMID*"_PRCMID
  1. S ^XTMP(PRCVMID,0)=X1_U_XX_"^ACK 2237/RIL message from DynaMed"
  1. S ^XTMP(PRCVMID,1)=REF_U_PRCVDT
  1. Q
  1. MSGRTN ;Send message to Fund Control Point users for update
  1. N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
  1. S XMSUB="TRANSMISSION ERRORS FOR "_$P(REF,"*",2)
  1. S XMDUZ="IFCAP OUTBOUND ERROR MESSAGE FOR RIL/2237"
  1. S XMTEXT="PRCVERR("
  1. D GETFCPU^PRCVLIC(.XMY,PRCSITE,PRCFCP)
  1. D ^XMD
  1. K XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
  1. Q
  1. CLEAN ;Clean up variables
  1. K ODATE,PRCPRO,PRCERR,PRCFS,PRCCS,PRCRS,PRCEE,PRCSC
  1. K DETAIL,HLA("HLS"),PRCDP,PRCERR,PRCMID,PRCVMID,PRCDT,PRCDTS
  1. K ORCDAT,I,J,K,Y,X,X1,X2,XX,HLA,RQD,RQ1,ORC,PRCCNT,PRCVY
  1. K XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ,ERRCNT,PRCVERR
  1. K PRCDATA,PRCSITE,PRCFCP
  1. Q
  1. ;