source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXDODB1.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1PSXDODB1 ;BIR/HTW-HL7 2.1 FILE AND PATIENT SAFETY CHECKS ;01/15/02 13:10:52
2 ;;2.0;CMOP;**45**;11 Apr 97
3 ;
4 Q
5 ;Returns PSXERR="" if passed, if not PSXERR='error format in EDI document'
6 ;called by PSXDODB
7 ;if the file fails a negative ack is placed in the outbox and a mailmessage
8 ;is sent using GRP1^PSXNOTE, and the file is placed in the pending box.
9 ;This process does not move it to archive nor remove it from the inbox.
10EN D BLDSEQ
11 K BTS
12TESTBT ;test the sequence of the messages in the batch
13 ; stored in ^TMP($J,"PSXDOD",I)
14 S PSXERR="",LSEG="",PTCNT=0,ORDCNT=0
15 F LNNUM=1:1 S LN=$G(^TMP($J,"PSXDOD",LNNUM)) Q:LN="" D Q:$G(SEGSTOP)
16 . I $E(LN)="$" S SEG=$P(LN,"^") I 1 ; discern $seg^ vs "seg|"
17 . E S SEG=$P(LN,"|")
18 . S:SEG="NTE" SEG=$P(LN,"|",1,2)
19 . Q:SEG="$$ENDXMIT"
20 . ;I $E(IOST)="C" W " ",SEG," "
21 . I LNNUM=1,SEG="$$XMIT" S LSEG=SEG,XMIT=LN Q
22 . I '$D(SEGSEQ(LSEG,SEG)) S PSXERR=PSXERR_$S($L(PSXERR):"~",1:"")_"SEQ^"_LSEG_U_SEG S LSEG=SEG,SEGSTOP=1 Q
23 . S LSEG=SEG
24 . I "BHS,$MSG,MSH,RX1,ZX1,PID,BTS"[SEG D CHECK
25 ;
26 I PSXERR="",$G(BTS)="" S PSXERR=PSXERR_$S($L(PSXERR):"~",1:"")_"56^" D
27 . I $E(IOST)="C" W !,"Batch Orders ",PSXERR,!,$G(PTCNTB),?40,$G(PTCNT)
28 ;
29 I PSXERR="" G EXIT ; FILE PASSED SAFETY CHECKS
30 ; FILE FAILED SAFETY CHECK send neg ack
31 K ACK
32 S ACK="MSH|^~\&|VistA||CHCS||20010925202704||ORM^O02|573-013240530|P|2.3.1|||NE|NE"
33 S BATID=$G(BATIDB)
34 D NOW^%DTC S BATDTM=+$$HLDATE^HLFNC(%)
35 F YY="BATID^10","BATDTM^7" D PUT(.ACK,"|",YY)
36 S ACK(1)=ACK,ACK(2)="MSA|CR|"_BATID
37 I PSXERR'="" S ACK(2)=ACK(2)_"|"_PSXERR
38 S FNAME2=$P(FNAME,".",1)_".TAC",PATH=$$GET1^DIQ(554,1,21)
39 F XX=1:1:5 S Y=$$GTF^%ZISH("ACK(1)",1,PATH,FNAME2) Q:Y=1 H 4
40 I Y'=1 S GBL="ACK" D FALERT^PSXDODNT(FNAME2,PATH,GBL)
41 S PATH=$$GET1^DIQ(554,1,22)
42 F XX=1:1:5 S Y=$$GTF^%ZISH("ACK(1)",1,PATH,FNAME2) Q:Y=1 H 4
43 I Y'=1 S GBL="ACK" D FALERT^PSXDODNT(FNAME2,PATH,GBL)
44ERRMSG ;send error message to PSXCMOPMGR key and copy file to pending.
45 S DIRHOLD=$$GET1^DIQ(554,1,23)
46 S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDOD",1)),3,DIRHOLD,FNAME)
47 S XMSUB="DOD CMOP Safety ALERT "_FNAME
48 D GRP1^PSXNOTE
49 ;S XMY(DUZ)="" ;***TESTING
50 S XMTEXT="PSXTXT("
51 S PSXTXT(1,0)="DOD CMOP File/Data Patient Safety checker found an error"
52 S PSXTXT(2,0)="FILE: "_FNAME
53 S PSXTXT(3,0)="A copy of the file has been placed in the hold directory "_DIRHOLD
54 S PSXTXT(4,0)="The Error code given back to DoD is:"
55 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
56 D ^XMD
57 I $E(IOST)="C" W ! F I=1:1:4 W !,PSXTXT(I,0) I I=4 H 3
58 K PSXTXT,DIRHOLD
59 G EXIT
60CHECK ;patient safety check; pull variables from segments/elements
61 I SEG="BHS" S BATIDB=$P(LN,"|",11),BHS=LN Q
62 I SEG="$MSG" S ORDSEQG=$P(LN,U,2) Q
63 I SEG="MSH" S BATIDM=$P(LN,"|",10),ORDSEQH=$P(BATIDM,"-",3),BATIDM=$P(BATIDM,"-",1,2) D
64 .I BATIDM'=BATIDB S PSXERR=PSXERR_$S($L(PSXERR):"^",1:"")_"22~"_BATIDM_"~"_ORDSEQH D
65 .. I $E(IOST)="C" W !,"Order Batch ID ",PSXERR,!,BATIDM,?40,BATIDB
66 .I ORDSEQH'=ORDSEQG S PSXERR=PSXERR_$S($L(PSXERR):"^",1:"")_"22~"_ORDSEQG D
67 .. I $E(IOST)="C" W !,"Order Sequence ",PSXERR,!,ORDSEQG,?40,ORDSEQH
68 I SEG="RX1" S RXIDR=$P(LN,"|",27),ORDCNT=ORDCNT+1 Q
69 I SEG="ZX1" S RXIDZ=$P(LN,"|",2) I RXIDZ'=RXIDR S PSXERR=PSXERR_$S($L(PSXERR):"^",1:"")_"44~"_ORDSEQH_U D Q
70 . I $E(IOST)="C" W !,"RX Number ",PSXERR,!,RXIDR,?40,RXIDZ
71 I SEG="PID" S PTCNT=PTCNT+1 Q
72 I SEG="BTS" S PTCNTB=$P(LN,"|",2),ORDCNTB=$P(LN,"|",4),BTS=LN D
73 . I PTCNTB'=PTCNT S PSXERR=PSXERR_$S($L(PSXERR):"^",1:"")_"56~" D
74 .. I $E(IOST)="C" W !,"Batch Orders ",PSXERR,!,PTCNTB,?40,PTCNT
75 . I ORDCNTB'=ORDCNT S PSXERR=PSXERR_$S($L(PSXERR):"^",1:"")_"58~" D
76 .. I $E(IOST)="C" W !,"Batch Totals ",PSXERR,!,ORDCNTB,?40,ORDCNT
77 Q
78BLDSEQ ;build check sequence of SEGMENTS
79 K SEGSEQ
80 F I=1:1 S LINE=$P($T(SEGBLD+I),";;",2,99) Q:LINE["$$END$" D
81 . S LSEG=$P(LINE,";;")
82 . F J=2:1 S SEG=$P(LINE,";;",J) Q:SEG="" S SEGSEQ(LSEG,SEG)="" ;W !,LSEG,?10,SEG
83 Q
84SEGBLD ; data for checking sequencing of segments.
85 ;;$$XMIT;;BHS
86 ;;BHS;;ORC
87 ;;ORC;;NTE|1;;NTE|2;;NTE|3;;NTE|4;;$MSG
88 ;;NTE|1;;NTE|2;;NTE|3;;NTE|4;;$MSG
89 ;;NTE|2;;NTE|2;;NTE|3;;NTE|4;;$MSG
90 ;;NTE|3;;NTE|3;;NTE|4;;$MSG
91 ;;NTE|4;;NTE|4;;$MSG
92 ;;$MSG;;MSH
93 ;;MSH;;PID
94 ;;PID;;NTE|8;;ORC
95 ;;NTE|8;;ORC;;NTE|8
96 ;;ORC;;RX1
97 ;;RX1;;ZX1;;NTE|7
98 ;;NTE|7;;NTE|7;;ZX1
99 ;;ZX1;;ORC;;BTS;;$MSG;;PID;;ORC
100 ;;BTS;;$$ENDXMIT
101 ;;$$END$
102 Q
103PIECE(REC,DLM,XX) ;
104 ; Set variable V = piece P of REC using delimiter DLM
105 N V,P S V=$P(XX,U),P=$P(XX,U,2),@V=$P(REC,DLM,P)
106 Q
107PUT(REC,DLM,XX) ;
108 ; Set Variable V into piece P of REC using delimiter DLM
109 N V,P S V=$P(XX,U),P=$P(XX,U,2)
110 S $P(REC,DLM,P)=$G(@V)
111 Q
112EXIT ;
113 K BTS,SEGSEQ,PTCNT,PTCNTB,ORDCNT,ORDCNTB,RXIDR,RXIDZ,BATID,BATIDM,ORDSEQH,BHS,ORDSEQG
114 K BATDTM,BATIDB,FNAME2,LN,LNNUM,LSEG,SEG,YY,XMIT,LINE,SEGSTOP
115 Q
116LOAD ; used for testing seperate from the call from PSXDODB
117 K ^TMP($J,"PSXDOD")
118 S GBL="^TMP("_$J_",""PSXDOD"",1)"
119 S PATH=$$GET1^DIQ(554,1,20)
120 S FNAME="0029_022751430_2.TRN"
121 S Y=$$FTG^%ZISH(PATH,FNAME,GBL,3)
122 Q
Note: See TracBrowser for help on using the repository browser.