| 1 | RAFLH1 ;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
|
|---|
| 6 | PRT S RAFMT=RAEXFM,RANUM=RAEXLBLS D PRT^RAFLH Q
|
|---|
| 7 | ;
|
|---|
| 8 | TEST 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
|
|---|
| 12 | START 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
|
|---|
| 21 | Q ; 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 | ;
|
|---|
| 34 | CMP ;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 | ;
|
|---|
| 43 | STORE 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.
|
|---|
