source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAO7PURG.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1RAO7PURG ;HISC/GJC-Purge order request ;9/5/97 08:58
2 ;;5.0;Radiology/Nuclear Medicine;**18**;Mar 16, 1998
3 ;;last modification by SS May 9,2000 for P18
4EN1(RAOIFN) ; 'RAOIFN' is the ien in file 75.1
5 ; Create and send HL7 Purge order request msg to CPRS
6 N RA0,RATAB,RAVAR,RAVARBLE
7 S RATAB=1 D EN1^RAO7UTL S RA0=$G(^RAO(75.1,RAOIFN,0)) Q:RA0']""
8 S RAVAR="RATMP(",RAVARBLE="RATMP"
9 ; msh
10 S @(RAVAR_RATAB_")")=$$MSH^RAO7UTL("ORM^O01") ;P18 event type
11 ; pid
12 S RATAB=RATAB+1,@(RAVAR_RATAB_")")=$$PID^RAO7UTL(RA0)
13 ; orc
14 S RATAB=RATAB+1
15 S @(RAVAR_RATAB_")")="ORC"_RAHLFS_"Z@"_RAHLFS_$P(RA0,"^",7)_"^OR"_RAHLFS_RAOIFN_"^RA"
16SHIP ; ship message to MSG^RAO7UTL which fires of the HL7 message to CPRS
17 D MSG^RAO7UTL("RA EVSEND OR",.@RAVARBLE)
18 Q
19EN2(RAMSG) ; Process purge message from oe/rr (cprs) to Rad/Nuc Med
20 ; Input: RAMSG - HL7 purge request message
21 ; ************************* Variables *********************************
22 ; RAMSH3=sending facility
23 ; RAORC2=<cprs_order_ien>_"^OR"
24 ; RAORC3=<rad/nuc med_order_ien>_"^RA"
25 ; RAPID3=patient internal identifier (ien)
26 ; RAPID5=patient external identifier (name)
27 ; *********************************************************************
28 D BRKOUT^RAO7UTL1 ; defines RAORC2, RAORC3, RAPID3, RAPID5, RAMSH3
29 ; & RADIV(.119)
30 N RAFNTDR,RAOIFN,RAORD0 S (RAERR,RALINEX,RAPURGE)=0
31 F S RALINEX=$O(RAMSG(RALINEX)) Q:RALINEX'>0 D Q:RAERR
32 . S RASEG=$G(RAMSG(RALINEX)) Q:$P(RASEG,RAHLFS)="MSH"
33 . S RAHDR=$P(RASEG,RAHLFS),RADATA=$P(RASEG,RAHLFS,2,999)
34 . D @$S(RAHDR="PID":"PID",RAHDR="ORC":"ORC",1:"ERR")
35 . Q
36 Q:RAERR S RAORD0=$G(^RAO(75.1,+RAORC3,0))
37 S:$$ONLIN(RAORD0) RAERR=24 Q:RAERR ; last activity date for order
38 ; is before the 'Order Data Cut-Off' for the img type
39 S:$P(RAORD0,"^",5)>5 RAERR=24 Q:RAERR ; can't purge orders that are
40 ; in the following stauses: active, scheduled or unreleased
41 S:$P(RAORD0,"^",7)="" RAERR=24 Q:RAERR ; missing CPRS order pointer
42 S:$$GET1^DIQ(100,+$P(RAORD0,"^",7)_",",.01)="" RAERR=24 Q:RAERR ; ptr
43 ; data to file 100 (CPRS Order) is invalid
44 S RAPUROK=$$PUROK^RAPURGE1(RAORD0,DT),RAOIFN=+RAORC3
45 D:RAPUROK ENPUR^RAPURGE1
46 Q ;returns to RAO7RO with RAPUROK set to send OK msg to CPRS
47ORC ; breakdown the 'ORC' segment
48 S RAERR=$$EN3^RAO7VLD(75.1,+RAORC3)
49 S:RAERR RAERR=22 Q:RAERR ; bad filler number
50 S:+RAORC2'>0 RAERR=16 Q:RAERR ; bad placer number
51 S:+RAORC2'=$P($G(^RAO(75.1,+RAORC3,0)),"^",7) RAERR=16 Q:RAERR ; bad placer number
52 Q
53PID ; breakdown the 'PID' segment
54 S RAERR=$$EN2^RAO7VLD(2,RAPID3,RAPID5) S:RAERR RAERR=2 ; bad patient id
55 Q
56ERR ; error control - file 'soft' errors with CPRS
57 N RAVAR S RAVAR("XQY0")=""
58 D ERR^RAO7UTL("HL7 message missing 'PID' & 'ORC' segments",.RAMSG,.RAVAR)
59 Q
60 ;
61ONLIN(RAORD0) ; Check to see if order activity occurred within the number
62 ; of days specified for an order, based on its i-type cut-off parms
63 ; Input: RAORD0-zero node for our order (75.1)
64 ; Output: 1-if order activity occurred later than cut-off date
65 ; 0-if no order activity later than cut-off date
66 ; The 18th piece of 0 node for file 75.1 is 'Last Activity Date/Time'
67 N RAONLIN,RAX
68 ; if no img type on order, dflt to gen'l rad img type
69 S RAX=$G(^RA(79.2,$S($P(RAORD0,"^",3)="":+$O(^RA(79.2,0)),1:$P(RAORD0,"^",3)),.1))
70 S RAONLIN=-$S($P(RAX,"^",6)>29:$P(RAX,"^",6),1:90)
71 Q:($P(RAORD0,"^",18)\1)<($$FMADD^XLFDT(DT,RAONLIN)) 0
72 Q 1
Note: See TracBrowser for help on using the repository browser.