source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAFLH2.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1RAFLH2 ;HISC/GJC-Utility determines if flash cards print. ;4/3/97 07:57
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3PRINT(RADIV,RALOC,RAPRC) ;
4 ; Pass in 'RAMDIV', 'RAMLC' & proc. array i.e, 'RAPX'.
5 ; Pass back '0' if the print is to be aborted, '>0' to print.
6 N I,RA71,RA79,RA791,RAFLG,X,X1
7 S RA79(.1)=$G(^RA(79,RADIV,.1)),RA791(0)=$G(^RA(79.1,+RALOC,0))
8 S RA79(.12)=$S($P(RA79(.1),"^",2)']"":0,"Nn"[$P(RA79(.1),"^",2):0,1:1)
9 S RA79(.18)=$S($P(RA79(.1),"^",8)']"":0,"Nn"[$P(RA79(.1),"^",8):0,1:1)
10 S RA791(2)=$S('+$P(RA791(0),"^",2):0,1:1) ; '0' if null or zero
11 S RA791(4)=$S('+$P(RA791(0),"^",4):0,1:1) ; '0' if null or zero
12 S RA791(8)=$S('+$P(RA791(0),"^",8):0,1:1) ; '0' if null or zero
13 ; 'RAPRC' in format of: Case #_^_$G(^RAMIS(71,proc,0))
14 ; where 'proc' is the procedure IEN. created in [RA REGISTER]
15 S I=0 F S I=$O(RAPRC(I)) Q:I'>0 D
16 . S X=$G(RAPRC(I)),X1=$P(X,"^",5)
17 . S RA71=+$G(RA71)+($S(X1']"":0,1:1))
18 . Q
19 S RAFLG=+$G(RA71)+RA791(2)+RA791(4)+RA791(8)+RA79(.12)+RA79(.18)
20 Q RAFLG
21KILFLH(X) ; Kill Flash Card Formats variables.
22 ; X -> IEN of file of the Label Print Fields file.
23 ; Called from 6^RAMAIN & Q^RAFLH1
24 Q:$G(^RA(78.7,X,0))']"" S RA787(0)=$G(^RA(78.7,X,0))
25 K @$P(RA787(0),"^",5),RA787(0)
26 Q
27SETFLH(X) ; Set Flash Card Formats variables.
28 ; X -> IEN of file of the Label Print Fields file.
29 ; Called from 6^RAMAIN & START^RAFLH1
30 Q:$G(^RA(78.7,X,0))']"" S RA787(0)=$G(^RA(78.7,X,0))
31 S @$P(RA787(0),"^",5)=$P(RA787(0),"^",4)
32 Q
33XECFLH(X,Y) ; Execute the "E" node for the Flash Card Formats file (78.2).
34 ; X -> IEN of the top level ; Y -> IEN at the first subfile level.
35 ; Called from RAFLH & RAFLH1
36 N I S I=0
37 F S I=$O(RAIND1(I)) Q:'+I S ^TMP($J,"RA FLASH",I)=RAIND1(I)
38 I '$D(RATEST) X ^RA(78.2,X,"E",Y,0) Q
39 N RASAV,RATMP S RASAV=$G(^RA(78.2,X,"E",Y,0))
40 S RATMP=$P(RASAV,"@")_$P(RASAV,"@",2) X RATMP
41 S ^RA(78.2,X,"E",Y,0)=RASAV
42 Q
Note: See TracBrowser for help on using the repository browser.