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

RAO7PURG.m

Go to the documentation of this file.
  1. RAO7PURG ;HISC/GJC-Purge order request ;9/5/97 08:58
  1. ;;5.0;Radiology/Nuclear Medicine;**18**;Mar 16, 1998
  1. ;;last modification by SS May 9,2000 for P18
  1. EN1(RAOIFN) ; 'RAOIFN' is the ien in file 75.1
  1. ; Create and send HL7 Purge order request msg to CPRS
  1. N RA0,RATAB,RAVAR,RAVARBLE
  1. S RATAB=1 D EN1^RAO7UTL S RA0=$G(^RAO(75.1,RAOIFN,0)) Q:RA0']""
  1. S RAVAR="RATMP(",RAVARBLE="RATMP"
  1. ; msh
  1. S @(RAVAR_RATAB_")")=$$MSH^RAO7UTL("ORM^O01") ;P18 event type
  1. ; pid
  1. S RATAB=RATAB+1,@(RAVAR_RATAB_")")=$$PID^RAO7UTL(RA0)
  1. ; orc
  1. S RATAB=RATAB+1
  1. S @(RAVAR_RATAB_")")="ORC"_RAHLFS_"Z@"_RAHLFS_$P(RA0,"^",7)_"^OR"_RAHLFS_RAOIFN_"^RA"
  1. SHIP ; ship message to MSG^RAO7UTL which fires of the HL7 message to CPRS
  1. D MSG^RAO7UTL("RA EVSEND OR",.@RAVARBLE)
  1. Q
  1. EN2(RAMSG) ; Process purge message from oe/rr (cprs) to Rad/Nuc Med
  1. ; Input: RAMSG - HL7 purge request message
  1. ; ************************* Variables *********************************
  1. ; RAMSH3=sending facility
  1. ; RAORC2=<cprs_order_ien>_"^OR"
  1. ; RAORC3=<rad/nuc med_order_ien>_"^RA"
  1. ; RAPID3=patient internal identifier (ien)
  1. ; RAPID5=patient external identifier (name)
  1. ; *********************************************************************
  1. D BRKOUT^RAO7UTL1 ; defines RAORC2, RAORC3, RAPID3, RAPID5, RAMSH3
  1. ; & RADIV(.119)
  1. N RAFNTDR,RAOIFN,RAORD0 S (RAERR,RALINEX,RAPURGE)=0
  1. F S RALINEX=$O(RAMSG(RALINEX)) Q:RALINEX'>0 D Q:RAERR
  1. . S RASEG=$G(RAMSG(RALINEX)) Q:$P(RASEG,RAHLFS)="MSH"
  1. . S RAHDR=$P(RASEG,RAHLFS),RADATA=$P(RASEG,RAHLFS,2,999)
  1. . D @$S(RAHDR="PID":"PID",RAHDR="ORC":"ORC",1:"ERR")
  1. . Q
  1. Q:RAERR S RAORD0=$G(^RAO(75.1,+RAORC3,0))
  1. S:$$ONLIN(RAORD0) RAERR=24 Q:RAERR ; last activity date for order
  1. ; is before the 'Order Data Cut-Off' for the img type
  1. S:$P(RAORD0,"^",5)>5 RAERR=24 Q:RAERR ; can't purge orders that are
  1. ; in the following stauses: active, scheduled or unreleased
  1. S:$P(RAORD0,"^",7)="" RAERR=24 Q:RAERR ; missing CPRS order pointer
  1. S:$$GET1^DIQ(100,+$P(RAORD0,"^",7)_",",.01)="" RAERR=24 Q:RAERR ; ptr
  1. ; data to file 100 (CPRS Order) is invalid
  1. S RAPUROK=$$PUROK^RAPURGE1(RAORD0,DT),RAOIFN=+RAORC3
  1. D:RAPUROK ENPUR^RAPURGE1
  1. Q ;returns to RAO7RO with RAPUROK set to send OK msg to CPRS
  1. ORC ; breakdown the 'ORC' segment
  1. S RAERR=$$EN3^RAO7VLD(75.1,+RAORC3)
  1. S:RAERR RAERR=22 Q:RAERR ; bad filler number
  1. S:+RAORC2'>0 RAERR=16 Q:RAERR ; bad placer number
  1. S:+RAORC2'=$P($G(^RAO(75.1,+RAORC3,0)),"^",7) RAERR=16 Q:RAERR ; bad placer number
  1. Q
  1. PID ; breakdown the 'PID' segment
  1. S RAERR=$$EN2^RAO7VLD(2,RAPID3,RAPID5) S:RAERR RAERR=2 ; bad patient id
  1. Q
  1. ERR ; error control - file 'soft' errors with CPRS
  1. N RAVAR S RAVAR("XQY0")=""
  1. D ERR^RAO7UTL("HL7 message missing 'PID' & 'ORC' segments",.RAMSG,.RAVAR)
  1. Q
  1. ;
  1. ONLIN(RAORD0) ; Check to see if order activity occurred within the number
  1. ; of days specified for an order, based on its i-type cut-off parms
  1. ; Input: RAORD0-zero node for our order (75.1)
  1. ; Output: 1-if order activity occurred later than cut-off date
  1. ; 0-if no order activity later than cut-off date
  1. ; The 18th piece of 0 node for file 75.1 is 'Last Activity Date/Time'
  1. N RAONLIN,RAX
  1. ; if no img type on order, dflt to gen'l rad img type
  1. S RAX=$G(^RA(79.2,$S($P(RAORD0,"^",3)="":+$O(^RA(79.2,0)),1:$P(RAORD0,"^",3)),.1))
  1. S RAONLIN=-$S($P(RAX,"^",6)>29:$P(RAX,"^",6),1:90)
  1. Q:($P(RAORD0,"^",18)\1)<($$FMADD^XLFDT(DT,RAONLIN)) 0
  1. Q 1