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

ORRDI1.m

Go to the documentation of this file. 
  1. ORRDI1 ;SLC/JMH - RDI routines for API supporting CDS data; 3/24/05 2:31 [8/11/05 6:25am] ; 1/11/07 8:33am
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**232**;Dec 17, 1997;Build 19
  1.  ;
  1. GET(DFN,DOMAIN) ;API for packages to call in order to get data from HDR for
  1.  ; check if in OUTAGE state and quit if so
  1.  I $$DOWNXVAL^ORRDI2 D  Q -1
  1.  .K ^XTMP("ORRDI",DOMAIN,DFN)
  1.  .S ^XTMP("ORRDI",DOMAIN,DFN,0)="^^-1"
  1.  ;  order checking purposes
  1.  N I,ORCACHE,ORRET,ORRECDT
  1.  ;check if data was just retrieved a short time ago and if so return
  1.  S ORRECDT=$P($G(^XTMP("ORRDI",DOMAIN,DFN,0)),U)
  1.  S ORCACHE=$$GET^XPAR("SYS","OR RDI CACHE TIME")
  1.  I $$FMDIFF^XLFDT($$NOW^XLFDT,ORRECDT,2)<(60*ORCACHE),$P(^XTMP("ORRDI",DOMAIN,DFN,0),U,3)>-1 S ORRET=$P(^XTMP("ORRDI",DOMAIN,DFN,0),U,3)
  1.  ;check if there has been an HDR down condition within last minute
  1.  I $$FMDIFF^XLFDT($$NOW^XLFDT,$P($G(^XTMP("ORRDI","PSOO",DFN,0)),U),2)<60,$P($G(^XTMP("ORRDI","PSOO",DFN,0)),U,3)<0 S ORRET=$P($G(^XTMP("ORRDI","PSOO",DFN,0)),U,3)
  1.  I $$FMDIFF^XLFDT($$NOW^XLFDT,$P($G(^XTMP("ORRDI","ART",DFN,0)),U),2)<60,$P($G(^XTMP("ORRDI","ART",DFN,0)),U,3)<0 S ORRET=$P($G(^XTMP("ORRDI","ART",DFN,0)),U,3)
  1.  ;if data is not "fresh" then go get it
  1.  I '$L($G(ORRET)) D
  1.  .S ORRET=$$RETRIEVE(DFN,DOMAIN)
  1.  .I ORRET>-1 S ^XTMP("ORRDI","OUTAGE INFO","FAILURES")=0
  1.  .I ORRET'>-1 D
  1.  ..Q:$P(ORRET,U,2)="PATIENT ICN NOT FOUND"
  1.  ..S ^XTMP("ORRDI","OUTAGE INFO","FAILURES")=$$FAILXVAL^ORRDI2+1
  1.  ..I $$FAILXVAL^ORRDI2'<$$FAILPVAL^ORRDI2 D
  1.  ...S ^XTMP("ORRDI","OUTAGE INFO","DOWN")=1
  1.  ...D SPAWN^ORRDI2
  1.  S $P(^XTMP("ORRDI",DOMAIN,DFN,0),U,3)=ORRET
  1.  I ORRET<1 D
  1.  .N TEMP S TEMP=^XTMP("ORRDI",DOMAIN,DFN,0)
  1.  .K ^XTMP("ORRDI",DOMAIN,DFN)
  1.  .S ^XTMP("ORRDI",DOMAIN,DFN,0)=TEMP
  1.  Q ORRET
  1. HAVEHDR() ;call to check if this system has an HDR to perform order checks
  1.  ;  against
  1.  ;check parameter to see if there is an HDR and returns positive if so
  1.  I $$GET^XPAR("SYS","OR RDI HAVE HDR") Q 1
  1.  ;returns negative because the parameter indicates there is no HDR
  1.  Q 0
  1. RETRIEVE(DFN,DOMAIN) ;actually go get the data from CDS
  1.  K ^XTMP("ORRDI",DOMAIN,DFN)
  1.  N START,END,HLL,HLA,ORFS,ORCS,ORRS,ORES,ORSS
  1.  N Y,ORRSLT,ICN,WHATOUT,HLNEXT,HLNODE,HLQUIT,ORHLP,RET,HL,HLDOM,HLDONE1,HLECH,HLFS,HLINSTN,HLMTIEN,HLPARAM,HLQ,STATUS,PRE
  1.  S (ORFS,ORCS,ORRS,ORES,ORSS)=""
  1.  ;S START=$$FMADD^XLFDT($P($$NOW^XLFDT,"."),-120),END=$$FMADD^XLFDT($P($$NOW^XLFDT,"."),485)
  1.  ;set up what codes for specific domains
  1.  I DOMAIN="ART" S WHATOUT="039OC_AL:ALLERGIES"
  1.  I DOMAIN="PSOO" S WHATOUT="055OC_RXOP:PHARMACY ALL OUTPATIENT",START=$$FMADD^XLFDT($P($$NOW^XLFDT,"."),-30)
  1.  ;get patient identifier (ICN)
  1.  D SELECT^ORWPT(.Y,DFN)
  1.  S ICN=$P($G(Y),U,14)
  1.  I 'ICN Q -1_"^PATIENT ICN NOT FOUND"
  1.  ;build HLA array with request HL7
  1.  S HLA("HLS",1)="SPR^XWBDRPC845-569716_0^T^ZREMOTE RPC^@SPR.4.2~003RPC017ORWRP REPORT TEXT&006RPCVER0010&007XWBPCNT0017&007XWBESSO066321214321\F\\F\\F\657\F"
  1.  S HLA("HLS",1,1)="\48102&007XWBDVER0011&006XWBSEC0043.14&002P10187369543;"_ICN_"&002P2"_WHATOUT_";1\S\RXOP;ORDV06;28;200&002P3000&002P4000&002P5000&002P600"_$L($G(START))_$G(START)_"&002P700"_$L($G(END))_$G(END)
  1.  S HLA("HLS",2)="RDF^1^@DSP.3~TX~300"
  1.  ;set HLL("LINKS") node to specify receiver location
  1.  S HLL("LINKS",1)="ORRDI SUBSCRIBER^ORHDR"
  1.  S ORHLP("OPEN TIMEOUT")=10
  1.  S ORHLP("SUBSCRIBER")="^OR RDI SENDER^"_$P($$SITE^VASITE,U,3)_"^OR RDI RECEIVER^^^"
  1.  ;call DIRECT^HLMA to send request
  1.  D DIRECT^HLMA("ORRDI EVENT","LM",1,.ORRSLT,,.ORHLP)
  1.  ;set time stamp of the data
  1.  I $G(ORRSLT) S ^XTMP("ORRDI",DOMAIN,DFN,0)=$$NOW^XLFDT
  1.  ;check if call failed
  1.  I $P($G(ORRSLT),U,2) Q "-1"_U_$G(ORRSLT)
  1.  ;get and parse the response HL7
  1.  S ORFS=$G(HL("FS")),ORCS=$E($G(HL("ECH")),1),ORRS=$E($G(HL("ECH")),2),ORES=$E($G(HL("ECH")),3),ORSS=$E($G(HL("ECH")),4)
  1.  N ORQUIT S ORQUIT=""
  1.  F  X HLNEXT Q:HLQUIT'>0!(ORQUIT'="")  D
  1.  .I $E(HLNODE,1,3)="MSA"&($P(HLNODE,ORFS,2)'="AA") S ORQUIT=$P(HLNODE,ORFS,2)
  1.  .I $E(HLNODE,1,3)="ERR" S ORQUIT=$P(HLNODE,ORFS,2)
  1.  .I $E(HLNODE,1,3)="RDT"&($P(HLNODE,ORFS,2)="S") D
  1.  ..S ^XTMP("ORRDI",0)=$$FMADD^XLFDT($$NOW^XLFDT,2)_U_$$NOW^XLFDT
  1.  ..I DOMAIN="ART" D ALPARSE(DFN,.HLNODE)
  1.  ..I DOMAIN="PSOO" D PSPARSE(DFN,.HLNODE)
  1.  I $L(ORQUIT) Q "-2"_U_ORQUIT
  1.  S RET=$O(^XTMP("ORRDI",DOMAIN,DFN,""),-1)
  1.  Q $G(RET)
  1. ALPARSE(DFN,DATA) ;parse an individual ART record that comes from CDS
  1.  I '$D(DATA(0)) S DATA(0)=DATA
  1.  N Y,I,SEQ,TMPREACT,I,DCCOUNT,DICOUNT
  1.  S SEQ=$O(^XTMP("ORRDI","ART",DFN,""),-1)+1
  1.  D PIECEOUT^ORRDI2(.Y,.DATA,ORFS)
  1.  Q:Y(4)="EE"
  1.  ;Q:$$UP^XLFSTR($P(Y(5),ORCS,2))'["DRUG"
  1.  ;save the originating facility
  1.  S ^XTMP("ORRDI","ART",DFN,SEQ,"FACILITY",0)=Y(3)
  1.  ;save reactant to the XTMP if it is coded
  1.  S TMPREACT=$TR(Y(6),ORCS,ORFS)
  1.  N CODING S CODING=$P(TMPREACT,ORFS,6)
  1.  S:$E(CODING,1,4)="99VA" ^XTMP("ORRDI","ART",DFN,SEQ,"REACTANT",0)=$P(TMPREACT,ORFS,4,6)
  1.  ;save drug classes to the XTMP (only coded values)
  1.  S I=0,DCCOUNT=0 F I=1:1:$L(Y(9),ORRS) D
  1.  . N TMP
  1.  . S TMP=$TR($P(Y(9),ORRS,I),ORCS,ORFS)
  1.  . ;check if drug class is coded
  1.  . N CODING S CODING=$P(TMP,ORFS,3) Q:$E(CODING,1,9)'="99VHA_ERT"
  1.  . S DCCOUNT=DCCOUNT+1
  1.  . S $P(TMP,ORFS,6)="99VA"_$P($P(TMP,ORFS,6),"_",2)
  1.  . S ^XTMP("ORRDI","ART",DFN,SEQ,"DRUG CLASSES",DCCOUNT)=$P(TMP,ORFS,4)_U_$P(TMP,ORFS,4)_U_$P(TMP,ORFS,6)_U_$P(TMP,ORFS,5)
  1.  ;save drug ingredients to the XTMP (only coded values)
  1.  S I=0,DICOUNT=0 F I=1:1:$L(Y(10),ORRS) D
  1.  . N TMP
  1.  . S TMP=$TR($P(Y(10),ORRS,I),ORCS,ORFS)
  1.  . ;check if drug ingredient is coded
  1.  . N CODING S CODING=$P(TMP,ORFS,6) Q:$E(CODING,1,4)'="99VA"
  1.  . S DICOUNT=DICOUNT+1
  1.  . S ^XTMP("ORRDI","ART",DFN,SEQ,"DRUG INGREDIENTS",DICOUNT)=$P(TMP,ORFS,4,6)
  1.  S I="" F  S I=$O(^XTMP("ORRDI","ART",DFN,SEQ,"REACTANT",I)) Q:I=""  S ^XTMP("ORRDI","ART",DFN,SEQ,"REACTANT",I)=$$REMESC(^XTMP("ORRDI","ART",DFN,SEQ,"REACTANT",I))
  1.  S I="" F  S I=$O(^XTMP("ORRDI","ART",DFN,SEQ,"DRUG INGREDIENTS",I)) Q:I=""  S ^XTMP("ORRDI","ART",DFN,SEQ,"DRUG INGREDIENTS",I)=$$REMESC(^XTMP("ORRDI","ART",DFN,SEQ,"DRUG INGREDIENTS",I))
  1.  S I="" F  S I=$O(^XTMP("ORRDI","ART",DFN,SEQ,"DRUG CLASSES",I)) Q:I=""  S ^XTMP("ORRDI","ART",DFN,SEQ,"DRUG CLASSES",I)=$$REMESC(^XTMP("ORRDI","ART",DFN,SEQ,"DRUG CLASSES",I))
  1.  Q
  1. PSPARSE(DFN,DATA) ;parse an individual PSOO record from CDS
  1.  I '$D(DATA(0)) S DATA(0)=DATA
  1.  N Y,I,COUNT,MAP,PIECE,SEQ
  1.  D PIECEOUT^ORRDI2(.Y,.DATA,ORFS)
  1.  S SEQ=$O(^XTMP("ORRDI","PSOO",DFN,""),-1)+1
  1.  S I="",COUNT=0,MAP="1,2,4,5,6,7,8,9,10,11,12,14"
  1.  F I=18,4,6,7,8,10,11,12,13,14,15,16 S PIECE(I)=Y(I),COUNT=COUNT+1,^XTMP("ORRDI","PSOO",DFN,SEQ,$P(MAP,",",COUNT),0)=PIECE(I)
  1.  S ^XTMP("ORRDI","PSOO",DFN,SEQ,1,0)=$P(^XTMP("ORRDI","PSOO",DFN,SEQ,1,0),ORCS,1)
  1.  I '$L(^XTMP("ORRDI","PSOO",DFN,SEQ,1,0))!(Y(17)=200) S ^XTMP("ORRDI","PSOO",DFN,SEQ,1,0)=Y(3)
  1.  S ^XTMP("ORRDI","PSOO",DFN,SEQ,6,0)=^XTMP("ORRDI","PSOO",DFN,SEQ,6,0)_";"_Y(9)
  1.  S ^XTMP("ORRDI","PSOO",DFN,SEQ,5,0)=$P(^XTMP("ORRDI","PSOO",DFN,SEQ,5,0),ORCS,5)
  1.  S ^XTMP("ORRDI","PSOO",DFN,SEQ,3,0)=$P($P(^XTMP("ORRDI","PSOO",DFN,SEQ,2,0),ORCS,4),".")
  1.  S ^XTMP("ORRDI","PSOO",DFN,SEQ,2,0)=$P(^XTMP("ORRDI","PSOO",DFN,SEQ,2,0),ORCS,5)
  1.  S ^XTMP("ORRDI","PSOO",DFN,SEQ,7,0)=$$DTCONV(^XTMP("ORRDI","PSOO",DFN,SEQ,7,0))
  1.  S ^XTMP("ORRDI","PSOO",DFN,SEQ,8,0)=$$DTCONV(^XTMP("ORRDI","PSOO",DFN,SEQ,8,0))
  1.  S ^XTMP("ORRDI","PSOO",DFN,SEQ,9,0)=$$DTCONV(^XTMP("ORRDI","PSOO",DFN,SEQ,9,0))
  1.  S I="" F  S I=$O(^XTMP("ORRDI","PSOO",DFN,SEQ,I)) Q:I=""  S ^XTMP("ORRDI","PSOO",DFN,SEQ,I,0)=$$REMESC($G(^XTMP("ORRDI","PSOO",DFN,SEQ,I,0)))
  1.  Q
  1. DTCONV(DATE) ;convert date in hl7 format to mm/dd/yy
  1.  Q $E(DATE,5,6)_"/"_$E(DATE,7,8)_"/"_$E(DATE,3,4)
  1.  ;Q $E(DATE,1,6)_$E($P(DATE,"/",3),3,4)
  1. REMESC(ORSTR) ;
  1.  ; Remove Escape Characters from HL7 Message Text
  1.  ; Escape Sequence codes:
  1.  ;         F = field separator (ORFS)
  1.  ;         S = component separator (ORCS)
  1.  ;         R = repetition separator (ORRS)
  1.  ;         E = escape character (ORES)
  1.  ;         T = subcomponent separator (ORSS)
  1.  N ORCHR,ORREP,I1,I2,J1,J2,K,VALUE
  1.  F ORCHR="F","S","R","E","T" S ORREP(ORES_ORCHR_ORES)=$S(ORCHR="F":ORFS,ORCHR="S":ORCS,ORCHR="R":ORRS,ORCHR="E":ORES,ORCHR="T":ORSS)
  1.  S ORSTR=$$REPLACE^XLFSTR(ORSTR,.ORREP)
  1.  F  S I1=$P(ORSTR,ORES_"X") Q:$L(I1)=$L(ORSTR)  D
  1.  .S I2=$P(ORSTR,ORES_"X",2,99)
  1.  .S J1=$P(I2,ORES) Q:'$L(J1)
  1.  .S J2=$P(I2,ORES,2,99)
  1.  .S VALUE=$$BASE^XLFUTL($$UP^XLFSTR(J1),16,10)
  1.  .S K=$S(VALUE>255:"?",VALUE<32!(VALUE>127&(VALUE<160)):"",1:$C(VALUE))
  1.  .S ORSTR=I1_K_J2
  1.  Q ORSTR