| 1 | PSXDODH ;BIR/HTW-HL7 Message Conversion ;01/15/02 13:10:52
|
|---|
| 2 | ;;2.0;CMOP;**38**;11 Apr 97
|
|---|
| 3 | ; Convert CMOP transmission messages from HL7 V 2.3.1 to V 2.1
|
|---|
| 4 | START ; Create 2.1 format
|
|---|
| 5 | EN(PATH,FNAME) ; needs directory & file name
|
|---|
| 6 | ; force an error in the next line
|
|---|
| 7 | ;S X=ERROR ; generate an undefined error
|
|---|
| 8 | I $L(PATH),$L(FNAME) I 1
|
|---|
| 9 | E S PSXERR="0^BAD PATH OR FILENAME" G ERRMSG
|
|---|
| 10 | K ^TMP($J,"PSXDOD")
|
|---|
| 11 | S GBL="^TMP("_$J_",""PSXDOD"",1)"
|
|---|
| 12 | S Y=$$FTG^%ZISH(PATH,FNAME,GBL,3)
|
|---|
| 13 | I Y'>0 S PSXERR="9^"_PATH_U_FNAME_U_" DID NOT LOAD" G ERRMSG
|
|---|
| 14 | I $D(^TMP($J,"PSXDOD"))'>1 S PSXERR="9^"_PATH_U_FNAME_U_" DID NOT LOAD" G ERRMSG
|
|---|
| 15 | EN1 ;
|
|---|
| 16 | S PSXERR=""
|
|---|
| 17 | S G="^TMP($J,""PSXDOD"")" ; for global indirection
|
|---|
| 18 | ; Perform Patient Safety check and gather a few variables
|
|---|
| 19 | D BLDSEQ^PSXDODH1,TESTBT^PSXDODH1
|
|---|
| 20 | ;send acknowledgement message
|
|---|
| 21 | K ACK
|
|---|
| 22 | S ACK="MSH|^~\&|VistA||CHCS||20010925202704||ORM^O02|573-013240530|P|2.3.1|||NE|NE"
|
|---|
| 23 | S BATID=BATIDB,PIECE(BHS,"|",11)=BATID
|
|---|
| 24 | D NOW^%DTC S BATDTM=+$$HLDATE^HLFNC(%)
|
|---|
| 25 | F YY="BATID^10","BATDTM^7" D PUT(.ACK,"|",YY)
|
|---|
| 26 | S ACK(1)=ACK,ACK(2)="MSA|CR|"_BATID
|
|---|
| 27 | I PSXERR'="" S ACK(2)=ACK(2)_"|"_PSXERR
|
|---|
| 28 | S FNAME2=$P(FNAME,".",1)_".TAC",PATH=$$GET1^DIQ(554,1,21)
|
|---|
| 29 | I PSXERR'="" D
|
|---|
| 30 | . F XX=1:1:5 S Y=$$GTF^%ZISH("ACK(1)",1,PATH,FNAME2) Q:Y=1 H 4
|
|---|
| 31 | . I Y'=1 D FALERT^PSXDODH1(FNAME2,PATH)
|
|---|
| 32 | . S PATH=$$GET1^DIQ(554,1,22)
|
|---|
| 33 | . F XX=1:1:5 S Y=$$GTF^%ZISH("ACK(1)",1,PATH,FNAME2) Q:Y=1 H 4
|
|---|
| 34 | . I Y'=1 D FALERT^PSXDODH1(FNAME2,PATH)
|
|---|
| 35 | . ;****TESTING
|
|---|
| 36 | I PSXERR'="" G ERRMSG
|
|---|
| 37 | EN2 ;entry for processing file into Vista Messages
|
|---|
| 38 | S (LNCNT,MCNT,LMSGLOC,ORDCNT)=0 ;line count, message line count, last $$MSG location, order count
|
|---|
| 39 | D HEADER^PSXDODH1 ; build $$XMIT & NTE|1 and set into Message
|
|---|
| 40 | S XMSUB="DOD CMOP "_FACNUM_"-"_BATNM_" from "_FACNM,XMDUZ=.5
|
|---|
| 41 | XMZ D XMZ^XMA2
|
|---|
| 42 | S M="^XMB(3.9,XMZ,2)" ; variable reference to MailMan message for construction
|
|---|
| 43 | S @M@(1,0)=XM
|
|---|
| 44 | S @M@(2,0)=NTE1,MCNT=2
|
|---|
| 45 | S LNNUM=3 F S LNNUM=$O(@G@(LNNUM)) Q:LNNUM'>0 S LN=@G@(LNNUM),SEG=$P(LN,"|") S:SEG["NTE" SEG=$P(LN,"|",1,2) D
|
|---|
| 46 | . I "NTE|2,NTE|3,NTE|4"[SEG D NTE234
|
|---|
| 47 | . I SEG="MSH" D MSH
|
|---|
| 48 | . I SEG="PID" D PID
|
|---|
| 49 | . I SEG="ORC" D ORC
|
|---|
| 50 | . I SEG="RXE" D RXE
|
|---|
| 51 | . I SEG="NTE|7" K NTE7 S NTE7=LN
|
|---|
| 52 | . I SEG="ZR1" D ZR1,BUILD,SETRX
|
|---|
| 53 | . I SEG="BTS" D BTS
|
|---|
| 54 | S ^XMB(3.9,XMZ,2,0)="^^"_MCNT_U_MCNT_U_DT
|
|---|
| 55 | S XMY("S.PSXX CMOP SERVER")=""
|
|---|
| 56 | ;S XMY(DUZ)="" ;****TESTING
|
|---|
| 57 | D ENT1^XMD
|
|---|
| 58 | D EXIT
|
|---|
| 59 | Q
|
|---|
| 60 | MSH ;assemble $$MSG, MSH
|
|---|
| 61 | ;MSH|^~\&|CHCS||VistA||20020219144700||ORM^O01|0124-020501408-1|P|2.3.
|
|---|
| 62 | D NTE234CK
|
|---|
| 63 | S DODORD=$P(LN,"|",10),DODORD=$P(DODORD,"-",3)
|
|---|
| 64 | S ORDCNT=ORDCNT+1
|
|---|
| 65 | S MCNT=MCNT+1,@M@(MCNT,0)="$MSG^"_ORDCNT ; Set current order $MSG order value
|
|---|
| 66 | I LMSGLOC S $P(@M@(LMSGLOC,0),"^",3)=MCNT-LMSGLOC ; Set last $MSG's location value of line count
|
|---|
| 67 | S LMSGLOC=MCNT ; store current $MSGs location
|
|---|
| 68 | S MSH="MSH|^~\&|CHCS||VistA||20020219144700||ORM|0124-020501408-1|P|2.1|" ;****Testing
|
|---|
| 69 | S $P(MSH,7,"|")=$P(LN,"|",7),$P(MSH,"|",10)=ORDCNT
|
|---|
| 70 | S MCNT=MCNT+1,@M@(MCNT,0)=MSH
|
|---|
| 71 | Q
|
|---|
| 72 | PID ;
|
|---|
| 73 | ;"PID|||98374511^3^M11||DUCK^CONSTANCE SUSAN||||||1804 MAUMPHREY LANE E.^^HIRANDO^CA^36662||2059880101"
|
|---|
| 74 | S PID0=$P(LN,"PID|",2)
|
|---|
| 75 | F YY="PTID^3","PNAME^5","PADD^11","PHONE^13" D PIECE(PID0,"|",YY)
|
|---|
| 76 | S PT1ST=$P(PNAME,"^",3,99),PTLST=$P(PNAME,"^",1,2) ; VENDOR ADJUSTMENT (REMOVE "^")
|
|---|
| 77 | S PT1ST=$TR(PT1ST,"^"," "),PNAME=PTLST_"^"_PT1ST ; VENDOR ADJUSTMENT (REMOVE "^")
|
|---|
| 78 | K PT1ST,PTLST ; VENDOR ADJUSTMENT (REMOVE "^")
|
|---|
| 79 | S PNAME=$P(PNAME,"^",2,99) ; remove leading "^"
|
|---|
| 80 | S PID="" F YY="PTID^3","PNAME^5","PADD^11","PHONE^13" D PUT(.PID,"|",YY)
|
|---|
| 81 | S PID="PID|"_PID
|
|---|
| 82 | S MCNT=MCNT+1,@M@(MCNT,0)=PID
|
|---|
| 83 | Q
|
|---|
| 84 | ;
|
|---|
| 85 | ORC ;Patient Data from ORC and RXE(2.3.1) parse date pieces for RX1,ZX1
|
|---|
| 86 | ; element mapping contained in document HL7 2.1_2.3 CONVERSION.xls
|
|---|
| 87 | ;S NODE="ORC|NM|0124-NA1281-2||2^1|||^^^20020213^20020315|||25||^HENDERSON^DIANE|||20020213000000||||||||"
|
|---|
| 88 | K RX1,ZX1
|
|---|
| 89 | S ORC=$P(LN,"ORC|",2) ; adjust line for HL7 component counting
|
|---|
| 90 | F YY="RXINDX^2","RXCNT^4","RXDATES^7","PRVPHY^12","ISSDT^15" D PIECE(ORC,"|",YY)
|
|---|
| 91 | S RFLDT=$P(RXDATES,"^",4),EXPDT=$P(RXDATES,"^",5)
|
|---|
| 92 | S MCNT=MCNT+1,@M@(MCNT,0)="ORC|NW|"
|
|---|
| 93 | Q
|
|---|
| 94 | RXE ; Start building RX1. RX1 has data elements from ORC and RXE segments from 3.2.1
|
|---|
| 95 | ;S RXE="RXE|100|A0259^AMOXICILLIN 250MG CAP^L|100||CAP||^TAKE ONE FOUR TIMES A DAY AS DIRECTED THEN TAKE 10 THREE TIMES A DAY AS DIRECTE|||||10||25|NA1281|9||20020213151053"
|
|---|
| 96 | S RXE=$P(LN,"RXE|",2)
|
|---|
| 97 | F YY="QTY^1","DRUGID^2","SIG^7","NUMRFLS^12","VERPHRM^14","RXNUM^15","RFLRMN^16","LSTRFLDT^18" D PIECE(RXE,"|",YY)
|
|---|
| 98 | S RXNUM=$P(RXNUM,"-",2)
|
|---|
| 99 | S ISSDT=$$FMDATE^HLFNC(ISSDT)\1,ISSDT=$$HLDATE^HLFNC(ISSDT) ;strip off time
|
|---|
| 100 | S LSTRFLDT=$$FMDATE^HLFNC(LSTRFLDT)\1,LSTRFLDT=$$HLDATE^HLFNC(LSTRFLDT)
|
|---|
| 101 | S SIG=$E(SIG,2,200)
|
|---|
| 102 | Q
|
|---|
| 103 | ZR1 ;
|
|---|
| 104 | ;S NODE="ZR1|NA1281|ONSC|1||1|(2of10)|CMOP TEST PHARMACY|30|RXNA1281|||20030213000000|"
|
|---|
| 105 | S ZR1=$P(LN,"ZR1|",2)
|
|---|
| 106 | F YY="RXZNUM^1","PATSTAT^2","RNWTYP^3","COPAYID^4","SAFCAP^5","RFLTXT^6","CLNIC^7","DAYSUP^8" D PIECE(ZR1,"|",YY)
|
|---|
| 107 | F YY="BARCODE^9","WARNFLG^10","RGSTMAIL^11" D PIECE(ZR1,"|",YY)
|
|---|
| 108 | S MAILID="M",RXCNT=$P(RXCNT,"~",1),PRVPHY=$$FMNAME^HLFNC(PRVPHY,"^")
|
|---|
| 109 | S LL=$F(PRVPHY," "),$E(PRVPHY,LL-1)="," ;change provider name to FM format "last,first mi jr"
|
|---|
| 110 | S RXZNUM=$P(RXZNUM,"-",2),SITEID=DIVNUM_"^"_DIVNM
|
|---|
| 111 | Q
|
|---|
| 112 | BTS ; FINISH
|
|---|
| 113 | S MCNT=MCNT+1
|
|---|
| 114 | I LMSGLOC S $P(@M@(LMSGLOC,0),"^",3)=MCNT-LMSGLOC
|
|---|
| 115 | S END="$$ENDXMIT^^"_DIVNUM_U_BATNM_U_PTCNTB_U_ORDCNTB
|
|---|
| 116 | ;S END=$$SETELM^PSXDODH1(END,3,"^",693) ;****TESTING
|
|---|
| 117 | ;S END=$$SETELM^PSXDODH1(END,"4,1","^,-",693) ;****TESTING
|
|---|
| 118 | S @M@(MCNT,0)=END
|
|---|
| 119 | Q
|
|---|
| 120 | BUILD ; assemble RX1 & ZX1
|
|---|
| 121 | ;RX1|NA1367|||||||||||60||P0151^PROPRANOLOL HCL 10MG TAB^L|||||3|20020402|2|||20020502|20020226|0124-NA1367-2||||TAKE ONE TABLET TWICE A DAY
|
|---|
| 122 | ;ZX1|NA1367|0124^BALBOA|M|1^1|(2of3)|GORDON ,TEVE||20|20020402||1|1|30||RXNA1367||ONSC|BALBOA
|
|---|
| 123 | ; gather elements from subscripted segment array and assemble the segment
|
|---|
| 124 | S RXINDX="1"_RXINDX ;****Institution file change for site leading 0s
|
|---|
| 125 | S RX1=""
|
|---|
| 126 | F YY="RXINDX^1","QTY^12","DRUGID^14","NUMRFLS^19","ISSDT^20","RFLRMN^21","EXPDT^24","LSTRFLDT^25","RXNUM^26","SIG^30" D PUT(.RX1,"|",YY)
|
|---|
| 127 | S RX1="RX1|"_RX1
|
|---|
| 128 | S ZX1=""
|
|---|
| 129 | S RXCNT=$P(RXCNT,"^",2)
|
|---|
| 130 | F YY="RXZNUM^1","SITEID^2","MAILID^3","RXCNT^4","RFLTXT^5","PRVPHY^6","RGSTMAIL^7","VERPHRM^8","RFLDT^9" D PUT(.ZX1,"|",YY)
|
|---|
| 131 | F YY="COPAYID^10","RNWTYP^11","SAFCAP^12","DAYSUP^13","BARCODE^15","WARNFLG^16","PATSTAT^17","CLNIC^18" D PUT(.ZX1,"|",YY)
|
|---|
| 132 | S ZX1="ZX1|"_ZX1
|
|---|
| 133 | ; change site number for testing
|
|---|
| 134 | ;S RX1=$$SETELM^PSXDODH1(RX1,"2,1","|,-",693) ;****TESTING
|
|---|
| 135 | ;S ZX1=$$SETELM^PSXDODH1(ZX1,"3,1","|,^",693) ;****TESTING
|
|---|
| 136 | Q
|
|---|
| 137 | SETRX ;put RX1,ZX1,NTE7 into mail message
|
|---|
| 138 | S MCNT=MCNT+1,@M@(MCNT,0)=RX1
|
|---|
| 139 | I $L($G(NTE7)) S MCNT=MCNT+1,@M@(MCNT,0)=NTE7 K NTE7
|
|---|
| 140 | S MCNT=MCNT+1,@M@(MCNT,0)=ZX1
|
|---|
| 141 | Q
|
|---|
| 142 | NTE234 ; insure 2 3 4 sequence is in place
|
|---|
| 143 | I SEG="NTE|2" S MCNT=MCNT+1,@M@(MCNT,0)=LN,NTE2=1
|
|---|
| 144 | I SEG="NTE|3" D S MCNT=MCNT+1,@M@(MCNT,0)=LN,NTE3=1
|
|---|
| 145 | . I '$G(NTE2) S MCNT=MCNT+1,@M@(MCNT,0)="NTE|2||",NTE2=1
|
|---|
| 146 | I SEG="NTE|4" D S MCNT=MCNT+1,@M@(MCNT,0)=LN,NTE4=1
|
|---|
| 147 | . I '$G(NTE2) S MCNT=MCNT+1,@M@(MCNT,0)="NTE|2||",NTE2=1
|
|---|
| 148 | . I '$G(NTE3) S MCNT=MCNT+1,@M@(MCNT,0)="NTE|3||",NTE3=1
|
|---|
| 149 | Q
|
|---|
| 150 | NTE234CK ; encounter MSH , insure NTE 2,3,4 in place
|
|---|
| 151 | I '$G(NTE2) S MCNT=MCNT+1,@M@(MCNT,0)="NTE|2||",NTE2=1
|
|---|
| 152 | I '$G(NTE3) S MCNT=MCNT+1,@M@(MCNT,0)="NTE|3||",NTE3=1
|
|---|
| 153 | I '$G(NTE4) S MCNT=MCNT+1,@M@(MCNT,0)="NTE|4||",NTE4=1
|
|---|
| 154 | Q
|
|---|
| 155 | PIECE(REC,DLM,XX) ;
|
|---|
| 156 | ; Set variable V = piece P of REC using delimiter DLM
|
|---|
| 157 | N V,P S V=$P(XX,U),P=$P(XX,U,2),@V=$P(REC,DLM,P)
|
|---|
| 158 | Q
|
|---|
| 159 | PUT(REC,DLM,XX) ;
|
|---|
| 160 | ; Set Variable V into piece P of REC using delimiter DLM
|
|---|
| 161 | N V,P S V=$P(XX,U),P=$P(XX,U,2)
|
|---|
| 162 | S $P(REC,DLM,P)=$G(@V)
|
|---|
| 163 | Q
|
|---|
| 164 | GETELM(STR,PIECES,SEPS) ;
|
|---|
| 165 | ; uses STRing and
|
|---|
| 166 | ; returns value of the element located by path of pieces and separators
|
|---|
| 167 | ; ex: 1st address line = $$getelm(ORC,"22,1","|,^")
|
|---|
| 168 | ; or = $$getelm(XMIT,"4,2,1","|,\F\,\S|")
|
|---|
| 169 | N P,S,PI,V,I S V=STR
|
|---|
| 170 | F I=1:1 S PI=$P(PIECES,",",I) Q:PI="" S P=I,P(I)=PI,S(I)=$P(SEPS,",",I)
|
|---|
| 171 | F I=1:1:P S V=$P(V,S(I),P(I))
|
|---|
| 172 | Q V
|
|---|
| 173 | ERRMSG ;
|
|---|
| 174 | MSGSEQER ;send error message to folks & DOD
|
|---|
| 175 | ;W !,"error ",PSXERR
|
|---|
| 176 | S DIRHOLD=$$GET1^DIQ(554,1,23)
|
|---|
| 177 | S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDOD",1)),3,DIRHOLD,FNAME)
|
|---|
| 178 | S XMSUB="DOD CMOP Safety "_FNAME
|
|---|
| 179 | S XMY("G.PSXX CMOP MANAGERS")=""
|
|---|
| 180 | ;S XMY(DUZ)="" ;***TESTING
|
|---|
| 181 | S XMTEXT="PSXTXT("
|
|---|
| 182 | S PSXTXT(1,0)="DOD CMOP HL7 Conversion to VA CMOP HL7 experienced an error"
|
|---|
| 183 | S PSXTXT(2,0)=$G(PSXERR)
|
|---|
| 184 | S PSXTXT(3,0)="FILE: "_FNAME
|
|---|
| 185 | S PSXTXT(4,0)="A copy of the file has been placed in the hold directory "_DIRHOLD
|
|---|
| 186 | D ^XMD
|
|---|
| 187 | I $E(IOST)="C" W ! F I=1:1:4 W !,PSXTXT(I,0) I I=4 H 3
|
|---|
| 188 | K PSXTXT,DIRHOLD
|
|---|
| 189 | Q
|
|---|
| 190 | EXIT ;
|
|---|
| 191 | K BATIDB,BATIDM,BHS,BTS,DLM,DODORD,END,FHS,FNAME,G,GBL,I,J,JJ,LL,LINE,LMSGLOC
|
|---|
| 192 | K LN,LNCNT,LNNUM,LSEG,M,MCNT,MSH,NTE1,NTE2,NTE3,NTE4,NTE7,ORC,ORDCNT,ORDCNTB
|
|---|
| 193 | K P,P1,P2,P3,PATH,PI,PID,PNAME,PSXERR,PSXTXT,PTCNT,PTCNTB,REC,RX1,RXE,RXID1,RXIDC,RXIDE
|
|---|
| 194 | K S,S1,S2,S3,SEG,SEGSEQ,SEPS,STR,STR0,V,VALUE,XM,XX,Y,YY,ZR1,ZX1
|
|---|
| 195 | K ADDRESS,BATDTM,BATID,BATIDB,BATIDM,BATNM,DIVISION,DIVNM,DIVNUM,EXPDT,FACNM,FNAME2,FNAME3,ISSDT
|
|---|
| 196 | K LSTRFLDT,MAILID,NTE1ADD,NTE1DIV,NTE1LOC,PID0,PIECE,PRVPHY,PSXF,RFLDT,RXCNT,RXDATES,RXNUM,RXZNUM
|
|---|
| 197 | K SIG,SITEID,START,TRANDTS,XMZ
|
|---|
| 198 | K ^TMP($J,"PSXDOD"),PSXTXT
|
|---|
| 199 | Q
|
|---|
| 200 | LOADTMP ; load data into ^TMP
|
|---|
| 201 | K ^TMP($J,"PSXDOD")
|
|---|
| 202 | F I=1:1 S X=$G(^XMB(3.9,125829,2,I,0)) Q:X="" S ^TMP($J,"PSXDOD",I)=X
|
|---|
| 203 | Q
|
|---|
| 204 | CLEARFLS(XX,EXT) ;
|
|---|
| 205 | LOOP K PSXF,PSXL
|
|---|
| 206 | S PATH=$$GET1^DIQ(554,1,XX),PSXF(EXT)=""
|
|---|
| 207 | S Y=$$LIST^%ZISH(PATH,"PSXF","PSXL")
|
|---|
| 208 | W !,"path ",PATH,!,"files ",EXT
|
|---|
| 209 | Q:$D(PSXL)'>1
|
|---|
| 210 | S FILE="" F I=0:0 S FILE=$O(PSXL(FILE)) Q:FILE="" W !,FILE S I=I+1
|
|---|
| 211 | Q:I'>0
|
|---|
| 212 | K DIR S DIR(0)="Y",DIR("A")="DELETE FILES ?? ",DIR("B")="N" D ^DIR K DIR Q:Y'>0
|
|---|
| 213 | W $$DEL^%ZISH(PATH,"PSXL")
|
|---|
| 214 | G LOOP
|
|---|
| 215 | Q
|
|---|
