PSXDODB1 ;BIR/HTW-HL7 2.1 FILE AND PATIENT SAFETY CHECKS ;01/15/02 13:10:52
;;2.0;CMOP;**45**;11 Apr 97
;
Q
;Returns PSXERR="" if passed, if not PSXERR='error format in EDI document'
;called by PSXDODB
;if the file fails a negative ack is placed in the outbox and a mailmessage
;is sent using GRP1^PSXNOTE, and the file is placed in the pending box.
;This process does not move it to archive nor remove it from the inbox.
EN D BLDSEQ
K BTS
TESTBT ;test the sequence of the messages in the batch
; stored in ^TMP($J,"PSXDOD",I)
S PSXERR="",LSEG="",PTCNT=0,ORDCNT=0
F LNNUM=1:1 S LN=$G(^TMP($J,"PSXDOD",LNNUM)) Q:LN="" D Q:$G(SEGSTOP)
. I $E(LN)="$" S SEG=$P(LN,"^") I 1 ; discern $seg^ vs "seg|"
. E S SEG=$P(LN,"|")
. S:SEG="NTE" SEG=$P(LN,"|",1,2)
. Q:SEG="$$ENDXMIT"
. ;I $E(IOST)="C" W " ",SEG," "
. I LNNUM=1,SEG="$$XMIT" S LSEG=SEG,XMIT=LN Q
. I '$D(SEGSEQ(LSEG,SEG)) S PSXERR=PSXERR_$S($L(PSXERR):"~",1:"")_"SEQ^"_LSEG_U_SEG S LSEG=SEG,SEGSTOP=1 Q
. S LSEG=SEG
. I "BHS,$MSG,MSH,RX1,ZX1,PID,BTS"[SEG D CHECK
;
I PSXERR="",$G(BTS)="" S PSXERR=PSXERR_$S($L(PSXERR):"~",1:"")_"56^" D
. I $E(IOST)="C" W !,"Batch Orders ",PSXERR,!,$G(PTCNTB),?40,$G(PTCNT)
;
I PSXERR="" G EXIT ; FILE PASSED SAFETY CHECKS
; FILE FAILED SAFETY CHECK send neg ack
K ACK
S ACK="MSH|^~\&|VistA||CHCS||20010925202704||ORM^O02|573-013240530|P|2.3.1|||NE|NE"
S BATID=$G(BATIDB)
D NOW^%DTC S BATDTM=+$$HLDATE^HLFNC(%)
F YY="BATID^10","BATDTM^7" D PUT(.ACK,"|",YY)
S ACK(1)=ACK,ACK(2)="MSA|CR|"_BATID
I PSXERR'="" S ACK(2)=ACK(2)_"|"_PSXERR
S FNAME2=$P(FNAME,".",1)_".TAC",PATH=$$GET1^DIQ(554,1,21)
F XX=1:1:5 S Y=$$GTF^%ZISH("ACK(1)",1,PATH,FNAME2) Q:Y=1 H 4
I Y'=1 S GBL="ACK" D FALERT^PSXDODNT(FNAME2,PATH,GBL)
S PATH=$$GET1^DIQ(554,1,22)
F XX=1:1:5 S Y=$$GTF^%ZISH("ACK(1)",1,PATH,FNAME2) Q:Y=1 H 4
I Y'=1 S GBL="ACK" D FALERT^PSXDODNT(FNAME2,PATH,GBL)
ERRMSG ;send error message to PSXCMOPMGR key and copy file to pending.
S DIRHOLD=$$GET1^DIQ(554,1,23)
S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDOD",1)),3,DIRHOLD,FNAME)
S XMSUB="DOD CMOP Safety ALERT "_FNAME
D GRP1^PSXNOTE
;S XMY(DUZ)="" ;***TESTING
S XMTEXT="PSXTXT("
S PSXTXT(1,0)="DOD CMOP File/Data Patient Safety checker found an error"
S PSXTXT(2,0)="FILE: "_FNAME
S PSXTXT(3,0)="A copy of the file has been placed in the hold directory "_DIRHOLD
S PSXTXT(4,0)="The Error code given back to DoD is:"
S L=$L(PSXERR) F I=1:1:1+(L\200) S XX=$E(PSXERR,(I-1)*200,I*200),PSXTXT(4+I,0)=XX
D ^XMD
I $E(IOST)="C" W ! F I=1:1:4 W !,PSXTXT(I,0) I I=4 H 3
K PSXTXT,DIRHOLD
G EXIT
CHECK ;patient safety check; pull variables from segments/elements
I SEG="BHS" S BATIDB=$P(LN,"|",11),BHS=LN Q
I SEG="$MSG" S ORDSEQG=$P(LN,U,2) Q
I SEG="MSH" S BATIDM=$P(LN,"|",10),ORDSEQH=$P(BATIDM,"-",3),BATIDM=$P(BATIDM,"-",1,2) D
.I BATIDM'=BATIDB S PSXERR=PSXERR_$S($L(PSXERR):"^",1:"")_"22~"_BATIDM_"~"_ORDSEQH D
.. I $E(IOST)="C" W !,"Order Batch ID ",PSXERR,!,BATIDM,?40,BATIDB
.I ORDSEQH'=ORDSEQG S PSXERR=PSXERR_$S($L(PSXERR):"^",1:"")_"22~"_ORDSEQG D
.. I $E(IOST)="C" W !,"Order Sequence ",PSXERR,!,ORDSEQG,?40,ORDSEQH
I SEG="RX1" S RXIDR=$P(LN,"|",27),ORDCNT=ORDCNT+1 Q
I SEG="ZX1" S RXIDZ=$P(LN,"|",2) I RXIDZ'=RXIDR S PSXERR=PSXERR_$S($L(PSXERR):"^",1:"")_"44~"_ORDSEQH_U D Q
. I $E(IOST)="C" W !,"RX Number ",PSXERR,!,RXIDR,?40,RXIDZ
I SEG="PID" S PTCNT=PTCNT+1 Q
I SEG="BTS" S PTCNTB=$P(LN,"|",2),ORDCNTB=$P(LN,"|",4),BTS=LN D
. I PTCNTB'=PTCNT S PSXERR=PSXERR_$S($L(PSXERR):"^",1:"")_"56~" D
.. I $E(IOST)="C" W !,"Batch Orders ",PSXERR,!,PTCNTB,?40,PTCNT
. I ORDCNTB'=ORDCNT S PSXERR=PSXERR_$S($L(PSXERR):"^",1:"")_"58~" D
.. I $E(IOST)="C" W !,"Batch Totals ",PSXERR,!,ORDCNTB,?40,ORDCNT
Q
BLDSEQ ;build check sequence of SEGMENTS
K SEGSEQ
F I=1:1 S LINE=$P($T(SEGBLD+I),";;",2,99) Q:LINE["$$END$" D
. S LSEG=$P(LINE,";;")
. F J=2:1 S SEG=$P(LINE,";;",J) Q:SEG="" S SEGSEQ(LSEG,SEG)="" ;W !,LSEG,?10,SEG
Q
SEGBLD ; data for checking sequencing of segments.
;;$$XMIT;;BHS
;;BHS;;ORC
;;ORC;;NTE|1;;NTE|2;;NTE|3;;NTE|4;;$MSG
;;NTE|1;;NTE|2;;NTE|3;;NTE|4;;$MSG
;;NTE|2;;NTE|2;;NTE|3;;NTE|4;;$MSG
;;NTE|3;;NTE|3;;NTE|4;;$MSG
;;NTE|4;;NTE|4;;$MSG
;;$MSG;;MSH
;;MSH;;PID
;;PID;;NTE|8;;ORC
;;NTE|8;;ORC;;NTE|8
;;ORC;;RX1
;;RX1;;ZX1;;NTE|7
;;NTE|7;;NTE|7;;ZX1
;;ZX1;;ORC;;BTS;;$MSG;;PID;;ORC
;;BTS;;$$ENDXMIT
;;$$END$
Q
PIECE(REC,DLM,XX) ;
; Set variable V = piece P of REC using delimiter DLM
N V,P S V=$P(XX,U),P=$P(XX,U,2),@V=$P(REC,DLM,P)
Q
PUT(REC,DLM,XX) ;
; Set Variable V into piece P of REC using delimiter DLM
N V,P S V=$P(XX,U),P=$P(XX,U,2)
S $P(REC,DLM,P)=$G(@V)
Q
EXIT ;
K BTS,SEGSEQ,PTCNT,PTCNTB,ORDCNT,ORDCNTB,RXIDR,RXIDZ,BATID,BATIDM,ORDSEQH,BHS,ORDSEQG
K BATDTM,BATIDB,FNAME2,LN,LNNUM,LSEG,SEG,YY,XMIT,LINE,SEGSTOP
Q
LOAD ; used for testing seperate from the call from PSXDODB
K ^TMP($J,"PSXDOD")
S GBL="^TMP("_$J_",""PSXDOD"",1)"
S PATH=$$GET1^DIQ(554,1,20)
S FNAME="0029_022751430_2.TRN"
S Y=$$FTG^%ZISH(PATH,FNAME,GBL,3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXDODB1 5095 printed Apr 09, 2024@20:49:16 Page 2
PSXDODB1 ;BIR/HTW-HL7 2.1 FILE AND PATIENT SAFETY CHECKS ;01/15/02 13:10:52
+1 ;;2.0;CMOP;**45**;11 Apr 97
+2 ;
+3 QUIT
+4 ;Returns PSXERR="" if passed, if not PSXERR='error format in EDI document'
+5 ;called by PSXDODB
+6 ;if the file fails a negative ack is placed in the outbox and a mailmessage
+7 ;is sent using GRP1^PSXNOTE, and the file is placed in the pending box.
+8 ;This process does not move it to archive nor remove it from the inbox.
EN DO BLDSEQ
+1 KILL BTS
TESTBT ;test the sequence of the messages in the batch
+1 ; stored in ^TMP($J,"PSXDOD",I)
+2 SET PSXERR=""
SET LSEG=""
SET PTCNT=0
SET ORDCNT=0
+3 FOR LNNUM=1:1
SET LN=$GET(^TMP($JOB,"PSXDOD",LNNUM))
if LN=""
QUIT
Begin DoDot:1
+4 ; discern $seg^ vs "seg|"
IF $EXTRACT(LN)="$"
SET SEG=$PIECE(LN,"^")
IF 1
+5 IF '$TEST
SET SEG=$PIECE(LN,"|")
+6 if SEG="NTE"
SET SEG=$PIECE(LN,"|",1,2)
+7 if SEG="$$ENDXMIT"
QUIT
+8 ;I $E(IOST)="C" W " ",SEG," "
+9 IF LNNUM=1
IF SEG="$$XMIT"
SET LSEG=SEG
SET XMIT=LN
QUIT
+10 IF '$DATA(SEGSEQ(LSEG,SEG))
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"~",1:"")_"SEQ^"_LSEG_U_SEG
SET LSEG=SEG
SET SEGSTOP=1
QUIT
+11 SET LSEG=SEG
+12 IF "BHS,$MSG,MSH,RX1,ZX1,PID,BTS"[SEG
DO CHECK
End DoDot:1
if $GET(SEGSTOP)
QUIT
+13 ;
+14 IF PSXERR=""
IF $GET(BTS)=""
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"~",1:"")_"56^"
Begin DoDot:1
+15 IF $EXTRACT(IOST)="C"
WRITE !,"Batch Orders ",PSXERR,!,$GET(PTCNTB),?40,$GET(PTCNT)
End DoDot:1
+16 ;
+17 ; FILE PASSED SAFETY CHECKS
IF PSXERR=""
GOTO EXIT
+18 ; FILE FAILED SAFETY CHECK send neg ack
+19 KILL ACK
+20 SET ACK="MSH|^~\&|VistA||CHCS||20010925202704||ORM^O02|573-013240530|P|2.3.1|||NE|NE"
+21 SET BATID=$GET(BATIDB)
+22 DO NOW^%DTC
SET BATDTM=+$$HLDATE^HLFNC(%)
+23 FOR YY="BATID^10","BATDTM^7"
DO PUT(.ACK,"|",YY)
+24 SET ACK(1)=ACK
SET ACK(2)="MSA|CR|"_BATID
+25 IF PSXERR'=""
SET ACK(2)=ACK(2)_"|"_PSXERR
+26 SET FNAME2=$PIECE(FNAME,".",1)_".TAC"
SET PATH=$$GET1^DIQ(554,1,21)
+27 FOR XX=1:1:5
SET Y=$$GTF^%ZISH("ACK(1)",1,PATH,FNAME2)
if Y=1
QUIT
HANG 4
+28 IF Y'=1
SET GBL="ACK"
DO FALERT^PSXDODNT(FNAME2,PATH,GBL)
+29 SET PATH=$$GET1^DIQ(554,1,22)
+30 FOR XX=1:1:5
SET Y=$$GTF^%ZISH("ACK(1)",1,PATH,FNAME2)
if Y=1
QUIT
HANG 4
+31 IF Y'=1
SET GBL="ACK"
DO FALERT^PSXDODNT(FNAME2,PATH,GBL)
ERRMSG ;send error message to PSXCMOPMGR key and copy file to pending.
+1 SET DIRHOLD=$$GET1^DIQ(554,1,23)
+2 SET Y=$$GTF^%ZISH($NAME(^TMP($JOB,"PSXDOD",1)),3,DIRHOLD,FNAME)
+3 SET XMSUB="DOD CMOP Safety ALERT "_FNAME
+4 DO GRP1^PSXNOTE
+5 ;S XMY(DUZ)="" ;***TESTING
+6 SET XMTEXT="PSXTXT("
+7 SET PSXTXT(1,0)="DOD CMOP File/Data Patient Safety checker found an error"
+8 SET PSXTXT(2,0)="FILE: "_FNAME
+9 SET PSXTXT(3,0)="A copy of the file has been placed in the hold directory "_DIRHOLD
+10 SET PSXTXT(4,0)="The Error code given back to DoD is:"
+11 SET L=$LENGTH(PSXERR)
FOR I=1:1:1+(L\200)
SET XX=$EXTRACT(PSXERR,(I-1)*200,I*200)
SET PSXTXT(4+I,0)=XX
+12 DO ^XMD
+13 IF $EXTRACT(IOST)="C"
WRITE !
FOR I=1:1:4
WRITE !,PSXTXT(I,0)
IF I=4
HANG 3
+14 KILL PSXTXT,DIRHOLD
+15 GOTO EXIT
CHECK ;patient safety check; pull variables from segments/elements
+1 IF SEG="BHS"
SET BATIDB=$PIECE(LN,"|",11)
SET BHS=LN
QUIT
+2 IF SEG="$MSG"
SET ORDSEQG=$PIECE(LN,U,2)
QUIT
+3 IF SEG="MSH"
SET BATIDM=$PIECE(LN,"|",10)
SET ORDSEQH=$PIECE(BATIDM,"-",3)
SET BATIDM=$PIECE(BATIDM,"-",1,2)
Begin DoDot:1
+4 IF BATIDM'=BATIDB
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"^",1:"")_"22~"_BATIDM_"~"_ORDSEQH
Begin DoDot:2
+5 IF $EXTRACT(IOST)="C"
WRITE !,"Order Batch ID ",PSXERR,!,BATIDM,?40,BATIDB
End DoDot:2
+6 IF ORDSEQH'=ORDSEQG
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"^",1:"")_"22~"_ORDSEQG
Begin DoDot:2
+7 IF $EXTRACT(IOST)="C"
WRITE !,"Order Sequence ",PSXERR,!,ORDSEQG,?40,ORDSEQH
End DoDot:2
End DoDot:1
+8 IF SEG="RX1"
SET RXIDR=$PIECE(LN,"|",27)
SET ORDCNT=ORDCNT+1
QUIT
+9 IF SEG="ZX1"
SET RXIDZ=$PIECE(LN,"|",2)
IF RXIDZ'=RXIDR
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"^",1:"")_"44~"_ORDSEQH_U
Begin DoDot:1
+10 IF $EXTRACT(IOST)="C"
WRITE !,"RX Number ",PSXERR,!,RXIDR,?40,RXIDZ
End DoDot:1
QUIT
+11 IF SEG="PID"
SET PTCNT=PTCNT+1
QUIT
+12 IF SEG="BTS"
SET PTCNTB=$PIECE(LN,"|",2)
SET ORDCNTB=$PIECE(LN,"|",4)
SET BTS=LN
Begin DoDot:1
+13 IF PTCNTB'=PTCNT
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"^",1:"")_"56~"
Begin DoDot:2
+14 IF $EXTRACT(IOST)="C"
WRITE !,"Batch Orders ",PSXERR,!,PTCNTB,?40,PTCNT
End DoDot:2
+15 IF ORDCNTB'=ORDCNT
SET PSXERR=PSXERR_$SELECT($LENGTH(PSXERR):"^",1:"")_"58~"
Begin DoDot:2
+16 IF $EXTRACT(IOST)="C"
WRITE !,"Batch Totals ",PSXERR,!,ORDCNTB,?40,ORDCNT
End DoDot:2
End DoDot:1
+17 QUIT
BLDSEQ ;build check sequence of SEGMENTS
+1 KILL SEGSEQ
+2 FOR I=1:1
SET LINE=$PIECE($TEXT(SEGBLD+I),";;",2,99)
if LINE["$$END$"
QUIT
Begin DoDot:1
+3 SET LSEG=$PIECE(LINE,";;")
+4 ;W !,LSEG,?10,SEG
FOR J=2:1
SET SEG=$PIECE(LINE,";;",J)
if SEG=""
QUIT
SET SEGSEQ(LSEG,SEG)=""
End DoDot:1
+5 QUIT
SEGBLD ; data for checking sequencing of segments.
+1 ;;$$XMIT;;BHS
+2 ;;BHS;;ORC
+3 ;;ORC;;NTE|1;;NTE|2;;NTE|3;;NTE|4;;$MSG
+4 ;;NTE|1;;NTE|2;;NTE|3;;NTE|4;;$MSG
+5 ;;NTE|2;;NTE|2;;NTE|3;;NTE|4;;$MSG
+6 ;;NTE|3;;NTE|3;;NTE|4;;$MSG
+7 ;;NTE|4;;NTE|4;;$MSG
+8 ;;$MSG;;MSH
+9 ;;MSH;;PID
+10 ;;PID;;NTE|8;;ORC
+11 ;;NTE|8;;ORC;;NTE|8
+12 ;;ORC;;RX1
+13 ;;RX1;;ZX1;;NTE|7
+14 ;;NTE|7;;NTE|7;;ZX1
+15 ;;ZX1;;ORC;;BTS;;$MSG;;PID;;ORC
+16 ;;BTS;;$$ENDXMIT
+17 ;;$$END$
+18 QUIT
PIECE(REC,DLM,XX) ;
+1 ; Set variable V = piece P of REC using delimiter DLM
+2 NEW V,P
SET V=$PIECE(XX,U)
SET P=$PIECE(XX,U,2)
SET @V=$PIECE(REC,DLM,P)
+3 QUIT
PUT(REC,DLM,XX) ;
+1 ; Set Variable V into piece P of REC using delimiter DLM
+2 NEW V,P
SET V=$PIECE(XX,U)
SET P=$PIECE(XX,U,2)
+3 SET $PIECE(REC,DLM,P)=$GET(@V)
+4 QUIT
EXIT ;
+1 KILL BTS,SEGSEQ,PTCNT,PTCNTB,ORDCNT,ORDCNTB,RXIDR,RXIDZ,BATID,BATIDM,ORDSEQH,BHS,ORDSEQG
+2 KILL BATDTM,BATIDB,FNAME2,LN,LNNUM,LSEG,SEG,YY,XMIT,LINE,SEGSTOP
+3 QUIT
LOAD ; used for testing seperate from the call from PSXDODB
+1 KILL ^TMP($JOB,"PSXDOD")
+2 SET GBL="^TMP("_$JOB_",""PSXDOD"",1)"
+3 SET PATH=$$GET1^DIQ(554,1,20)
+4 SET FNAME="0029_022751430_2.TRN"
+5 SET Y=$$FTG^%ZISH(PATH,FNAME,GBL,3)
+6 QUIT
