source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARIC.m@ 808

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

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1RARIC ;HISC/FPT AISC/SAW-Radiologic Image Capture and Display Routine ;6/19/97 12:06
2 ;;5.0;Radiology/Nuclear Medicine;**23,27**;Mar 16, 1998
3 ;
4CREATE ; create new stub entry in file 74
5 ; called from ^MAGKEXC, ^MAGKEXC1
6 ; If no report entry is created, RARPT will be undefined
7 K RARPT
8 ; --------------------------------------------------------------------
9 ; Perform data validation checks for the following 'RA' namespaced
10 ; variables: RADTE, RADFN, RADTI, RACN & RACNI (all should be defined)
11 Q:'$D(RADTE)!('$D(RADFN))!('$D(RADTI))!('$D(RACN))!('$D(RACNI))
12 ; Check the above variables to insure they consist of the proper
13 ; sequence of characters.
14 Q:RADTE'?7N1"."1.4N ; Fileman internal date/time without seconds
15 K RASULT D DT^DILF("T",RADTE,.RASULT)
16 I RASULT=-1 K RASULT Q ; invalid FM internal date format
17 K RASULT
18 Q:RADTI'?7N1"."1.4N ; reverse chronological date/time without seconds
19 Q:+RADFN'=RADFN Q:'$D(^RADPT(RADFN,0)) ; not a number, or invalid ien
20 Q:RACN'?1.5N ; case #'s lie in the range of 1-99999
21 Q:RACNI'?1N.N ; must be a number, period
22 Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) ; exam record missing
23 Q:$P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),U)'=RACN ; case/exam mismatch
24 ; --------------------------------------------------------------------
25 ; continue whether exam was purged or not -- 08/23/00
26 N RAPRTSET,RAMEMARR,RA1
27 D EN2^RAUTL20(.RAMEMARR) ; is this case part of a print set ?
28 ; don't need to lock exam date's node
29 N I,J,X S I=$P(^RARPT(0),"^",3)
30LOCK S I=I+1 L +^RARPT(I):1
31 I $T,'$D(^RARPT(I)),'$D(^RARPT("B",I)) G NEWOK
32 L -^RARPT(I)
33 S X=$G(^RAPRT(I,0))
34 ;
35 ; if lock-failed node belongs to this case, set rarpt & quit
36 I $P(X,"^",2)=RADFN,(9999999.9999-$P(X,"^",3))=RADTI,$P($P(X,"^"),"-",2)=RACNI S RARPT=I G OUT
37 ; if lock-failed node belongs to a printset with the same patient and
38 ; exam date/time as the current case, set rarpt & quit
39 I RAPRTSET,$P(X,"^",2)=RADFN,(9999999.9999-$P(X,"^",3))=RADTI S RARPT=I G OUT
40 ;
41 G LOCK ; lock-failed node belongs to another case, thus try again
42NEWOK S ^RARPT(I,0)=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN,RARPT=I,^(0)=$P(^RARPT(0),"^",1,2)_"^"_I_"^"_($P(^(0),"^",4)+1) D NOW^%DTC S DT=X K %,%H,%I
43 ; don't define "T" node
44 S $P(^RARPT(I,0),"^",2,6)=RADFN_"^"_(9999999.9999-RADTI)_"^"_RACN_"^^"_DT ; don't stuff REPORTED DATE
45 S:'$D(RAMDIV) RAMDIV=+$P(^RADPT(RADFN,"DT",RADTI,0),"^",3) S:'$D(RAMDV) RAMDV=$S($D(^RA(79,RAMDIV,.1)):^(.1),1:"") S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",17)=RARPT
46 S MAGSCN=$G(^MAG(2006.1,"AXSCN"))
47 I ('MAGSCN)!(MAGSCN="N") S MAGSCN=""
48 E S MAGSCN="Images captured for this report."
49 I $L(MAGSCN) S ^RARPT(RARPT,"R",0)="^^1^1^"_DT,^RARPT(RARPT,"R",1,0)=MAGSCN
50 ; The orig. clin hist is now referenced directly from file 70, so
51 ; comment out next 2 lines to stop copying orig. clin hist from file 70
52 ;I $O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",0)) S I=0 F J=0:1 S I=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI,"H",I)) Q:I'>0 I $D(^(I,0)) S ^RARPT(RARPT,"H",(J+1),0)=^(0)
53 ;S:J ^RARPT(RARPT,"H",0)="^^"_J_"^"_J_"^"_DT
54 ;Update Activity Log with 'images collected' transaction
55 S DA=RARPT,DIE="^RARPT(",DR="100///""NOW""",DR(2,74.01)="2////"_$S($D(RAESIG):"V",1:"C")_";3////"_DUZ D ^DIE K DA,DR,DE,DQ,DIE
56 S DA=RARPT,DIK="^RARPT(",RAQUEUED=1 D IX1^DIK ;D:$D(RAMDV) UPSTAT^RAUTL0
57 N RARPTN S RARPTN=$P(^RARPT(RARPT,0),"^")
58 ;
59 ; create a var RARIC to suppress display of info msg from ptr^rarte2
60 ; if another case of this printset got cancelled
61 I RAPRTSET N RARIC S RARIC=1 D PTR^RARTE2
62 ; don't have to check raxit, since we're quitting now
63 ;
64 K DA,DIK,J,RAQUEUED
65OUT L -^RARPT(RARPT)
66 Q
67PTR ; create pointer in file 74 for Imaging package
68 ; called from MAGKEXC, MAGKEXC1 & MAGRIC
69 ; input: RARPT - IEN of Rad/NM Report file #74
70 ; MAGGP - IEN of record in file 2005 pointed to by a report
71 ; returns: Y=0 - variable MAGGP does not exist
72 ; Y=-1 - FileMan could not create an entry
73 ; Y>0 - FileMan created an entry
74 ;
75 N DA,DIC
76 I '$D(MAGGP) S Y=0 Q
77 S DIC("P")=$P(^DD(74,2005,0),U,2)
78 S DA(1)=RARPT,DIC="^RARPT("_DA(1)_",2005,",DIC(0)="LZ",X=MAGGP
79 K DD,DO D FILE^DICN
80 Q
Note: See TracBrowser for help on using the repository browser.