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 Apr 09, 2024@21:42:14 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 ;
