source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAFLH1.m@ 1590

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

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1RAFLH1 ;HISC/CAH,FPT AISC/MJK,RMO-Print Radiology Exam Labels ;6/12/97 11:44
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 Q:'RAEXLBLS I RAFLHFL S RACNI=RAFLHFL G PRT
4 F RACNI=+$P(RAFLHFL,";",2):0 S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0 I $D(^(RACNI,0)) S RAY3=^(0) D PRT
5 Q
6PRT S RAFMT=RAEXFM,RANUM=RAEXLBLS D PRT^RAFLH Q
7 ;
8TEST D SET^RAPSET1 I $D(XQUIT) K XQUIT,POP Q
9 S RATEST="",RANUM=1,RAFMT=$S($P(RAMLC,"^",7):$P(RAMLC,"^",7),1:1)
10 S ZTRTN="START^RAFLH1" F RASV="RATEST","RANUM","RAFMT","RAMDIV" S ZTSAVE(RASV)=""
11 D ZIS^RAUTL G Q:RAPOP
12START U IO S RAK=0
13 F S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0 D SETFLH^RAFLH2(RAK)
14 G Q:'$D(^RA(78.2,RAFMT,0))
15 F RAII=1:1:RANUM W @IOF F RAI=0:0 S RAI=$O(^RA(78.2,RAFMT,"E",RAI)) Q:RAI'>0 D
16 . I $G(^RA(78.2,RAFMT,"E",RAI,0))'["@" D
17 .. X ^RA(78.2,RAFMT,"E",RAI,0)
18 .. Q
19 . E D XECFLH^RAFLH2(RAFMT,RAI)
20 . Q
21Q ; Quit & kill
22 ; RAOPT("RPTPAT") is defined in the entry action field for options
23 ; in this case RAOPT("RPTPAT") is defined for the option RA RPTPAT.
24 ; RA RPTPAT is allowed to print more than one record. If multiple
25 ; records, this CLOSE^RAUTL will close the device after printing
26 ; only one record. This causes subsequent records to be displayed to
27 ; the HOME device.
28 D:'$D(RAOPT("RPTPAT")) CLOSE^RAUTL S RAK=0
29 F S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0 D KILFLH^RAFLH2(RAK)
30 K %W,%Y1,DUOUT,POP,RAEXFM,RAEXLBLS,RAFLHFL,RAFMT,RAI,RAII,RAK,RAMES,RANUM,RAPOP,RASV,RATEST,RAY0,RAY1,RAY2,RAY3,ZTDESC,ZTDTH,ZTRTN,ZTSAVE,DISYS
31 I $D(ZTQUEUED) K RADFN,RADTI,RAFLH
32 Q
33 ;
34CMP ;This code compiles flash card formats into code stored in the
35 ;'Compiled Logic' field #100 of file #78.2
36 Q:'$D(^RA(78.2,RAFMT,0)) S RAROW=$S($P(^(0),"^",2):$P(^(0),"^",2),1:6) K ^RA(78.2,RAFMT,"E"),^TMP($J,"RAFORM")
37 F RAI=0:0 S RAI=$O(^RA(78.2,RAFMT,1,RAI)) Q:RAI'>0 I $D(^(RAI,0)) S XX=^(0),^TMP($J,"RAFORM",+$P(XX,"^",2),+$P(XX,"^",3),$P(XX,"^"))=$P(XX,"^",4,5)
38 S RAN=1 F RAI=1:1:RAROW S FL=1 S:'$D(^TMP($J,"RAFORM",RAI)) ^RA(78.2,RAFMT,"E",RAN,0)="W !",RAN=RAN+1 I $D(^(RAI)) F COL=0:0 S COL=$O(^TMP($J,"RAFORM",RAI,COL)) Q:COL'>0 S %="",%=$O(^(COL,%)) S J=^(%) D STORE
39 W !!?5,"...format '",$P(^RA(78.2,RAFMT,0),"^"),"' has been compiled."
40 K RA787,RAROW,XX,RAI,RAII,RAIV,RADEF,J,TITL,COL,RAN,^TMP($J,"RAFORM")
41 Q
42 ;
43STORE S RAIV="DT",RADEF="" S:$D(^RA(78.7,+%,0)) RAIV=^(0),RADEF=$P(RAIV,"^",3),RAIV=$P(RAIV,"^",5)
44 S RA787("E")=$G(^RA(78.7,+%,"E"))
45 S TITL=$S(RAIV="RAFREE":"",$P(J,"^")="NONE":"",$P(J,"^")]"":$P(J,"^"),1:RADEF)
46 S ^RA(78.2,RAFMT,"E",RAN,0)="W "_$S(FL:"!",1:"")_"?"_(COL-1)_","""_TITL_""","_$S(RAIV="RAFREE":""""_$P(J,"^",2)_"""",RA787("E")["$$BCDE^RAUTL18":"@"_RAIV,1:RAIV)
47 S RAN=RAN+1,FL=0
48 Q
49 ;
50 ; Exam labels are printed on the device specified in the location
51 ; parameter, FLASH CARD PRINTER NAME in File 79.1. If there is no
52 ; value in that field, the user will be prompted for a device. The
53 ; number of exam labels printed is defined in the location parameter,
54 ; HOW MANY EXAM LABELS PER EXAM. That number is not changed by any
55 ; parameter or combination of parameters. If that number is zero (or
56 ; null), then no exam labels will be printed.
Note: See TracBrowser for help on using the repository browser.