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

SCMCHLRI.m

Go to the documentation of this file. 
  1. SCMCHLRI ;BP/DJB - PCMM HL7 Rejects - Identify & Store Msg ; 2/28/00 12:10pm
  1.  ;;5.3;Scheduling;**210,1015**;AUG 13, 1993;Build 21
  1.  ;
  1. ACK ;Identify an acknowledgment message
  1.  ;
  1.  ;HL7 Message:
  1.  ;   ACK Code..........: Segment MSA, fld 1
  1.  ;   Msg ID............: Segment MSA, fld 2
  1.  ;   Segment code......: Segment ERR, fld 2, component 1
  1.  ;   Sequence..........: Segment ERR, fld 2, component 2
  1.  ;   Field Position....: Segment ERR, fld 2, component 3
  1.  ;   Error code........: Segment ERR, fld 2, component 4
  1.  ;
  1.  NEW ARRAY,CS,FS,RS
  1.  ;
  1.  S CS=$E(HL("ECH"),1) ;..Component separator
  1.  S RS=$E(HL("ECH"),2) ;..Repetition separator
  1.  S FS=HL("FS") ;.........Field separator
  1.  ;
  1.  D PARSE ;Build array
  1.  Q:'$D(ARRAY)
  1.  D UPDATE ;Update PCMM HL7 TRANSISSION LOG file
  1.  Q
  1.  ;
  1. PARSE ;Parse ACK message.
  1.  ;Build array:
  1.  ;   ARRAY("MSA","MSGID")........= Message ID
  1.  ;   ARRAY("MSA","ACKCODE")......= ACK code
  1.  ;   ARRAY("ERR",counter,"SEG")..= Segment ID
  1.  ;   ARRAY("ERR",counter,"SEQ")..= Sequence #
  1.  ;   ARRAY("ERR",counter,"FLD")..= Field Position
  1.  ;   ARRAY("ERR",counter,"CODE").= Error code
  1.  ;
  1.  NEW CNTERR,MSGID,SEG,TXTFLD,TXTREP
  1.  ;
  1.  F  X HLNEXT Q:(HLQUIT'>0)  D  ;
  1.  . S SEG=$P(HLNODE,FS,1) ;..Segment name
  1.  . ;
  1.  . ;-> MSA segment
  1.  . I SEG="MSA" D  Q
  1.  .. S ARRAY("MSA","ACKCODE")=$P(HLNODE,FS,2)
  1.  .. S ARRAY("MSA","MSGID")=$P(HLNODE,FS,3)
  1.  . ;
  1.  . ;-> ERR segment
  1.  . I SEG="ERR" D  Q
  1.  .. S TXTFLD=$P(HLNODE,FS,2) ;..Repeating field
  1.  .. F CNTERR=1:1 S TXTREP=$P(TXTFLD,RS,CNTERR) Q:TXTREP=""  D  ;
  1.  ... S ARRAY("ERR",CNTERR,"SEG")=$P(TXTREP,CS,1)
  1.  ... ;Get Sequence # and strip off any leading zeros
  1.  ... S SEQ=$P(TXTREP,CS,2)
  1.  ... F  Q:($E(SEQ,1)'=0)  S SEQ=$E(SEQ,2,$L(SEQ))
  1.  ... S ARRAY("ERR",CNTERR,"SEQ")=SEQ
  1.  ... S ARRAY("ERR",CNTERR,"FLD")=$P(TXTREP,CS,3)
  1.  ... S ARRAY("ERR",CNTERR,"CODE")=$P(TXTREP,CS,4)
  1.  Q
  1.  ;
  1. UPDATE ;Update entry in PCMM HL7 TRANSMISSION LOG file
  1.  NEW ACKCODE,ERRORI,MSGID,TRANI
  1.  S MSGID=ARRAY("MSA","MSGID")
  1.  S TRANI=$O(^SCPT(404.471,"B",MSGID,""))
  1.  Q:'$G(TRANI)
  1.  Q:'$D(^SCPT(404.471,TRANI))
  1.  S ACKCODE=ARRAY("MSA","ACKCODE")
  1.  ;
  1.  ;Message processed.
  1.  I ACKCODE="AA" D STATUS(TRANI,"A") Q  ;Msg accepted
  1.  ;
  1.  ;Rejected for reasons unrelated to content.
  1.  I ACKCODE="AR" D STATUS(TRANI,"M") Q  ;Msg marked for re-transmit
  1.  ;
  1.  ;Rejected - error information provided.
  1.  I ACKCODE="AE" D  Q
  1.  . D STATUS(TRANI,"RJ") ;Msg rejected
  1.  . D STORE(TRANI)
  1.  Q
  1.  ;
  1. STATUS(TRANI,STATUS) ;Update STATUS field in PCMM HL7 TRANSMISSION LOG file.
  1.  ; Input: TRANI - IEN of PCM HL7 TRANSMISSION LOG file
  1.  ;       STATUS - A=Accepted, M=Marked for re-transmit, RJ=Rejected
  1.  ;
  1.  NEW SCERR,SCFDA,SCIENS
  1.  Q:'$G(TRANI)
  1.  Q:",A,M,RJ,"'[(","_$G(STATUS)_",")
  1.  S SCIENS=TRANI_","
  1.  S SCFDA(404.471,SCIENS,.04)=STATUS ;.........Status
  1.  S SCFDA(404.471,SCIENS,.05)=$$NOW^XLFDT() ;..ACK received date
  1.  D FILE^DIE("I","SCFDA","SCERR")
  1.  Q
  1.  ;
  1. STORE(TRANI) ;Store data from "ERR" and "ZER" arrays
  1.  ;
  1.  ; Input: TRANI - IEN of PCMM HL7 TRANSMISSION LOG file
  1.  ;Output: None
  1.  ;
  1.  NEW SCERR,SCIEN,SCIENS,SCIENS1,SCFDA
  1.  NEW CNT,ERRORI,FLD,SEG,SEQ,ZPCID
  1.  ;
  1.  S CNT=0
  1.  F  S CNT=$O(ARRAY("ERR",CNT)) Q:'CNT  D  ;
  1.  . ;
  1.  . ;Create entry in ERROR CODE multiple field
  1.  . S ERRORI=$$CREATE(ARRAY("ERR",CNT,"CODE"),CNT,TRANI)
  1.  . Q:+ERRORI<0
  1.  . ;
  1.  . S SEG=$G(ARRAY("ERR",CNT,"SEG")) ;..Segment
  1.  . S SEQ=$G(ARRAY("ERR",CNT,"SEQ")) ;..Sequence number
  1.  . S FLD=$G(ARRAY("ERR",CNT,"FLD")) ;..Field Position
  1.  . S ZPCID=""
  1.  . I SEG="ZPC" D  ;..ZPC ID
  1.  .. Q:'SEQ
  1.  .. S SEQI=$O(^SCPT(404.471,TRANI,"ZPC","B",SEQ,""))
  1.  .. Q:'SEQI
  1.  .. S ZPCID=$P($G(^SCPT(404.471,TRANI,"ZPC",SEQI,0)),"^",2)
  1.  . ;
  1.  . S SCIENS=ERRORI_","_TRANI_","
  1.  . S SCFDA(404.47142,SCIENS,.02)=SEG
  1.  . S SCFDA(404.47142,SCIENS,.03)=SEQ
  1.  . S SCFDA(404.47142,SCIENS,.04)=FLD
  1.  . S SCFDA(404.47142,SCIENS,.05)=ZPCID
  1.  . S SCFDA(404.47142,SCIENS,.06)=1
  1.  . D FILE^DIE("I","SCFDA","SCERR")
  1.  . KILL SCFDA,SCERR
  1.  Q
  1.  ;
  1. CREATE(ERRORCD,CNT,TRANI) ;Create an entry in the ERROR CODE multiiple field
  1.  ; Input: ERRORCD - Error code
  1.  ;        CNT     - Counter for multiple entries
  1.  ;Output: IEN to entry created
  1.  ;        -1^Error - Unable to create entry
  1.  ;
  1.  NEW IENS,SCERR,SCFDA,SCIEN
  1.  S:'$G(CNT) CNT=1
  1.  S IENS="+"_CNT_","_TRANI_","
  1.  S SCFDA(404.47142,IENS,.01)=ERRORCD
  1.  D UPDATE^DIE("E","SCFDA","SCIEN","SCERR")
  1.  I $D(SCERR) Q "-1^Unable to create entry in ERROR CODE field"
  1.  Q SCIEN(CNT)
  1.  ;
  1. CONVERT(ID) ;If ID is from an integrated site, convert it to local ID.
  1.  ;Input: ID="Site#-404.49 IEN"  (Example: 642-3456)
  1.  ;
  1.  I $D(^SCPT(404.49,"C",ID)) D   ;....See if ID is an Integration ID
  1.  . S ID=$O(^SCPT(404.49,"C",ID,"")) ;..If so, convert it to local ID
  1.  E  S ID=$P(ID,"-",2)
  1.  Q ID
  1.  ;
  1.  ;==================================================================
  1.  ;
  1. HL7SAMP ;Sample code to view HL7 message
  1.  NEW I,J
  1.  F I=1:1 X HLNEXT Q:HLQUIT'>0  D  ;
  1.  . S ^TMP("DJB",$J,I)=HLNODE
  1.  . S J=0
  1.  . ;Get segments greater than 245 characters
  1.  . F  S J=$O(HLNODE(J)) Q:'J  S ^TMP("DJB",$J,I,J)=HLNODE(J)
  1.  Q