- RAFLH1 ;HISC/CAH,FPT AISC/MJK,RMO-Print Radiology Exam Labels ;6/12/97 11:44
- ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- Q:'RAEXLBLS I RAFLHFL S RACNI=RAFLHFL G PRT
- 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
- Q
- PRT S RAFMT=RAEXFM,RANUM=RAEXLBLS D PRT^RAFLH Q
- ;
- TEST D SET^RAPSET1 I $D(XQUIT) K XQUIT,POP Q
- S RATEST="",RANUM=1,RAFMT=$S($P(RAMLC,"^",7):$P(RAMLC,"^",7),1:1)
- S ZTRTN="START^RAFLH1" F RASV="RATEST","RANUM","RAFMT","RAMDIV" S ZTSAVE(RASV)=""
- D ZIS^RAUTL G Q:RAPOP
- START U IO S RAK=0
- F S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0 D SETFLH^RAFLH2(RAK)
- G Q:'$D(^RA(78.2,RAFMT,0))
- F RAII=1:1:RANUM W @IOF F RAI=0:0 S RAI=$O(^RA(78.2,RAFMT,"E",RAI)) Q:RAI'>0 D
- . I $G(^RA(78.2,RAFMT,"E",RAI,0))'["@" D
- .. X ^RA(78.2,RAFMT,"E",RAI,0)
- .. Q
- . E D XECFLH^RAFLH2(RAFMT,RAI)
- . Q
- Q ; Quit & kill
- ; RAOPT("RPTPAT") is defined in the entry action field for options
- ; in this case RAOPT("RPTPAT") is defined for the option RA RPTPAT.
- ; RA RPTPAT is allowed to print more than one record. If multiple
- ; records, this CLOSE^RAUTL will close the device after printing
- ; only one record. This causes subsequent records to be displayed to
- ; the HOME device.
- D:'$D(RAOPT("RPTPAT")) CLOSE^RAUTL S RAK=0
- F S RAK=$O(^RA(78.7,RAK)) Q:RAK'>0 D KILFLH^RAFLH2(RAK)
- 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
- I $D(ZTQUEUED) K RADFN,RADTI,RAFLH
- Q
- ;
- CMP ;This code compiles flash card formats into code stored in the
- ;'Compiled Logic' field #100 of file #78.2
- 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")
- 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)
- 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
- W !!?5,"...format '",$P(^RA(78.2,RAFMT,0),"^"),"' has been compiled."
- K RA787,RAROW,XX,RAI,RAII,RAIV,RADEF,J,TITL,COL,RAN,^TMP($J,"RAFORM")
- Q
- ;
- STORE S RAIV="DT",RADEF="" S:$D(^RA(78.7,+%,0)) RAIV=^(0),RADEF=$P(RAIV,"^",3),RAIV=$P(RAIV,"^",5)
- S RA787("E")=$G(^RA(78.7,+%,"E"))
- S TITL=$S(RAIV="RAFREE":"",$P(J,"^")="NONE":"",$P(J,"^")]"":$P(J,"^"),1:RADEF)
- 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)
- S RAN=RAN+1,FL=0
- Q
- ;
- ; Exam labels are printed on the device specified in the location
- ; parameter, FLASH CARD PRINTER NAME in File 79.1. If there is no
- ; value in that field, the user will be prompted for a device. The
- ; number of exam labels printed is defined in the location parameter,
- ; HOW MANY EXAM LABELS PER EXAM. That number is not changed by any
- ; parameter or combination of parameters. If that number is zero (or
- ; null), then no exam labels will be printed.
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAFLH1 3189 printed Feb 19, 2025@00:01:24 Page 2
- RAFLH1 ;HISC/CAH,FPT AISC/MJK,RMO-Print Radiology Exam Labels ;6/12/97 11:44
- +1 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
- +2 if 'RAEXLBLS
- QUIT
- IF RAFLHFL
- SET RACNI=RAFLHFL
- GOTO PRT
- +3 FOR RACNI=+$PIECE(RAFLHFL,";",2):0
- SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
- if RACNI'>0
- QUIT
- IF $DATA(^(RACNI,0))
- SET RAY3=^(0)
- DO PRT
- +4 QUIT
- PRT SET RAFMT=RAEXFM
- SET RANUM=RAEXLBLS
- DO PRT^RAFLH
- QUIT
- +1 ;
- TEST DO SET^RAPSET1
- IF $DATA(XQUIT)
- KILL XQUIT,POP
- QUIT
- +1 SET RATEST=""
- SET RANUM=1
- SET RAFMT=$SELECT($PIECE(RAMLC,"^",7):$PIECE(RAMLC,"^",7),1:1)
- +2 SET ZTRTN="START^RAFLH1"
- FOR RASV="RATEST","RANUM","RAFMT","RAMDIV"
- SET ZTSAVE(RASV)=""
- +3 DO ZIS^RAUTL
- if RAPOP
- GOTO Q
- START USE IO
- SET RAK=0
- +1 FOR
- SET RAK=$ORDER(^RA(78.7,RAK))
- if RAK'>0
- QUIT
- DO SETFLH^RAFLH2(RAK)
- +2 if '$DATA(^RA(78.2,RAFMT,0))
- GOTO Q
- +3 FOR RAII=1:1:RANUM
- WRITE @IOF
- FOR RAI=0:0
- SET RAI=$ORDER(^RA(78.2,RAFMT,"E",RAI))
- if RAI'>0
- QUIT
- Begin DoDot:1
- +4 IF $GET(^RA(78.2,RAFMT,"E",RAI,0))'["@"
- Begin DoDot:2
- +5 XECUTE ^RA(78.2,RAFMT,"E",RAI,0)
- +6 QUIT
- End DoDot:2
- +7 IF '$TEST
- DO XECFLH^RAFLH2(RAFMT,RAI)
- +8 QUIT
- End DoDot:1
- Q ; Quit & kill
- +1 ; RAOPT("RPTPAT") is defined in the entry action field for options
- +2 ; in this case RAOPT("RPTPAT") is defined for the option RA RPTPAT.
- +3 ; RA RPTPAT is allowed to print more than one record. If multiple
- +4 ; records, this CLOSE^RAUTL will close the device after printing
- +5 ; only one record. This causes subsequent records to be displayed to
- +6 ; the HOME device.
- +7 if '$DATA(RAOPT("RPTPAT"))
- DO CLOSE^RAUTL
- SET RAK=0
- +8 FOR
- SET RAK=$ORDER(^RA(78.7,RAK))
- if RAK'>0
- QUIT
- DO KILFLH^RAFLH2(RAK)
- +9 KILL %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
- +10 IF $DATA(ZTQUEUED)
- KILL RADFN,RADTI,RAFLH
- +11 QUIT
- +12 ;
- CMP ;This code compiles flash card formats into code stored in the
- +1 ;'Compiled Logic' field #100 of file #78.2
- +2 if '$DATA(^RA(78.2,RAFMT,0))
- QUIT
- SET RAROW=$SELECT($PIECE(^(0),"^",2):$PIECE(^(0),"^",2),1:6)
- KILL ^RA(78.2,RAFMT,"E"),^TMP($JOB,"RAFORM")
- +3 FOR RAI=0:0
- SET RAI=$ORDER(^RA(78.2,RAFMT,1,RAI))
- if RAI'>0
- QUIT
- IF $DATA(^(RAI,0))
- SET XX=^(0)
- SET ^TMP($JOB,"RAFORM",+$PIECE(XX,"^",2),+$PIECE(XX,"^",3),$PIECE(XX,"^"))=$PIECE(XX,"^",4,5)
- +4 SET RAN=1
- FOR RAI=1:1:RAROW
- SET FL=1
- if '$DATA(^TMP($JOB,"RAFORM",RAI))
- SET ^RA(78.2,RAFMT,"E",RAN,0)="W !"
- SET RAN=RAN+1
- IF $DATA(^(RAI))
- FOR COL=0:0
- SET COL=$ORDER(^TMP($JOB,"RAFORM",RAI,COL))
- if COL'>0
- QUIT
- SET %=""
- SET %=$ORDER(^(COL,%))
- SET J=^(%)
- DO STORE
- +5 WRITE !!?5,"...format '",$PIECE(^RA(78.2,RAFMT,0),"^"),"' has been compiled."
- +6 KILL RA787,RAROW,XX,RAI,RAII,RAIV,RADEF,J,TITL,COL,RAN,^TMP($JOB,"RAFORM")
- +7 QUIT
- +8 ;
- STORE SET RAIV="DT"
- SET RADEF=""
- if $DATA(^RA(78.7,+%,0))
- SET RAIV=^(0)
- SET RADEF=$PIECE(RAIV,"^",3)
- SET RAIV=$PIECE(RAIV,"^",5)
- +1 SET RA787("E")=$GET(^RA(78.7,+%,"E"))
- +2 SET TITL=$SELECT(RAIV="RAFREE":"",$PIECE(J,"^")="NONE":"",$PIECE(J,"^")]"":$PIECE(J,"^"),1:RADEF)
- +3 SET ^RA(78.2,RAFMT,"E",RAN,0)="W "_$SELECT(FL:"!",1:"")_"?"_(COL-1)_","""_TITL_""","_$SELECT(RAIV="RAFREE":""""_$PIECE(J,"^",2)_"""",RA787("E")["$$BCDE^RAUTL18":"@"_RAIV,1:RAIV)
- +4 SET RAN=RAN+1
- SET FL=0
- +5 QUIT
- +6 ;
- +7 ; Exam labels are printed on the device specified in the location
- +8 ; parameter, FLASH CARD PRINTER NAME in File 79.1. If there is no
- +9 ; value in that field, the user will be prompted for a device. The
- +10 ; number of exam labels printed is defined in the location parameter,
- +11 ; HOW MANY EXAM LABELS PER EXAM. That number is not changed by any
- +12 ; parameter or combination of parameters. If that number is zero (or
- +13 ; null), then no exam labels will be printed.