- RAFLH ;HISC/FPT AISC/MJK-Print Radiology Flash Cards ;12/4/97 12:25
- ;;5.0;Radiology/Nuclear Medicine;**47**;Mar 16, 1998;Build 21
- 1 Q:'$D(^RADPT(RADFN,0)) S RAY1=^(0) Q:'$D(^DPT(RADFN,0)) S RAY0=^(0)
- Q:'$D(^RADPT(RADFN,"DT",RADTI,0)) S RAY2=^(0)
- ;
- I $D(ZTQUEUED) S ZTREQ="@"
- I RAFLHFL S RACNI=RAFLHFL Q:'$D(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) S RAY3=^(0),X=$S($D(^RAMIS(71,+$P(RAY3,"^",2),0)):^(0),1:"") D RAFMT,PRT G EXIT
- ; pce 2 of RAFLHFL, is set only if 'Add Exams to Last Visit',
- ; so that loop is done only thru newly added exams
- F RACNI=+$P(RAFLHFL,";",2):0 S RAFMT=RAFLH,RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:RACNI'>0!($D(RANUMF)) I $D(^(RACNI,0)) S RAY3=^(0),X=$S($D(^RAMIS(71,+$P(RAY3,"^",2),0)):^(0),1:"") D RAFMT D CASE
- EXIT D ^RAFLH1,Q^RAFLH1 Q
- CASE K RAX S RAFL=$S($P(X,"^",3)="":1,'$D(^%ZIS(1,+$P(X,"^",3),0)):1,1:0) Q:'RAFL
- ; if $D(RADIF) and using img loc's 'how many flash cards each visit',
- ; then RAVISIT1 is ignored, which may result in extra flash cards
- I RAFLHFL["ALL"!($D(RADIF)) D PRT Q
- ; RAVISIT1 defined if img loc param specifies exactly how many
- ; flash cards should print per visit (and div param is 'no') .
- ; When exactly that many cards have been printed, RANUMF is defined.
- D PRT S:$D(RAVISIT1) RANUMF=1
- Q
- ;
- RAFMT K RADIF S RAFMT=$S($P(X,"^",4):$P(X,"^",4),1:RAFLH) S:RAFMT'=RAFLH RADIF="" Q
- ;
- PRT I '$D(^RA(78.2,RAFMT,0)) W @$S($G(RAFFLF)]"":RAFFLF,1:IOF) Q
- N RACNT,RAIND1,RAIND2 D PSET^%ZISP
- N RAMEMLOW,RAPRTSET,RAEXSPEC,RAVAL
- D EN1^RAUTL20
- ; RAEXSPEC = array to store print fld that's exam specific
- I '$D(RATEST) D
- .;RAY=data dict: 78.21; fld: .01 (ptr to a file 78.7 record)
- .;RAX=zero node of the file 78.7 record
- .N RAY S RAI=0
- .F S RAI=$O(^RA(78.2,RAFMT,1,RAI)) Q:RAI'>0 D
- ..S RAY=+$P($G(^RA(78.2,RAFMT,1,RAI,0)),U) Q:'($D(^RA(78.7,RAY,"E"))#2)
- ..X ^RA(78.7,RAY,"E") ;w/P47
- ..I $P(^RA(78.7,RAY,0),U,6)="Y",$P(^(0),U,5)]"" S RAEXSPEC($P(^(0),U,5))=1
- ..Q
- .Q
- ;RANUM = # of jacket labels to print (user defined) RA LABELS - Jacket Labels (RAJAC)
- F RAII=1:1:RANUM D
- . S RAI=0 F S RAI=$O(^RA(78.2,RAFMT,"E",RAI)) Q:RAI'>0 D
- .. I $G(^RA(78.2,RAFMT,"E",RAI,0))'["@" D
- ... ; P47 add new SSAN vars: RACNDSP
- ... N RASSAN,RACSESAV,RACNDSP S RASSAN=""
- ... I $D(RADFN),$D(RADTI),$D(RACNI) S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
- ... S RACNDSP=$S((RASSAN'=""):RASSAN,1:$G(RACSE))
- ... I $$USESSAN^RAHLRU1() S RACSESAV=$G(RACSE),RACSE=RACNDSP
- ... X ^RA(78.2,RAFMT,"E",RAI,0)
- ... I $$USESSAN^RAHLRU1() S RACSE=RACSESAV
- ... S RAVAL=$P(^RA(78.2,RAFMT,"E",RAI,0),",RA",2) S:RAVAL]"" RAVAL="RA"_RAVAL
- ... I RAVAL]"",@RAVAL]"",$G(RAEXSPEC(RAVAL)),RAPRTSET W "+"
- ... Q
- .. E D XECFLH^RAFLH2(RAFMT,RAI)
- .. Q
- . I $G(RAFMT)=$G(RAHDFM) Q
- . W @$S($G(RAFFLF)]"":RAFFLF,1:IOF)
- . Q
- D PKILL^%ZISP K RAI,RAII
- Q
- ;
- FLH ; Flash card entry point.
- N RAPRNT S RAPRNT=$$PRINT^RAFLH2(RAMDIV,RAMLC,.RAPX) Q:'RAPRNT
- ; from orig. devlprs -- if NO default flashcard format, set RAFLH to 1
- S (RAEXFM,RAEXLBLS)=0,RANUM=1,RAFLH=$S($P(RAMLC,"^",7):$P(RAMLC,"^",7),1:1)
- K RAFLHCNT
- F I=0:0 S I=$O(RAPX(I)) Q:I'>0 S RAFLHCNT(I)=""
- ; Print a flash card for each proc whose 'Required Flash Card Printer'
- ; field contains a valid printer regardless of other loc and div params
- ; For each card printed, its corresponding RAFLHCNT(I) is deleted.
- ; Any RAFLHCNT() left would mean continuing on to paragragh 1
- F I=0:0 S I=$O(RAPX(I)) Q:I'>0 I $P(RAPX(I),"^",4)]"",$D(^%ZIS(1,+$P(RAPX(I),"^",4),0)) S ION=$P(^(0),"^"),IOP=$S(ION]"":"Q;"_ION,1:"Q"),RAFLHFL=I D D Q
- .S RAMES="W !!?3,""NOTE: Case No. "",$P(RAPX(I),""^""),"" ("",$E($P(RAPX(I),""^"",2),1,20),"") has been queued to printer "",ION,""."",!"
- .S RAMESCNT=$G(RAMESCNT)+1
- .K RAFLHCNT(I)
- S RAMES="W !?5,""...all needed flash cards and exam labels queued to print on "",ION,""."",!"
- ; known problem inheritied :
- ; when all flash cards have been printed because all the procedures
- ; had REQUIRED FLASH CARD PRINTER defined, then the following msg
- ; should not print, but as inherited, it does
- S:$D(RAMESCNT) RAMES="W !?5,""...all remaining flash cards and exam labels queued to print on "",ION,""."",!"
- K RAMESCNT S ION=$P(RAMLC,"^",3),IOP=$S(ION]"":"Q;"_ION,1:"Q")
- I IOP="Q" S RASELDEV="Select the FLASH CARD/EXAM LABEL Printer"
- ; RAVSTFLG is from 'Add Exams to Last Visit'
- S RAFLHFL=$S($P(RAMDV,"^",2):"ALL",1:"") S:$D(RAVSTFLG) RAFLHFL=RAFLHFL_";"_($O(RAPX(0))-1)
- S RANUM=$S($P(RAMDV,"^",2):1,1:$P(RAMLC,"^",2))
- ; no. flash cards to print :
- ; if from RAMDV = 1 card only for each exam (procedure)
- ; if from RAMLC = n cards for the first procedure
- S RAEXLBLS=+$P(RAMLC,"^",8)
- ; from orig. devlprs -- if NO default flashcard format, set RAEXFM to 1
- S RAEXFM=$S($P(RAMLC,"^",9):$P(RAMLC,"^",9),1:1)
- K RAVISIT1 I '$P(RAMDV,U,2),$P(RAMLC,U,2) S RAVISIT1=1
- ; RAVISIT1 = 1 if paragraph 1's For-loop should be done once only
- I $D(RASELDEV),RANUM=0,RAEXLBLS=0 K IOP,RAMES,RASELDEV Q
- ; known problem inherited :
- ; in the next line, this early quit would mean not printing full amt of
- ; flash cards, if HOW MANY FLASH CARDS PER VISIT > # procs already prt'd
- I '$D(RAFLHCNT),$D(RASELDEV),RAEXLBLS=0 K IOP,RAMES,RASELDEV Q
- I $D(RASELDEV),$D(RAFLHCNT),RAEXLBLS=0 S RASELDEV="Select the FLASH CARD Printer"
- I '$D(RAFLHCNT),$D(RASELDEV),RAEXLBLS>0 S RASELDEV="Select the EXAM LABEL Printer"
- I $D(RAFLHCNT),$D(RASELDEV),RANUM=0,RAEXLBLS>0 S RASELDEV="Select the EXAM LABEL Printer"
- ;
- Q ;save off variables for TaskMan RACNI, RAMDIV, RASAV2, & RASAV3 added w/RA*5.0*47
- S ZTDTH=$H,ZTRTN="DQ^RAFLH"
- F RASV="RADFN","RADTI","RAFLHFL","RAFLH","RANUM","RAEXLBLS","RAEXFM","RAMDIV","RACNI" S ZTSAVE(RASV)=""
- S:$D(RAVISIT1) ZTSAVE("RAVISIT1")=""
- S:$D(RASAV2) ZTSAVE("RASAV2")=""
- S:$D(RASAV3) ZTSAVE("RASAV3")=""
- W ! D ZIS^RAUTL Q:RAPOP
- DQ U IO S U="^" S X="T",%DT="" D ^%DT S DT=Y G RAFLH
- ;
- ; If there is a flash card printer associated with the procedure, then
- ; one flash card will print out at that printer regardless of any
- ; division or location parameters concerning flash cards.
- ;
- ; If there is no flash card printer associated with the procedure and
- ; the division parameter is set to YES, then one flash card will print
- ; out at the flash card printer specified in the location parameter.
- ; If there is no printer specified in the location parameter, then
- ; the user will be prompted for a device.
- ;
- ; If there is no flash card printer associated with the procedure and
- ; the division parameter is set to NO, then the number of flash cards
- ; printed out will equal the value in the location parameter field,
- ; HOW MANY FLASH CARDS PER VISIT. The flash cards will print out at the
- ; flash card printer specified in the location parameter. If there is
- ; no printer specified in the location parameter, then the user will be
- ; prompted for a device.
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAFLH 6948 printed Feb 19, 2025@00:01:23 Page 2
- RAFLH ;HISC/FPT AISC/MJK-Print Radiology Flash Cards ;12/4/97 12:25
- +1 ;;5.0;Radiology/Nuclear Medicine;**47**;Mar 16, 1998;Build 21
- 1 if '$DATA(^RADPT(RADFN,0))
- QUIT
- SET RAY1=^(0)
- if '$DATA(^DPT(RADFN,0))
- QUIT
- SET RAY0=^(0)
- +1 if '$DATA(^RADPT(RADFN,"DT",RADTI,0))
- QUIT
- SET RAY2=^(0)
- +2 ;
- +3 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +4 IF RAFLHFL
- SET RACNI=RAFLHFL
- if '$DATA(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
- QUIT
- SET RAY3=^(0)
- SET X=$SELECT($DATA(^RAMIS(71,+$PIECE(RAY3,"^",2),0)):^(0),1:"")
- DO RAFMT
- DO PRT
- GOTO EXIT
- +5 ; pce 2 of RAFLHFL, is set only if 'Add Exams to Last Visit',
- +6 ; so that loop is done only thru newly added exams
- +7 FOR RACNI=+$PIECE(RAFLHFL,";",2):0
- SET RAFMT=RAFLH
- SET RACNI=$ORDER(^RADPT(RADFN,"DT",RADTI,"P",RACNI))
- if RACNI'>0!($DATA(RANUMF))
- QUIT
- IF $DATA(^(RACNI,0))
- SET RAY3=^(0)
- SET X=$SELECT($DATA(^RAMIS(71,+$PIECE(RAY3,"^",2),0)):^(0),1:"")
- DO RAFMT
- DO CASE
- EXIT DO ^RAFLH1
- DO Q^RAFLH1
- QUIT
- CASE KILL RAX
- SET RAFL=$SELECT($PIECE(X,"^",3)="":1,'$DATA(^%ZIS(1,+$PIECE(X,"^",3),0)):1,1:0)
- if 'RAFL
- QUIT
- +1 ; if $D(RADIF) and using img loc's 'how many flash cards each visit',
- +2 ; then RAVISIT1 is ignored, which may result in extra flash cards
- +3 IF RAFLHFL["ALL"!($DATA(RADIF))
- DO PRT
- QUIT
- +4 ; RAVISIT1 defined if img loc param specifies exactly how many
- +5 ; flash cards should print per visit (and div param is 'no') .
- +6 ; When exactly that many cards have been printed, RANUMF is defined.
- +7 DO PRT
- if $DATA(RAVISIT1)
- SET RANUMF=1
- +8 QUIT
- +9 ;
- RAFMT KILL RADIF
- SET RAFMT=$SELECT($PIECE(X,"^",4):$PIECE(X,"^",4),1:RAFLH)
- if RAFMT'=RAFLH
- SET RADIF=""
- QUIT
- +1 ;
- PRT IF '$DATA(^RA(78.2,RAFMT,0))
- WRITE @$SELECT($GET(RAFFLF)]"":RAFFLF,1:IOF)
- QUIT
- +1 NEW RACNT,RAIND1,RAIND2
- DO PSET^%ZISP
- +2 NEW RAMEMLOW,RAPRTSET,RAEXSPEC,RAVAL
- +3 DO EN1^RAUTL20
- +4 ; RAEXSPEC = array to store print fld that's exam specific
- +5 IF '$DATA(RATEST)
- Begin DoDot:1
- +6 ;RAY=data dict: 78.21; fld: .01 (ptr to a file 78.7 record)
- +7 ;RAX=zero node of the file 78.7 record
- +8 NEW RAY
- SET RAI=0
- +9 FOR
- SET RAI=$ORDER(^RA(78.2,RAFMT,1,RAI))
- if RAI'>0
- QUIT
- Begin DoDot:2
- +10 SET RAY=+$PIECE($GET(^RA(78.2,RAFMT,1,RAI,0)),U)
- if '($DATA(^RA(78.7,RAY,"E"))#2)
- QUIT
- +11 ;w/P47
- XECUTE ^RA(78.7,RAY,"E")
- +12 IF $PIECE(^RA(78.7,RAY,0),U,6)="Y"
- IF $PIECE(^(0),U,5)]""
- SET RAEXSPEC($PIECE(^(0),U,5))=1
- +13 QUIT
- End DoDot:2
- +14 QUIT
- End DoDot:1
- +15 ;RANUM = # of jacket labels to print (user defined) RA LABELS - Jacket Labels (RAJAC)
- +16 FOR RAII=1:1:RANUM
- Begin DoDot:1
- +17 SET RAI=0
- FOR
- SET RAI=$ORDER(^RA(78.2,RAFMT,"E",RAI))
- if RAI'>0
- QUIT
- Begin DoDot:2
- +18 IF $GET(^RA(78.2,RAFMT,"E",RAI,0))'["@"
- Begin DoDot:3
- +19 ; P47 add new SSAN vars: RACNDSP
- +20 NEW RASSAN,RACSESAV,RACNDSP
- SET RASSAN=""
- +21 IF $DATA(RADFN)
- IF $DATA(RADTI)
- IF $DATA(RACNI)
- SET RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
- +22 SET RACNDSP=$SELECT((RASSAN'=""):RASSAN,1:$GET(RACSE))
- +23 IF $$USESSAN^RAHLRU1()
- SET RACSESAV=$GET(RACSE)
- SET RACSE=RACNDSP
- +24 XECUTE ^RA(78.2,RAFMT,"E",RAI,0)
- +25 IF $$USESSAN^RAHLRU1()
- SET RACSE=RACSESAV
- +26 SET RAVAL=$PIECE(^RA(78.2,RAFMT,"E",RAI,0),",RA",2)
- if RAVAL]""
- SET RAVAL="RA"_RAVAL
- +27 IF RAVAL]""
- IF @RAVAL]""
- IF $GET(RAEXSPEC(RAVAL))
- IF RAPRTSET
- WRITE "+"
- +28 QUIT
- End DoDot:3
- +29 IF '$TEST
- DO XECFLH^RAFLH2(RAFMT,RAI)
- +30 QUIT
- End DoDot:2
- +31 IF $GET(RAFMT)=$GET(RAHDFM)
- QUIT
- +32 WRITE @$SELECT($GET(RAFFLF)]"":RAFFLF,1:IOF)
- +33 QUIT
- End DoDot:1
- +34 DO PKILL^%ZISP
- KILL RAI,RAII
- +35 QUIT
- +36 ;
- FLH ; Flash card entry point.
- +1 NEW RAPRNT
- SET RAPRNT=$$PRINT^RAFLH2(RAMDIV,RAMLC,.RAPX)
- if 'RAPRNT
- QUIT
- +2 ; from orig. devlprs -- if NO default flashcard format, set RAFLH to 1
- +3 SET (RAEXFM,RAEXLBLS)=0
- SET RANUM=1
- SET RAFLH=$SELECT($PIECE(RAMLC,"^",7):$PIECE(RAMLC,"^",7),1:1)
- +4 KILL RAFLHCNT
- +5 FOR I=0:0
- SET I=$ORDER(RAPX(I))
- if I'>0
- QUIT
- SET RAFLHCNT(I)=""
- +6 ; Print a flash card for each proc whose 'Required Flash Card Printer'
- +7 ; field contains a valid printer regardless of other loc and div params
- +8 ; For each card printed, its corresponding RAFLHCNT(I) is deleted.
- +9 ; Any RAFLHCNT() left would mean continuing on to paragragh 1
- +10 FOR I=0:0
- SET I=$ORDER(RAPX(I))
- if I'>0
- QUIT
- IF $PIECE(RAPX(I),"^",4)]""
- IF $DATA(^%ZIS(1,+$PIECE(RAPX(I),"^",4),0))
- SET ION=$PIECE(^(0),"^")
- SET IOP=$SELECT(ION]"":"Q;"_ION,1:"Q")
- SET RAFLHFL=I
- Begin DoDot:1
- +11 SET RAMES="W !!?3,""NOTE: Case No. "",$P(RAPX(I),""^""),"" ("",$E($P(RAPX(I),""^"",2),1,20),"") has been queued to printer "",ION,""."",!"
- +12 SET RAMESCNT=$GET(RAMESCNT)+1
- +13 KILL RAFLHCNT(I)
- End DoDot:1
- DO Q
- +14 SET RAMES="W !?5,""...all needed flash cards and exam labels queued to print on "",ION,""."",!"
- +15 ; known problem inheritied :
- +16 ; when all flash cards have been printed because all the procedures
- +17 ; had REQUIRED FLASH CARD PRINTER defined, then the following msg
- +18 ; should not print, but as inherited, it does
- +19 if $DATA(RAMESCNT)
- SET RAMES="W !?5,""...all remaining flash cards and exam labels queued to print on "",ION,""."",!"
- +20 KILL RAMESCNT
- SET ION=$PIECE(RAMLC,"^",3)
- SET IOP=$SELECT(ION]"":"Q;"_ION,1:"Q")
- +21 IF IOP="Q"
- SET RASELDEV="Select the FLASH CARD/EXAM LABEL Printer"
- +22 ; RAVSTFLG is from 'Add Exams to Last Visit'
- +23 SET RAFLHFL=$SELECT($PIECE(RAMDV,"^",2):"ALL",1:"")
- if $DATA(RAVSTFLG)
- SET RAFLHFL=RAFLHFL_";"_($ORDER(RAPX(0))-1)
- +24 SET RANUM=$SELECT($PIECE(RAMDV,"^",2):1,1:$PIECE(RAMLC,"^",2))
- +25 ; no. flash cards to print :
- +26 ; if from RAMDV = 1 card only for each exam (procedure)
- +27 ; if from RAMLC = n cards for the first procedure
- +28 SET RAEXLBLS=+$PIECE(RAMLC,"^",8)
- +29 ; from orig. devlprs -- if NO default flashcard format, set RAEXFM to 1
- +30 SET RAEXFM=$SELECT($PIECE(RAMLC,"^",9):$PIECE(RAMLC,"^",9),1:1)
- +31 KILL RAVISIT1
- IF '$PIECE(RAMDV,U,2)
- IF $PIECE(RAMLC,U,2)
- SET RAVISIT1=1
- +32 ; RAVISIT1 = 1 if paragraph 1's For-loop should be done once only
- +33 IF $DATA(RASELDEV)
- IF RANUM=0
- IF RAEXLBLS=0
- KILL IOP,RAMES,RASELDEV
- QUIT
- +34 ; known problem inherited :
- +35 ; in the next line, this early quit would mean not printing full amt of
- +36 ; flash cards, if HOW MANY FLASH CARDS PER VISIT > # procs already prt'd
- +37 IF '$DATA(RAFLHCNT)
- IF $DATA(RASELDEV)
- IF RAEXLBLS=0
- KILL IOP,RAMES,RASELDEV
- QUIT
- +38 IF $DATA(RASELDEV)
- IF $DATA(RAFLHCNT)
- IF RAEXLBLS=0
- SET RASELDEV="Select the FLASH CARD Printer"
- +39 IF '$DATA(RAFLHCNT)
- IF $DATA(RASELDEV)
- IF RAEXLBLS>0
- SET RASELDEV="Select the EXAM LABEL Printer"
- +40 IF $DATA(RAFLHCNT)
- IF $DATA(RASELDEV)
- IF RANUM=0
- IF RAEXLBLS>0
- SET RASELDEV="Select the EXAM LABEL Printer"
- +41 ;
- Q ;save off variables for TaskMan RACNI, RAMDIV, RASAV2, & RASAV3 added w/RA*5.0*47
- +1 SET ZTDTH=$HOROLOG
- SET ZTRTN="DQ^RAFLH"
- +2 FOR RASV="RADFN","RADTI","RAFLHFL","RAFLH","RANUM","RAEXLBLS","RAEXFM","RAMDIV","RACNI"
- SET ZTSAVE(RASV)=""
- +3 if $DATA(RAVISIT1)
- SET ZTSAVE("RAVISIT1")=""
- +4 if $DATA(RASAV2)
- SET ZTSAVE("RASAV2")=""
- +5 if $DATA(RASAV3)
- SET ZTSAVE("RASAV3")=""
- +6 WRITE !
- DO ZIS^RAUTL
- if RAPOP
- QUIT
- DQ USE IO
- SET U="^"
- SET X="T"
- SET %DT=""
- DO ^%DT
- SET DT=Y
- GOTO RAFLH
- +1 ;
- +2 ; If there is a flash card printer associated with the procedure, then
- +3 ; one flash card will print out at that printer regardless of any
- +4 ; division or location parameters concerning flash cards.
- +5 ;
- +6 ; If there is no flash card printer associated with the procedure and
- +7 ; the division parameter is set to YES, then one flash card will print
- +8 ; out at the flash card printer specified in the location parameter.
- +9 ; If there is no printer specified in the location parameter, then
- +10 ; the user will be prompted for a device.
- +11 ;
- +12 ; If there is no flash card printer associated with the procedure and
- +13 ; the division parameter is set to NO, then the number of flash cards
- +14 ; printed out will equal the value in the location parameter field,
- +15 ; HOW MANY FLASH CARDS PER VISIT. The flash cards will print out at the
- +16 ; flash card printer specified in the location parameter. If there is
- +17 ; no printer specified in the location parameter, then the user will be
- +18 ; prompted for a device.
- +19 ;