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

RAO7UTL.m

Go to the documentation of this file. 
  1. RAO7UTL ;HISC/GJC,SS-Utilities for HL7 messages. ; 20 Apr 2011  7:31 PM
  1.  ;;5.0;Radiology/Nuclear Medicine;**18,45,57,82,1003**;Nov 01, 2010;Build 3
  1.  ;modified by SS JUN 19,2000 for P18
  1. EN1 ; Entry point to define some basic HL7 variables
  1.  N I S RAHLFS="|",RAECH="^~\&"
  1.  S $P(RAHLFS(0),RAHLFS,51)=""
  1.  F I=1:1:$L(RAECH) S RAECH(I)=$E(RAECH,I)
  1.  Q
  1.  ;
  1. CMEDIA(IEN,RAPTYPE) ;Called from RAO7MFN when a procedure is updated
  1.  ;Input: IEN=ien of proc. in file 71
  1.  ;   RAPTYPE=procedure type; broad, parent, series, or detailed.
  1.  ;Return: J=a string with some combination of the following indicators:
  1.  ;I for Iodinated ionic, N for Iodinated non-ionic, L for Gadolinium
  1.  ;C for Oral Cholecystographic, G for Gastrografin, B for Barium or
  1.  ;NULL if none of the indicators apply to this procedure.
  1.  ;
  1.  ;'Broad' procedures have no contrast media definition, return null
  1.  Q:RAPTYPE="B" ""
  1.  ;if 'detailed' or 'series' & no contrast media data return null
  1.  I RAPTYPE'="P",'($O(^RAMIS(71,IEN,"CM",0))) Q ""
  1.  NEW I,INA,J S J=""
  1.  I RAPTYPE="P" D
  1.  .S I=0 F  S I=$O(^RAMIS(71,IEN,4,I)) Q:'I  D
  1.  ..S I(0)=+$G(^RAMIS(71,IEN,4,I,0)) Q:'I(0)
  1.  ..S INA=$P($G(^RAMIS(71,I(0),"I")),"^")
  1.  ..S INA=$S(INA="":1,INA>DT:1,1:0)
  1.  ..D:INA NONPAR(I(0))
  1.  ..Q
  1.  .Q
  1.  E  D NONPAR(IEN)
  1.  Q J
  1.  ;
  1. NONPAR(IEN) ;obtain contrast media data for a 'detailed' or 'series' proc
  1.  ; Input: IEN=ien of the non-parent, non-broad procedure
  1.  ;Return: J=data string (return)
  1.  ;variable definition: I=ien of sub-file rec
  1.  NEW H,I S I=0
  1.  F  S I=$O(^RAMIS(71,IEN,"CM",I)) Q:I'>0  D
  1.  .S H=$P($G(^RAMIS(71,IEN,"CM",I,0)),U) Q:H=""
  1.  .S:J'[H J=J_H
  1.  .Q
  1.  Q
  1.  ;
  1. MSH(X) ; Set up the 'MSH' segment.
  1.  ; 'X' is passed in and identifies the message type.
  1.  S:X']"" X="Message Type Error"
  1.  Q "MSH"_RAHLFS_RAECH_RAHLFS_"RADIOLOGY"_RAHLFS_$P($G(^DIC(4,+$G(DUZ(2)),99)),"^")_$$STR(3)_$$HLDATE^HLFNC($$NOW^XLFDT(),"TS")_$$STR(2)_X
  1.  ;
  1. MSA(X,Y) ; Set up the 'MSA' segment. P18 
  1.  ; 'X' is passed in and identifies the message ID.
  1.  ; 'Y' is acknowledgement code
  1.  S:X']"" X="Message ID Error"
  1.  Q "MSA"_RAHLFS_Y_RAHLFS_$E(X,1,20)_$$STR(4)
  1. MFI(X) ; Set up the 'MFI' segment
  1.  S @(RAVAR_RACNT_")")="MFI"_RAHLFS_RAFNUM
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAECH(1)_RAFNAME_RAECH(1)
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_"99DD"_RAHLFS_RAHLFS_X ;P18
  1.  S @(RAVAR_RACNT_")")=@(RAVAR_RACNT_")")_RAHLFS_RAHLFS_RAHLFS_"ER"
  1.  X RAINCR ; increment counter
  1.  Q
  1. PID(Y) ; Create 'pid' segment
  1.  Q "PID"_$$STR(3)_+$P(Y,"^")_$$STR(2)_$P($G(^DPT(+$P(Y,"^"),0)),"^")
  1.  ;
  1. PV1(Y) ; Create 'pv1' segment
  1.  ;Input: Y=zero node of the RAD/NUC MED ORDERS (#75.1) file
  1.  N DFN,RA,RARMBED,RAWARD,VAIP,RAPF
  1.  S DFN=+$P(Y,"^"),VAIP("D")=$P(Y,"^",21)
  1.  S RA("PV1",2)="O",RA("PV1",3)=+$P(Y,"^",22)
  1.  D IN5^VADPT S RAWARD=$G(VAIP(5)),RARMBED=$G(VAIP(6))
  1.  I RAWARD]"" D
  1.  . S RA("PV1",2)="I",RAWARD(44)=$P($G(^DIC(42,+RAWARD,44)),"^")
  1.  . S RA("PV1",3)=+RAWARD(44)_U_$P(RARMBED,"^",2)
  1.  . Q
  1.  S RAPF="PV1"_$$STR(2)_RA("PV1",2)_RAHLFS_RA("PV1",3)_$$STR(16) ;_"Visit #" was truncated for P18   ? Req 4
  1.  ;IHS/BJI/DAY - Patch 1003 - Comment out call to VA's IBB package
  1.  ;D PV1^RABWIBB
  1.  ;End Patch
  1.  ; pv1^RABWIBB will redefine RAPF if the PFSS switch is on and there's a valid PFSS Account Reference
  1.  ; Otherwise, RAPF won't be changed
  1.  K RACCOUNT ; this variable was set earlier in FB^RABWIBB
  1.  Q RAPF
  1.  ;
  1. PURGE K RAHLFS,RACNT,RAECH,RAFNAME,RAFNUM,RAINCR,RASUB,RATSTMP,RAVAR,RAXIT
  1. PURGE1 ; kill only whole file update variables
  1.  K RA71,RA713,RACMCODE,RACMNOR,RACOST,RACPT,RAIEN71,RAIMGAB,RAMFE,RAMULT
  1.  K RAPHYAP,RAPRCTY,RAXT71
  1.  Q
  1. DIAG(X,Y,Z) ; Pass back an "A" if any Dx code has 'Yes' in the 'Generate
  1.  ;         Abnormal Alert' field.
  1.  N A,AAH,RA7003,RA783 S AAH=""
  1.  S RA7003=$G(^RADPT(X,"DT",Y,"P",Z,0)),RA7003(13)=+$P(RA7003,"^",13)
  1.  S RA783(0)=$G(^RA(78.3,RA7003(13),0))
  1.  S RA783(4)=$$UP^XLFSTR($P(RA783(0),"^",4))
  1.  S:RA783(4)="Y" AAH="A"
  1.  Q:AAH]"" AAH
  1.  S A=0 F  S A=$O(^RADPT(X,"DT",Y,"P",Z,"DX",A)) Q:A'>0  D  Q:AAH]""
  1.  . S RA783=+$G(^RADPT(X,"DT",Y,"P",Z,"DX",A,0))
  1.  . S RA783(0)=$G(^RA(78.3,RA783,0))
  1.  . S RA783(4)=$$UP^XLFSTR($P(RA783(0),"^",4))
  1.  . I RA783(4)="Y" S AAH="A"
  1.  . Q
  1.  Q AAH
  1. PROCNDE(X) ; Check if the procedure has both an I-Type & Proc. Type
  1.  ;         assigned. Pass back '1' if either the I-Type -or- Proc. Type
  1.  ;         data is missing.  '0' if everything is ok.
  1.  I $P(X(0),U,6)]"",($P(X(0),U,12)]"") Q 0
  1.  Q 1
  1. STR(X) ; Pass back a predetermined # of '|' or other field separator
  1.  Q:$G(RAHLFS(0))']""!(+X=0) "" ; Quit if parent string i.e, 'RAHLFS(0)'
  1.  ;                               does not exist or +X evaluates to null.
  1.  ;
  1.  S:X<0 X=$$ABS^XLFMTH(X) ;       If passed in negative, take absolute
  1.  ;                               value.  Quit if 'X' is greater than the
  1.  ;                               length of our parent string.
  1.  ;
  1.  S:X["." X=X\1 ;                 If a non-integer, remove mantissa.
  1.  ;
  1.  Q:X>($L(RAHLFS(0))) "" ;        If parameter greater than length of
  1.  ;                               string, pass back null.
  1.  Q $E(RAHLFS(0),1,X)
  1.  ;
  1. CHKUSR(RADUZ) ; Check user status to 'DC' an order.
  1.  ; pass back '0' if non-active Rad/Nuc Med user
  1.  ; pass back '1' if active Rad/Nuc Med user
  1.  N RAINADT S RAINADT=+$P($G(^VA(200,RADUZ,"PS")),"^",4) ;inactivation DT
  1.  Q $S('($D(RADUZ)#2):0,'$D(^VA(200,RADUZ,0)):0,'$D(^("RAC")):0,'RAINADT:1,'$D(DT):0,DT'>RAINADT:1,1:0)
  1.  ;
  1. ERR(RATXT,RAMSG,RAVAR) ; Call CPRS utility to log 'soft' errors.
  1.  ; Input: RATXT-text description of the error
  1.  ;        RAMSG-HL7 message array
  1.  ;        RAVAR-variables to be saved off
  1.  D EN^ORERR(RATXT,.RAMSG,.RAVAR)
  1.  Q
  1.  ;
  1. MSG(RAPROTO,RAMSG) ; ship HL7 messages to CPRS from this entry point
  1.  ; input: RAPROTO - protocol to execute
  1.  ;          RAMSG - message (in HL7 format)
  1.  D MSG^XQOR(RAPROTO,.RAMSG)
  1.  Q
  1.  ;
  1. UPDATP(RAY) ;update the parent procedure when a descendent is
  1.  ;updated. Called from RAMAIN2 (procedure entry/edit)
  1.  ;input: RAY=ien of desc.^name of desc. (if existing record)
  1.  ;       RAY=ien of desc.^name of desc.^1 (if new record)
  1.  W !!,$P(RAY,U,2)_" is a descendent procedure, updating parent(s)..."
  1.  N RAPIEN,RAQUIT S (RAPIEN,RAQUIT)=0
  1.  F  S RAPIEN=$O(^RAMIS(71,"ADESC",+RAY,RAPIEN)) Q:'RAPIEN  D  Q:RAQUIT
  1.  .S RAPIEN(0)=$G(^RAMIS(71,RAPIEN,0))
  1.  .W !?2,"Updating parent: "_$E($P(RAPIEN(0),U),1,50)
  1.  .S RAPIEN("I")=$P($G(^RAMIS(71,RAPIEN,"I")),"^")
  1.  .S RAPIEN("S")=$S(RAPIEN("I")="":1,RAPIEN("I")>DT:1,1:0)
  1.  .L +^RAMIS(71,RAPIEN):300
  1.  .I '$T S RAQUIT=1 D  Q
  1.  ..W !?2,"Parent Procedure: "_$E($P(RAPIEN(0),U),1,50)
  1.  ..W !?2,"being edited by another user, try again later!",$C(7)
  1.  ..Q
  1.  .D PROC^RAO7MFN(0,71,RAPIEN("S")_"^"_RAPIEN("S"),RAPIEN)
  1.  .L -^RAMIS(71,RAPIEN)
  1.  .Q
  1.  Q
  1.  ;----------------------------
  1.  ;called from 
  1.  ;-Case # edit  START1+16^RAEDCN
  1.  ;-Edit by patient
  1.  ;-Tracking
  1.  ;Saves proc ien before editing, locate the exam by patient, datetime and caseN 
  1. SVBEFOR(RAPATN,RAINVDT,RACIEN) ;P18;send radfn,radti,racni (instead of racn and new sequencing of params
  1.  ; RAPRIEN() holds "before" values
  1.  N RADATA,RAX,RA0,RA1,RA2,RA3
  1.  S RADATA=$G(^RADPT(RAPATN,"DT",RAINVDT,"P",RACIEN,0))
  1.  Q:RADATA=""  ;failure
  1.  ; don't check parent here, since still need compare Req Phys & Proc Mods
  1.  S RAPRIEN=$P(RADATA,"^",2) ; procedure ien
  1.  S RAPRIEN(1)=RAPATN ; dfn
  1.  S RAPRIEN(2)=RAINVDT ; inverse date exm
  1.  S RAPRIEN(3)=RACIEN ; case ien
  1.  S RAPRIEN(4)=$P(RADATA,"^",14) ; req phy
  1.  D STR70^RAUTL10(.RAX,RAPATN,RAINVDT,RACIEN)
  1.  S RAPRIEN(5)=RAX ; string of proc mods
  1.  ; send "XX" if diffcs in Req.Phy &/or Proc Mods
  1.  ; Next lines are for RA*5*82
  1.  ; Save CPT modifiers before editing
  1.  S RAX=0 K RAPRIEN("CMOD")
  1.  F  S RAX=$O(^RADPT(RAPATN,"DT",RAINVDT,"P",RACIEN,"CMOD",RAX)) Q:'RAX  S RAPRIEN("CMOD",RAX)=+$G(^(RAX,0))
  1.  ; Save Tech comments before editing
  1.  S RAX=0 K RAPRIEN("TCOM")
  1.  F  S RAX=$O(^RADPT(RAPATN,"DT",RAINVDT,"P",RACIEN,"L",RAX)) Q:'RAX  S RAPRIEN("TCOM",RAX)=$G(^(RAX,"TCOM"))
  1.  Q  ;OK