PSXDODB1.m

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 ---PSXDODB1   5095     printed  Mar 13, 2025@20:48:42                                                                                                                                                                                                    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