Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSXDODB

PSXDODB.m

Go to the documentation of this file. 
  1. PSXDODB ;BIR/HTW-HL7 Message Conversion ;25 Jul 2002  10:02 PM
  1.  ;;2.0;CMOP;**38,45**;11 Apr 97
  1.  ; This routine loads a Businessware-converted 2.1 message into a mailman message
  1. EN(PATH,FNAME) ; needs directory & file name
  1.  ; force an error in the next line
  1.  I $L(PATH),$L(FNAME) I 1
  1.  E  S PSXERR="0^BAD PATH OR FILENAME" G ERRMSG
  1.  K ^TMP($J,"PSXDOD")
  1.  S GBL="^TMP("_$J_",""PSXDOD"",1)"
  1.  S Y=$$FTG^%ZISH(PATH,FNAME,GBL,3)
  1.  I Y'>0 S PSXERR="9^"_PATH_U_FNAME_U_" DID NOT LOAD" G ERRMSG
  1.  I $D(^TMP($J,"PSXDOD"))'>1 S PSXERR="9^"_PATH_U_FNAME_U_" DID NOT LOAD" G ERRMSG
  1. EN1 ;
  1.  S PSXERR=""
  1.  D EN^PSXDODB1 ;returns PSXERR="" if file is OK ; otherwise it sends negative ack, mail message, copies to pending
  1.  G:PSXERR'="" EXIT
  1.  S GL="^TMP($J,""PSXDOD"")" ; for global indirection
  1.  ; Work through translated 2.1 file and add 1 prefix to site ids
  1.  ; correct Patient name. provider name, remove BTS segment
  1.  F Z=0:0 S Z=$O(^TMP($J,"PSXDOD",Z)) Q:$G(Z)'>0  S G="^TMP($J,""PSXDOD"""_","_Z_")" D
  1.  .I $G(@G)["BTS|" S @G=^TMP($J,"PSXDOD",Z+1) K ^TMP($J,"PSXDOD",Z+1) ;remove BTS segment if found
  1.  .I $G(@G)["$END" S $P(@G,"^",3)=("1"_$P(@G,"^",3)) Q 
  1.  .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)
  1.  .;I $G(@G)["NTE|1" S $P(@G,"|",4)=1_$P(@G,"|",4),$P(@G,"\S\",3)=SITE,NTE1=$G(@G)
  1.  .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)
  1.  .I $G(@G)["RX1" S $P(@G,"|",2)=1_$P(@G,"|",2)
  1.  .;I $G(@G)["ZX1" S $P(@G,"|",3)=SITE
  1.  .I $G(@G)["ZX1|" S $P(@G,"|",3)=1_$P(@G,"|",3) D
  1.  ..S PRVNM=$P(@G,"|",7) Q:PRVNM'[" ,"
  1.  ..S PRVNML=$P(PRVNM," ,"),PRVNMF=$P(PRVNM," ,",2),PRVNM=PRVNML_", "_PRVNMF
  1.  ..S $P(@G,"|",7)=PRVNM
  1.  ..K PRVNM,PRVNML,PRVNMF
  1.  .;remore 2nd and following "^" in patient name
  1.  .I $G(@G)["PID|" D
  1.  .. S PTNM=$P(@G,"|",6),PTNML=$P(PTNM,"^"),PTNMF=$P(PTNM,"^",2,99),PTNMF=$TR(PTNMF,"^"," ")
  1.  .. S PTNM=PTNML_"^"_PTNMF,$P(@G,"|",6)=PTNM
  1.  .. K PTNM,PTNML,PTNMF
  1.  ;
  1. EN2 ;entry for processing file into Vista Messages
  1.  S (LNCNT,MCNT,LMSGLOC,ORDCNT)=0 ;line count, message line count, last $$MSG location, order count
  1.  ; 
  1.  ;D HEADER^PSXDODH1 ; build $$XMIT & NTE|1 and set into Message    
  1.  S XMSUB="DOD CMOP "_SITE_"-"_BATNM_" from "_FACNM,XMDUZ=.5
  1. XMZ D XMZ^XMA2 G:XMZ'>0 XMZ
  1.  S M="^XMB(3.9,XMZ,2)" ; variable reference to MailMan message for construction
  1.  S @M@(1,0)=XM
  1.  S @M@(2,0)=NTE1,MCNT=2
  1.  S LNNUM=3 F  S LNNUM=$O(@GL@(LNNUM)) Q:LNNUM'>0  S LN=@GL@(LNNUM),@M@(MCNT,0)=LN,MCNT=MCNT+1
  1.  S ^XMB(3.9,XMZ,2,0)="^^"_MCNT_U_MCNT_U_DT
  1.  S XMY("S.PSXX CMOP SERVER")="" ;****testing comment out
  1.  ;S XMY(DUZ)="" H 1 ;****TESTING S.PSXX
  1.  D ENT1^XMD
  1.  D EXIT
  1.  Q
  1. PIECE(REC,DLM,XX) ;
  1.  ; Set variable V = piece P of REC using delimiter DLM
  1.  N V,P S V=$P(XX,U),P=$P(XX,U,2),@V=$P(REC,DLM,P)
  1.  Q
  1. PUT(REC,DLM,XX) ;
  1.  ; Set Variable V into piece P of REC using delimiter DLM
  1.  N V,P S V=$P(XX,U),P=$P(XX,U,2)
  1.  S $P(REC,DLM,P)=$G(@V)
  1.  Q
  1. GETELM(STR,PIECES,SEPS) ;
  1.  ; uses STRing and
  1.  ; returns value of the element located by path of pieces and separators
  1.  ; ex: 1st address line = $$getelm(ORC,"22,1","|,^")
  1.  ; or                   = $$getelm(XMIT,"4,2,1","|,\F\,\S|")
  1.  N P,S,PI,V,I S V=STR
  1.  F I=1:1 S PI=$P(PIECES,",",I) Q:PI=""  S P=I,P(I)=PI,S(I)=$P(SEPS,",",I)
  1.  F I=1:1:P S V=$P(V,S(I),P(I))
  1.  Q V
  1. ERRMSG ;
  1. MSGSEQER ;send error message to folks & DOD
  1.  ;W !,"error ",PSXERR
  1.  S DIRHOLD=$$GET1^DIQ(554,1,23)
  1.  S Y=$$GTF^%ZISH($NA(^TMP($J,"PSXDOD",1)),3,DIRHOLD,FNAME)
  1.  S XMSUB="DOD CMOP Safty "_FNAME
  1.  ;S XMY(DUZ)="" ;****TESTING
  1.  S XMY("G.PSXX CMOP MANAGERS")=""
  1.  S XMTEXT="PSXTXT("
  1.  S PSXTXT(1,0)="DOD CMOP HL7 Conversion to  VA CMOP HL7 experienced an error"
  1.  S PSXTXT(2,0)=$G(PSXERR)
  1.  S PSXTXT(3,0)="FILE: "_FNAME
  1.  S PSXTXT(4,0)="A copy of the file has been placed in the hold directory "_DIRHOLD
  1.  D ^XMD
  1.  I $E(IOST)="C" W ! F I=1:1:4 W !,PSXTXT(I,0) I I=4 H 3
  1.  K PSXTXT,DIRHOLD
  1.  Q
  1. EXIT ;
  1.  K BATIDB,BATIDM,BHS,BTS,DLM,DODORD,END,FHS,FNAME,G,GBL,I,J,JJ,LL,LINE,LMSGLOC
  1.  K LN,LNCNT,LNNUM,LSEG,M,MCNT,MSH,NTE1,NTE2,NTE3,NTE4,NTE7,ORC,ORDCNT,ORDCNTB
  1.  K P,P1,P2,P3,PATH,PI,PID,PNAME,PSXERR,PSXTXT,PTCNT,PTCNTB,REC,RX1,RXE,RXID1,RXIDC,RXIDE
  1.  K S,S1,S2,S3,SEG,SEGSEQ,SEPS,STR,STR0,V,VALUE,XM,XX,Y,YY,ZR1,ZX1
  1.  K ADDRESS,BATDTM,BATID,BATIDB,BATIDM,BATNM,DIVISION,DIVNM,DIVNUM,EXPDT,FACNM,FNAME2,FNAME3,ISSDT
  1.  K LSTRFLDT,MAILID,NTE1ADD,NTE1DIV,NTE1LOC,PID0,PIECE,PRVPHY,PSXF,RFLDT,RXCNT,RXDATES,RXNUM,RXZNUM
  1.  K SIG,SITEID,START,TRANDTS,XMZ
  1.  K ^TMP($J,"PSXDOD"),PSXTXT
  1.  Q
  1. LOADTMP ; load data into ^TMP
  1.  K ^TMP($J,"PSXDOD")
  1.  F I=1:1 S X=$G(^XMB(3.9,125829,2,I,0)) Q:X=""  S ^TMP($J,"PSXDOD",I)=X
  1.  Q
  1. CLEARFLS(XX,EXT) ;
  1. LOOP K PSXF,PSXL
  1.  S PATH=$$GET1^DIQ(554,1,XX),PSXF(EXT)=""
  1.  S Y=$$LIST^%ZISH(PATH,"PSXF","PSXL")
  1.  W !,"path ",PATH,!,"files ",EXT
  1.  Q:$D(PSXL)'>1
  1.  S FILE="" F I=0:0 S FILE=$O(PSXL(FILE)) Q:FILE=""  W !,FILE S I=I+1
  1.  Q:I'>0
  1.  K DIR S DIR(0)="Y",DIR("A")="DELETE FILES ?? ",DIR("B")="N" D ^DIR K DIR Q:Y'>0
  1.  W $$DEL^%ZISH(PATH,"PSXL")
  1.  G LOOP
  1.  Q