source: FOIAVistA/trunk/r/CMOP-PSX/PSXDODB.m@ 1783

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

initial load of FOIAVistA 6/30/08 version

File size: 4.9 KB
Line 
1PSXDODB ;BIR/HTW-HL7 Message Conversion ;25 Jul 2002 10:02 PM
2 ;;2.0;CMOP;**38,45**;11 Apr 97
3 ; This routine loads a Businessware-converted 2.1 message into a mailman message
4EN(PATH,FNAME) ; needs directory & file name
5 ; force an error in the next line
6 I $L(PATH),$L(FNAME) I 1
7 E S PSXERR="0^BAD PATH OR FILENAME" G ERRMSG
8 K ^TMP($J,"PSXDOD")
9 S GBL="^TMP("_$J_",""PSXDOD"",1)"
10 S Y=$$FTG^%ZISH(PATH,FNAME,GBL,3)
11 I Y'>0 S PSXERR="9^"_PATH_U_FNAME_U_" DID NOT LOAD" G ERRMSG
12 I $D(^TMP($J,"PSXDOD"))'>1 S PSXERR="9^"_PATH_U_FNAME_U_" DID NOT LOAD" G ERRMSG
13EN1 ;
14 S PSXERR=""
15 D EN^PSXDODB1 ;returns PSXERR="" if file is OK ; otherwise it sends negative ack, mail message, copies to pending
16 G:PSXERR'="" EXIT
17 S GL="^TMP($J,""PSXDOD"")" ; for global indirection
18 ; Work through translated 2.1 file and add 1 prefix to site ids
19 ; correct Patient name. provider name, remove BTS segment
20 F Z=0:0 S Z=$O(^TMP($J,"PSXDOD",Z)) Q:$G(Z)'>0 S G="^TMP($J,""PSXDOD"""_","_Z_")" D
21 .I $G(@G)["BTS|" S @G=^TMP($J,"PSXDOD",Z+1) K ^TMP($J,"PSXDOD",Z+1) ;remove BTS segment if found
22 .I $G(@G)["$END" S $P(@G,"^",3)=("1"_$P(@G,"^",3)) Q
23 .I $G(@G)["$XMIT" S SITE="1"_$P(@G,"^",5),$P(@G,"^",5)=SITE,$P(@G,"^",11)=SITE,BATNM=$P(@G,"^",2),FACNM=$P(@G,"^",3),BATID=SITE_BATNM,XX=$P(@G,U,6),$P(@G,U,6)=$$FMDATE^HLFNC(XX),XM=$G(@G)
24 .;I $G(@G)["NTE|1" S $P(@G,"|",4)=1_$P(@G,"|",4),$P(@G,"\S\",3)=SITE,NTE1=$G(@G)
25 .I $G(@G)["NTE|1" S $P(@G,"|",4)=1_$P(@G,"|",4),F1=$P(@G,"\F\",1),$P(F1,"\S\",3)=SITE,$P(@G,"\F\",1)=F1,NTE1=$G(@G)
26 .I $G(@G)["RX1" S $P(@G,"|",2)=1_$P(@G,"|",2)
27 .;I $G(@G)["ZX1" S $P(@G,"|",3)=SITE
28 .I $G(@G)["ZX1|" S $P(@G,"|",3)=1_$P(@G,"|",3) D
29 ..S PRVNM=$P(@G,"|",7) Q:PRVNM'[" ,"
30 ..S PRVNML=$P(PRVNM," ,"),PRVNMF=$P(PRVNM," ,",2),PRVNM=PRVNML_", "_PRVNMF
31 ..S $P(@G,"|",7)=PRVNM
32 ..K PRVNM,PRVNML,PRVNMF
33 .;remore 2nd and following "^" in patient name
34 .I $G(@G)["PID|" D
35 .. S PTNM=$P(@G,"|",6),PTNML=$P(PTNM,"^"),PTNMF=$P(PTNM,"^",2,99),PTNMF=$TR(PTNMF,"^"," ")
36 .. S PTNM=PTNML_"^"_PTNMF,$P(@G,"|",6)=PTNM
37 .. K PTNM,PTNML,PTNMF
38 ;
39EN2 ;entry for processing file into Vista Messages
40 S (LNCNT,MCNT,LMSGLOC,ORDCNT)=0 ;line count, message line count, last $$MSG location, order count
41 ;
42 ;D HEADER^PSXDODH1 ; build $$XMIT & NTE|1 and set into Message
43 S XMSUB="DOD CMOP "_SITE_"-"_BATNM_" from "_FACNM,XMDUZ=.5
44XMZ D XMZ^XMA2 G:XMZ'>0 XMZ
45 S M="^XMB(3.9,XMZ,2)" ; variable reference to MailMan message for construction
46 S @M@(1,0)=XM
47 S @M@(2,0)=NTE1,MCNT=2
48 S LNNUM=3 F S LNNUM=$O(@GL@(LNNUM)) Q:LNNUM'>0 S LN=@GL@(LNNUM),@M@(MCNT,0)=LN,MCNT=MCNT+1
49 S ^XMB(3.9,XMZ,2,0)="^^"_MCNT_U_MCNT_U_DT
50 S XMY("S.PSXX CMOP SERVER")="" ;****testing comment out
51 ;S XMY(DUZ)="" H 1 ;****TESTING S.PSXX
52 D ENT1^XMD
53 D EXIT
54 Q
55PIECE(REC,DLM,XX) ;
56 ; Set variable V = piece P of REC using delimiter DLM
57 N V,P S V=$P(XX,U),P=$P(XX,U,2),@V=$P(REC,DLM,P)
58 Q
59PUT(REC,DLM,XX) ;
60 ; Set Variable V into piece P of REC using delimiter DLM
61 N V,P S V=$P(XX,U),P=$P(XX,U,2)
62 S $P(REC,DLM,P)=$G(@V)
63 Q
64GETELM(STR,PIECES,SEPS) ;
65 ; uses STRing and
66 ; returns value of the element located by path of pieces and separators
67 ; ex: 1st address line = $$getelm(ORC,"22,1","|,^")
68 ; or = $$getelm(XMIT,"4,2,1","|,\F\,\S|")
69 N P,S,PI,V,I S V=STR
70 F I=1:1 S PI=$P(PIECES,",",I) Q:PI="" S P=I,P(I)=PI,S(I)=$P(SEPS,",",I)
71 F I=1:1:P S V=$P(V,S(I),P(I))
72 Q V
73ERRMSG ;
74MSGSEQER ;send error message to folks & DOD
75 ;W !,"error ",PSXERR
76 S DIRHOLD=$$GET1^DIQ(554,1,23)
77 S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDOD",1)),3,DIRHOLD,FNAME)
78 S XMSUB="DOD CMOP Safty "_FNAME
79 ;S XMY(DUZ)="" ;****TESTING
80 S XMY("G.PSXX CMOP MANAGERS")=""
81 S XMTEXT="PSXTXT("
82 S PSXTXT(1,0)="DOD CMOP HL7 Conversion to VA CMOP HL7 experienced an error"
83 S PSXTXT(2,0)=$G(PSXERR)
84 S PSXTXT(3,0)="FILE: "_FNAME
85 S PSXTXT(4,0)="A copy of the file has been placed in the hold directory "_DIRHOLD
86 D ^XMD
87 I $E(IOST)="C" W ! F I=1:1:4 W !,PSXTXT(I,0) I I=4 H 3
88 K PSXTXT,DIRHOLD
89 Q
90EXIT ;
91 K BATIDB,BATIDM,BHS,BTS,DLM,DODORD,END,FHS,FNAME,G,GBL,I,J,JJ,LL,LINE,LMSGLOC
92 K LN,LNCNT,LNNUM,LSEG,M,MCNT,MSH,NTE1,NTE2,NTE3,NTE4,NTE7,ORC,ORDCNT,ORDCNTB
93 K P,P1,P2,P3,PATH,PI,PID,PNAME,PSXERR,PSXTXT,PTCNT,PTCNTB,REC,RX1,RXE,RXID1,RXIDC,RXIDE
94 K S,S1,S2,S3,SEG,SEGSEQ,SEPS,STR,STR0,V,VALUE,XM,XX,Y,YY,ZR1,ZX1
95 K ADDRESS,BATDTM,BATID,BATIDB,BATIDM,BATNM,DIVISION,DIVNM,DIVNUM,EXPDT,FACNM,FNAME2,FNAME3,ISSDT
96 K LSTRFLDT,MAILID,NTE1ADD,NTE1DIV,NTE1LOC,PID0,PIECE,PRVPHY,PSXF,RFLDT,RXCNT,RXDATES,RXNUM,RXZNUM
97 K SIG,SITEID,START,TRANDTS,XMZ
98 K ^TMP($J,"PSXDOD"),PSXTXT
99 Q
100LOADTMP ; load data into ^TMP
101 K ^TMP($J,"PSXDOD")
102 F I=1:1 S X=$G(^XMB(3.9,125829,2,I,0)) Q:X="" S ^TMP($J,"PSXDOD",I)=X
103 Q
104CLEARFLS(XX,EXT) ;
105LOOP K PSXF,PSXL
106 S PATH=$$GET1^DIQ(554,1,XX),PSXF(EXT)=""
107 S Y=$$LIST^%ZISH(PATH,"PSXF","PSXL")
108 W !,"path ",PATH,!,"files ",EXT
109 Q:$D(PSXL)'>1
110 S FILE="" F I=0:0 S FILE=$O(PSXL(FILE)) Q:FILE="" W !,FILE S I=I+1
111 Q:I'>0
112 K DIR S DIR(0)="Y",DIR("A")="DELETE FILES ?? ",DIR("B")="N" D ^DIR K DIR Q:Y'>0
113 W $$DEL^%ZISH(PATH,"PSXL")
114 G LOOP
115 Q
Note: See TracBrowser for help on using the repository browser.