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

RMPRFC3.m

Go to the documentation of this file.
  1. RMPRFC3 ;HINES CIOFO/HNC - Process IFC HL7 ; 2/6/09
  1. ;;3.0;PROSTHETICS;**83,193,198**;Feb 09,1996;Build 6
  1. ;
  1. ;
  1. ;Helen Corkwell-new flow 3/9/05
  1. ;
  1. ; Patch 83 -
  1. ; - Prohibit filing data in 668 if code runs at sending site
  1. ; - Exit if NW record in consults and 668; and if DC and is dup
  1. ;
  1. Q
  1. EN ;process IFC responses
  1. ;load message in ^TMP
  1. K ^TMP("RMPRIF",$J)
  1. N HLNODE,SEG,I ;production code
  1. N RMPRSITIEN,RMPRSTA
  1. F I=1:1 X HLNEXT Q:HLQUIT'>0 D
  1. .I $P(HLNODE,"|")="OBX" D
  1. ..S ^TMP("RMPRIF",$J,"OBX",$P(HLNODE,"|",2),$P(HLNODE,"|",5))=$E(HLNODE,5,999)
  1. .I $P(HLNODE,"|")="NTE" D
  1. ..S ^TMP("RMPRIF",$J,"NTE",$P(HLNODE,"|",2))=$E(HLNODE,5,999)
  1. .I "OBXNTE"'[$P(HLNODE,"|") D
  1. ..S ^TMP("RMPRIF",$J,$P(HLNODE,"|"))=$E(HLNODE,5,999)
  1. ;
  1. CHK ;
  1. ;DC does not have a OBR segment, must check status first
  1. ;
  1. ;
  1. ;is it a NW or DC order?
  1. I '$D(^TMP("RMPRIF",$J,"ORC")) G EXIT
  1. S RMPRST=$P(^TMP("RMPRIF",$J,"ORC"),"|",1)
  1. I RMPRST="OD" S RMPRST=$P(^TMP("RMPRIF",$J,"ORC"),"|",5)
  1. I (RMPRST'="NW")&(RMPRST'="DC") G EXIT
  1. ;
  1. I '$D(^TMP("RMPRIF",$J,"OBR"))&(RMPRST'="DC") G EXIT
  1. I RMPRST="NW"&($P($G(^TMP("RMPRIF",$J,"OBR")),"|",4)'["PROSTHETICS IFC") G EXIT
  1. ;
  1. ;is it a discontinued order? does it have a consult ien?
  1. ;is there a local consult ien? has it already been filed in 668?
  1. I RMPRST="NW" D
  1. .S RMPR123=$P(^TMP("RMPRIF",$J,"OBR"),"|",2)
  1. .S RMPR123I=$P(RMPR123,U,1),RMPRISIT=$P(RMPR123,U,2)
  1. ;
  1. I RMPRST="DC" D
  1. .S RMPR123=$P(^TMP("RMPRIF",$J,"ORC"),"|",3)
  1. .S RMPR123I=$P(RMPR123,U,1),RMPRISIT=$P(RMPR123,U,2)
  1. .S RMPR123A=RMPR123I
  1. TST ;
  1. ;Consult IEN
  1. D FIND^DIC(4,,99,,RMPRISIT,1,"D",,,"RMPRSTA")
  1. S RMPRSITIEN=$G(RMPRSTA("DILIST",2,1)) ;RMPR*3.0*198 sets the institution IEN for discontinued and new consults
  1. I RMPRST="NW" D
  1. .S RMPR123A=$O(^GMR(123,"AIFC",RMPRSITIEN,RMPR123I,0))
  1. ;
  1. I RMPR123A="" G EXIT
  1. ;added check, when HL7 link is down possible to get mult NW msg
  1. ;8/23/05 hnc
  1. ; modified check, EXIT imm. on NW message, loop On 668 "D" xref to determine if dup DC
  1. ; 13 MAR 09 DDA
  1. I RMPRST="NW" G:$D(^RMPR(668,"D",RMPR123A)) EXIT
  1. I RMPRST="DC" S RMPRDPDC=0 D
  1. .S RMPRDCIN="" F S RMPRDCIN=$O(^RMPR(668,"D",RMPR123A,RMPRDCIN)) Q:RMPRDCIN="" D
  1. ..S:^RMPR(668,RMPRDCIN,2,1,0)["****DISCONTINUED****" RMPRDPDC=1
  1. ..Q
  1. .Q
  1. I $G(RMPRDPDC)=1 G EXIT
  1. S ^TMP("RMPRIF",$J,"GOODTOGO")="OKAY"
  1. G EN^RMPRFC4
  1. Q
  1. ;
  1. EXIT ;common exit point
  1. K ^TMP("RMPRIF",$J)
  1. G EXIT^RMPRFC4
  1. ;END