SCMCHLRI ;BP/DJB - PCMM HL7 Rejects - Identify & Store Msg ; 2/28/00 12:10pm
;;5.3;Scheduling;**210**;AUG 13, 1993
;
ACK ;Identify an acknowledgment message
;
;HL7 Message:
; ACK Code..........: Segment MSA, fld 1
; Msg ID............: Segment MSA, fld 2
; Segment code......: Segment ERR, fld 2, component 1
; Sequence..........: Segment ERR, fld 2, component 2
; Field Position....: Segment ERR, fld 2, component 3
; Error code........: Segment ERR, fld 2, component 4
;
NEW ARRAY,CS,FS,RS
;
S CS=$E(HL("ECH"),1) ;..Component separator
S RS=$E(HL("ECH"),2) ;..Repetition separator
S FS=HL("FS") ;.........Field separator
;
D PARSE ;Build array
Q:'$D(ARRAY)
D UPDATE ;Update PCMM HL7 TRANSISSION LOG file
Q
;
PARSE ;Parse ACK message.
;Build array:
; ARRAY("MSA","MSGID")........= Message ID
; ARRAY("MSA","ACKCODE")......= ACK code
; ARRAY("ERR",counter,"SEG")..= Segment ID
; ARRAY("ERR",counter,"SEQ")..= Sequence #
; ARRAY("ERR",counter,"FLD")..= Field Position
; ARRAY("ERR",counter,"CODE").= Error code
;
NEW CNTERR,MSGID,SEG,TXTFLD,TXTREP
;
F X HLNEXT Q:(HLQUIT'>0) D ;
. S SEG=$P(HLNODE,FS,1) ;..Segment name
. ;
. ;-> MSA segment
. I SEG="MSA" D Q
.. S ARRAY("MSA","ACKCODE")=$P(HLNODE,FS,2)
.. S ARRAY("MSA","MSGID")=$P(HLNODE,FS,3)
. ;
. ;-> ERR segment
. I SEG="ERR" D Q
.. S TXTFLD=$P(HLNODE,FS,2) ;..Repeating field
.. F CNTERR=1:1 S TXTREP=$P(TXTFLD,RS,CNTERR) Q:TXTREP="" D ;
... S ARRAY("ERR",CNTERR,"SEG")=$P(TXTREP,CS,1)
... ;Get Sequence # and strip off any leading zeros
... S SEQ=$P(TXTREP,CS,2)
... F Q:($E(SEQ,1)'=0) S SEQ=$E(SEQ,2,$L(SEQ))
... S ARRAY("ERR",CNTERR,"SEQ")=SEQ
... S ARRAY("ERR",CNTERR,"FLD")=$P(TXTREP,CS,3)
... S ARRAY("ERR",CNTERR,"CODE")=$P(TXTREP,CS,4)
Q
;
UPDATE ;Update entry in PCMM HL7 TRANSMISSION LOG file
NEW ACKCODE,ERRORI,MSGID,TRANI
S MSGID=ARRAY("MSA","MSGID")
S TRANI=$O(^SCPT(404.471,"B",MSGID,""))
Q:'$G(TRANI)
Q:'$D(^SCPT(404.471,TRANI))
S ACKCODE=ARRAY("MSA","ACKCODE")
;
;Message processed.
I ACKCODE="AA" D STATUS(TRANI,"A") Q ;Msg accepted
;
;Rejected for reasons unrelated to content.
I ACKCODE="AR" D STATUS(TRANI,"M") Q ;Msg marked for re-transmit
;
;Rejected - error information provided.
I ACKCODE="AE" D Q
. D STATUS(TRANI,"RJ") ;Msg rejected
. D STORE(TRANI)
Q
;
STATUS(TRANI,STATUS) ;Update STATUS field in PCMM HL7 TRANSMISSION LOG file.
; Input: TRANI - IEN of PCM HL7 TRANSMISSION LOG file
; STATUS - A=Accepted, M=Marked for re-transmit, RJ=Rejected
;
NEW SCERR,SCFDA,SCIENS
Q:'$G(TRANI)
Q:",A,M,RJ,"'[(","_$G(STATUS)_",")
S SCIENS=TRANI_","
S SCFDA(404.471,SCIENS,.04)=STATUS ;.........Status
S SCFDA(404.471,SCIENS,.05)=$$NOW^XLFDT() ;..ACK received date
D FILE^DIE("I","SCFDA","SCERR")
Q
;
STORE(TRANI) ;Store data from "ERR" and "ZER" arrays
;
; Input: TRANI - IEN of PCMM HL7 TRANSMISSION LOG file
;Output: None
;
NEW SCERR,SCIEN,SCIENS,SCIENS1,SCFDA
NEW CNT,ERRORI,FLD,SEG,SEQ,ZPCID
;
S CNT=0
F S CNT=$O(ARRAY("ERR",CNT)) Q:'CNT D ;
. ;
. ;Create entry in ERROR CODE multiple field
. S ERRORI=$$CREATE(ARRAY("ERR",CNT,"CODE"),CNT,TRANI)
. Q:+ERRORI<0
. ;
. S SEG=$G(ARRAY("ERR",CNT,"SEG")) ;..Segment
. S SEQ=$G(ARRAY("ERR",CNT,"SEQ")) ;..Sequence number
. S FLD=$G(ARRAY("ERR",CNT,"FLD")) ;..Field Position
. S ZPCID=""
. I SEG="ZPC" D ;..ZPC ID
.. Q:'SEQ
.. S SEQI=$O(^SCPT(404.471,TRANI,"ZPC","B",SEQ,""))
.. Q:'SEQI
.. S ZPCID=$P($G(^SCPT(404.471,TRANI,"ZPC",SEQI,0)),"^",2)
. ;
. S SCIENS=ERRORI_","_TRANI_","
. S SCFDA(404.47142,SCIENS,.02)=SEG
. S SCFDA(404.47142,SCIENS,.03)=SEQ
. S SCFDA(404.47142,SCIENS,.04)=FLD
. S SCFDA(404.47142,SCIENS,.05)=ZPCID
. S SCFDA(404.47142,SCIENS,.06)=1
. D FILE^DIE("I","SCFDA","SCERR")
. KILL SCFDA,SCERR
Q
;
CREATE(ERRORCD,CNT,TRANI) ;Create an entry in the ERROR CODE multiiple field
; Input: ERRORCD - Error code
; CNT - Counter for multiple entries
;Output: IEN to entry created
; -1^Error - Unable to create entry
;
NEW IENS,SCERR,SCFDA,SCIEN
S:'$G(CNT) CNT=1
S IENS="+"_CNT_","_TRANI_","
S SCFDA(404.47142,IENS,.01)=ERRORCD
D UPDATE^DIE("E","SCFDA","SCIEN","SCERR")
I $D(SCERR) Q "-1^Unable to create entry in ERROR CODE field"
Q SCIEN(CNT)
;
CONVERT(ID) ;If ID is from an integrated site, convert it to local ID.
;Input: ID="Site#-404.49 IEN" (Example: 642-3456)
;
I $D(^SCPT(404.49,"C",ID)) D ;....See if ID is an Integration ID
. S ID=$O(^SCPT(404.49,"C",ID,"")) ;..If so, convert it to local ID
E S ID=$P(ID,"-",2)
Q ID
;
;==================================================================
;
HL7SAMP ;Sample code to view HL7 message
NEW I,J
F I=1:1 X HLNEXT Q:HLQUIT'>0 D ;
. S ^TMP("DJB",$J,I)=HLNODE
. S J=0
. ;Get segments greater than 245 characters
. F S J=$O(HLNODE(J)) Q:'J S ^TMP("DJB",$J,I,J)=HLNODE(J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCHLRI 5025 printed Sep 23, 2025@20:17:02 Page 2
SCMCHLRI ;BP/DJB - PCMM HL7 Rejects - Identify & Store Msg ; 2/28/00 12:10pm
+1 ;;5.3;Scheduling;**210**;AUG 13, 1993
+2 ;
ACK ;Identify an acknowledgment message
+1 ;
+2 ;HL7 Message:
+3 ; ACK Code..........: Segment MSA, fld 1
+4 ; Msg ID............: Segment MSA, fld 2
+5 ; Segment code......: Segment ERR, fld 2, component 1
+6 ; Sequence..........: Segment ERR, fld 2, component 2
+7 ; Field Position....: Segment ERR, fld 2, component 3
+8 ; Error code........: Segment ERR, fld 2, component 4
+9 ;
+10 NEW ARRAY,CS,FS,RS
+11 ;
+12 ;..Component separator
SET CS=$EXTRACT(HL("ECH"),1)
+13 ;..Repetition separator
SET RS=$EXTRACT(HL("ECH"),2)
+14 ;.........Field separator
SET FS=HL("FS")
+15 ;
+16 ;Build array
DO PARSE
+17 if '$DATA(ARRAY)
QUIT
+18 ;Update PCMM HL7 TRANSISSION LOG file
DO UPDATE
+19 QUIT
+20 ;
PARSE ;Parse ACK message.
+1 ;Build array:
+2 ; ARRAY("MSA","MSGID")........= Message ID
+3 ; ARRAY("MSA","ACKCODE")......= ACK code
+4 ; ARRAY("ERR",counter,"SEG")..= Segment ID
+5 ; ARRAY("ERR",counter,"SEQ")..= Sequence #
+6 ; ARRAY("ERR",counter,"FLD")..= Field Position
+7 ; ARRAY("ERR",counter,"CODE").= Error code
+8 ;
+9 NEW CNTERR,MSGID,SEG,TXTFLD,TXTREP
+10 ;
+11 ;
FOR
XECUTE HLNEXT
if (HLQUIT'>0)
QUIT
Begin DoDot:1
+12 ;..Segment name
SET SEG=$PIECE(HLNODE,FS,1)
+13 ;
+14 ;-> MSA segment
+15 IF SEG="MSA"
Begin DoDot:2
+16 SET ARRAY("MSA","ACKCODE")=$PIECE(HLNODE,FS,2)
+17 SET ARRAY("MSA","MSGID")=$PIECE(HLNODE,FS,3)
End DoDot:2
QUIT
+18 ;
+19 ;-> ERR segment
+20 IF SEG="ERR"
Begin DoDot:2
+21 ;..Repeating field
SET TXTFLD=$PIECE(HLNODE,FS,2)
+22 ;
FOR CNTERR=1:1
SET TXTREP=$PIECE(TXTFLD,RS,CNTERR)
if TXTREP=""
QUIT
Begin DoDot:3
+23 SET ARRAY("ERR",CNTERR,"SEG")=$PIECE(TXTREP,CS,1)
+24 ;Get Sequence # and strip off any leading zeros
+25 SET SEQ=$PIECE(TXTREP,CS,2)
+26 FOR
if ($EXTRACT(SEQ,1)'=0)
QUIT
SET SEQ=$EXTRACT(SEQ,2,$LENGTH(SEQ))
+27 SET ARRAY("ERR",CNTERR,"SEQ")=SEQ
+28 SET ARRAY("ERR",CNTERR,"FLD")=$PIECE(TXTREP,CS,3)
+29 SET ARRAY("ERR",CNTERR,"CODE")=$PIECE(TXTREP,CS,4)
End DoDot:3
End DoDot:2
QUIT
End DoDot:1
+30 QUIT
+31 ;
UPDATE ;Update entry in PCMM HL7 TRANSMISSION LOG file
+1 NEW ACKCODE,ERRORI,MSGID,TRANI
+2 SET MSGID=ARRAY("MSA","MSGID")
+3 SET TRANI=$ORDER(^SCPT(404.471,"B",MSGID,""))
+4 if '$GET(TRANI)
QUIT
+5 if '$DATA(^SCPT(404.471,TRANI))
QUIT
+6 SET ACKCODE=ARRAY("MSA","ACKCODE")
+7 ;
+8 ;Message processed.
+9 ;Msg accepted
IF ACKCODE="AA"
DO STATUS(TRANI,"A")
QUIT
+10 ;
+11 ;Rejected for reasons unrelated to content.
+12 ;Msg marked for re-transmit
IF ACKCODE="AR"
DO STATUS(TRANI,"M")
QUIT
+13 ;
+14 ;Rejected - error information provided.
+15 IF ACKCODE="AE"
Begin DoDot:1
+16 ;Msg rejected
DO STATUS(TRANI,"RJ")
+17 DO STORE(TRANI)
End DoDot:1
QUIT
+18 QUIT
+19 ;
STATUS(TRANI,STATUS) ;Update STATUS field in PCMM HL7 TRANSMISSION LOG file.
+1 ; Input: TRANI - IEN of PCM HL7 TRANSMISSION LOG file
+2 ; STATUS - A=Accepted, M=Marked for re-transmit, RJ=Rejected
+3 ;
+4 NEW SCERR,SCFDA,SCIENS
+5 if '$GET(TRANI)
QUIT
+6 if ",A,M,RJ,"'[(","_$GET(STATUS)_",")
QUIT
+7 SET SCIENS=TRANI_","
+8 ;.........Status
SET SCFDA(404.471,SCIENS,.04)=STATUS
+9 ;..ACK received date
SET SCFDA(404.471,SCIENS,.05)=$$NOW^XLFDT()
+10 DO FILE^DIE("I","SCFDA","SCERR")
+11 QUIT
+12 ;
STORE(TRANI) ;Store data from "ERR" and "ZER" arrays
+1 ;
+2 ; Input: TRANI - IEN of PCMM HL7 TRANSMISSION LOG file
+3 ;Output: None
+4 ;
+5 NEW SCERR,SCIEN,SCIENS,SCIENS1,SCFDA
+6 NEW CNT,ERRORI,FLD,SEG,SEQ,ZPCID
+7 ;
+8 SET CNT=0
+9 ;
FOR
SET CNT=$ORDER(ARRAY("ERR",CNT))
if 'CNT
QUIT
Begin DoDot:1
+10 ;
+11 ;Create entry in ERROR CODE multiple field
+12 SET ERRORI=$$CREATE(ARRAY("ERR",CNT,"CODE"),CNT,TRANI)
+13 if +ERRORI<0
QUIT
+14 ;
+15 ;..Segment
SET SEG=$GET(ARRAY("ERR",CNT,"SEG"))
+16 ;..Sequence number
SET SEQ=$GET(ARRAY("ERR",CNT,"SEQ"))
+17 ;..Field Position
SET FLD=$GET(ARRAY("ERR",CNT,"FLD"))
+18 SET ZPCID=""
+19 ;..ZPC ID
IF SEG="ZPC"
Begin DoDot:2
+20 if 'SEQ
QUIT
+21 SET SEQI=$ORDER(^SCPT(404.471,TRANI,"ZPC","B",SEQ,""))
+22 if 'SEQI
QUIT
+23 SET ZPCID=$PIECE($GET(^SCPT(404.471,TRANI,"ZPC",SEQI,0)),"^",2)
End DoDot:2
+24 ;
+25 SET SCIENS=ERRORI_","_TRANI_","
+26 SET SCFDA(404.47142,SCIENS,.02)=SEG
+27 SET SCFDA(404.47142,SCIENS,.03)=SEQ
+28 SET SCFDA(404.47142,SCIENS,.04)=FLD
+29 SET SCFDA(404.47142,SCIENS,.05)=ZPCID
+30 SET SCFDA(404.47142,SCIENS,.06)=1
+31 DO FILE^DIE("I","SCFDA","SCERR")
+32 KILL SCFDA,SCERR
End DoDot:1
+33 QUIT
+34 ;
CREATE(ERRORCD,CNT,TRANI) ;Create an entry in the ERROR CODE multiiple field
+1 ; Input: ERRORCD - Error code
+2 ; CNT - Counter for multiple entries
+3 ;Output: IEN to entry created
+4 ; -1^Error - Unable to create entry
+5 ;
+6 NEW IENS,SCERR,SCFDA,SCIEN
+7 if '$GET(CNT)
SET CNT=1
+8 SET IENS="+"_CNT_","_TRANI_","
+9 SET SCFDA(404.47142,IENS,.01)=ERRORCD
+10 DO UPDATE^DIE("E","SCFDA","SCIEN","SCERR")
+11 IF $DATA(SCERR)
QUIT "-1^Unable to create entry in ERROR CODE field"
+12 QUIT SCIEN(CNT)
+13 ;
CONVERT(ID) ;If ID is from an integrated site, convert it to local ID.
+1 ;Input: ID="Site#-404.49 IEN" (Example: 642-3456)
+2 ;
+3 ;....See if ID is an Integration ID
IF $DATA(^SCPT(404.49,"C",ID))
Begin DoDot:1
+4 ;..If so, convert it to local ID
SET ID=$ORDER(^SCPT(404.49,"C",ID,""))
End DoDot:1
+5 IF '$TEST
SET ID=$PIECE(ID,"-",2)
+6 QUIT ID
+7 ;
+8 ;==================================================================
+9 ;
HL7SAMP ;Sample code to view HL7 message
+1 NEW I,J
+2 ;
FOR I=1:1
XECUTE HLNEXT
if HLQUIT'>0
QUIT
Begin DoDot:1
+3 SET ^TMP("DJB",$JOB,I)=HLNODE
+4 SET J=0
+5 ;Get segments greater than 245 characters
+6 FOR
SET J=$ORDER(HLNODE(J))
if 'J
QUIT
SET ^TMP("DJB",$JOB,I,J)=HLNODE(J)
End DoDot:1
+7 QUIT
