Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RAFLH

RAFLH.m

Go to the documentation of this file.
  1. 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. 1 Q:'$D(^RADPT(RADFN,0)) S RAY1=^(0) Q:'$D(^DPT(RADFN,0)) S RAY0=^(0)
  1. Q:'$D(^RADPT(RADFN,"DT",RADTI,0)) S RAY2=^(0)
  1. ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. 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
  1. ; pce 2 of RAFLHFL, is set only if 'Add Exams to Last Visit',
  1. ; so that loop is done only thru newly added exams
  1. 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
  1. EXIT D ^RAFLH1,Q^RAFLH1 Q
  1. CASE K RAX S RAFL=$S($P(X,"^",3)="":1,'$D(^%ZIS(1,+$P(X,"^",3),0)):1,1:0) Q:'RAFL
  1. ; if $D(RADIF) and using img loc's 'how many flash cards each visit',
  1. ; then RAVISIT1 is ignored, which may result in extra flash cards
  1. I RAFLHFL["ALL"!($D(RADIF)) D PRT Q
  1. ; RAVISIT1 defined if img loc param specifies exactly how many
  1. ; flash cards should print per visit (and div param is 'no') .
  1. ; When exactly that many cards have been printed, RANUMF is defined.
  1. D PRT S:$D(RAVISIT1) RANUMF=1
  1. Q
  1. ;
  1. RAFMT K RADIF S RAFMT=$S($P(X,"^",4):$P(X,"^",4),1:RAFLH) S:RAFMT'=RAFLH RADIF="" Q
  1. ;
  1. PRT I '$D(^RA(78.2,RAFMT,0)) W @$S($G(RAFFLF)]"":RAFFLF,1:IOF) Q
  1. N RACNT,RAIND1,RAIND2 D PSET^%ZISP
  1. N RAMEMLOW,RAPRTSET,RAEXSPEC,RAVAL
  1. D EN1^RAUTL20
  1. ; RAEXSPEC = array to store print fld that's exam specific
  1. I '$D(RATEST) D
  1. .;RAY=data dict: 78.21; fld: .01 (ptr to a file 78.7 record)
  1. .;RAX=zero node of the file 78.7 record
  1. .N RAY S RAI=0
  1. .F S RAI=$O(^RA(78.2,RAFMT,1,RAI)) Q:RAI'>0 D
  1. ..S RAY=+$P($G(^RA(78.2,RAFMT,1,RAI,0)),U) Q:'($D(^RA(78.7,RAY,"E"))#2)
  1. ..X ^RA(78.7,RAY,"E") ;w/P47
  1. ..I $P(^RA(78.7,RAY,0),U,6)="Y",$P(^(0),U,5)]"" S RAEXSPEC($P(^(0),U,5))=1
  1. ..Q
  1. .Q
  1. ;RANUM = # of jacket labels to print (user defined) RA LABELS - Jacket Labels (RAJAC)
  1. F RAII=1:1:RANUM D
  1. . S RAI=0 F S RAI=$O(^RA(78.2,RAFMT,"E",RAI)) Q:RAI'>0 D
  1. .. I $G(^RA(78.2,RAFMT,"E",RAI,0))'["@" D
  1. ... ; P47 add new SSAN vars: RACNDSP
  1. ... N RASSAN,RACSESAV,RACNDSP S RASSAN=""
  1. ... I $D(RADFN),$D(RADTI),$D(RACNI) S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
  1. ... S RACNDSP=$S((RASSAN'=""):RASSAN,1:$G(RACSE))
  1. ... I $$USESSAN^RAHLRU1() S RACSESAV=$G(RACSE),RACSE=RACNDSP
  1. ... X ^RA(78.2,RAFMT,"E",RAI,0)
  1. ... I $$USESSAN^RAHLRU1() S RACSE=RACSESAV
  1. ... S RAVAL=$P(^RA(78.2,RAFMT,"E",RAI,0),",RA",2) S:RAVAL]"" RAVAL="RA"_RAVAL
  1. ... I RAVAL]"",@RAVAL]"",$G(RAEXSPEC(RAVAL)),RAPRTSET W "+"
  1. ... Q
  1. .. E D XECFLH^RAFLH2(RAFMT,RAI)
  1. .. Q
  1. . I $G(RAFMT)=$G(RAHDFM) Q
  1. . W @$S($G(RAFFLF)]"":RAFFLF,1:IOF)
  1. . Q
  1. D PKILL^%ZISP K RAI,RAII
  1. Q
  1. ;
  1. FLH ; Flash card entry point.
  1. N RAPRNT S RAPRNT=$$PRINT^RAFLH2(RAMDIV,RAMLC,.RAPX) Q:'RAPRNT
  1. ; from orig. devlprs -- if NO default flashcard format, set RAFLH to 1
  1. S (RAEXFM,RAEXLBLS)=0,RANUM=1,RAFLH=$S($P(RAMLC,"^",7):$P(RAMLC,"^",7),1:1)
  1. K RAFLHCNT
  1. F I=0:0 S I=$O(RAPX(I)) Q:I'>0 S RAFLHCNT(I)=""
  1. ; Print a flash card for each proc whose 'Required Flash Card Printer'
  1. ; field contains a valid printer regardless of other loc and div params
  1. ; For each card printed, its corresponding RAFLHCNT(I) is deleted.
  1. ; Any RAFLHCNT() left would mean continuing on to paragragh 1
  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
  1. .S RAMES="W !!?3,""NOTE: Case No. "",$P(RAPX(I),""^""),"" ("",$E($P(RAPX(I),""^"",2),1,20),"") has been queued to printer "",ION,""."",!"
  1. .S RAMESCNT=$G(RAMESCNT)+1
  1. .K RAFLHCNT(I)
  1. S RAMES="W !?5,""...all needed flash cards and exam labels queued to print on "",ION,""."",!"
  1. ; known problem inheritied :
  1. ; when all flash cards have been printed because all the procedures
  1. ; had REQUIRED FLASH CARD PRINTER defined, then the following msg
  1. ; should not print, but as inherited, it does
  1. S:$D(RAMESCNT) RAMES="W !?5,""...all remaining flash cards and exam labels queued to print on "",ION,""."",!"
  1. K RAMESCNT S ION=$P(RAMLC,"^",3),IOP=$S(ION]"":"Q;"_ION,1:"Q")
  1. I IOP="Q" S RASELDEV="Select the FLASH CARD/EXAM LABEL Printer"
  1. ; RAVSTFLG is from 'Add Exams to Last Visit'
  1. S RAFLHFL=$S($P(RAMDV,"^",2):"ALL",1:"") S:$D(RAVSTFLG) RAFLHFL=RAFLHFL_";"_($O(RAPX(0))-1)
  1. S RANUM=$S($P(RAMDV,"^",2):1,1:$P(RAMLC,"^",2))
  1. ; no. flash cards to print :
  1. ; if from RAMDV = 1 card only for each exam (procedure)
  1. ; if from RAMLC = n cards for the first procedure
  1. S RAEXLBLS=+$P(RAMLC,"^",8)
  1. ; from orig. devlprs -- if NO default flashcard format, set RAEXFM to 1
  1. S RAEXFM=$S($P(RAMLC,"^",9):$P(RAMLC,"^",9),1:1)
  1. K RAVISIT1 I '$P(RAMDV,U,2),$P(RAMLC,U,2) S RAVISIT1=1
  1. ; RAVISIT1 = 1 if paragraph 1's For-loop should be done once only
  1. I $D(RASELDEV),RANUM=0,RAEXLBLS=0 K IOP,RAMES,RASELDEV Q
  1. ; known problem inherited :
  1. ; in the next line, this early quit would mean not printing full amt of
  1. ; flash cards, if HOW MANY FLASH CARDS PER VISIT > # procs already prt'd
  1. I '$D(RAFLHCNT),$D(RASELDEV),RAEXLBLS=0 K IOP,RAMES,RASELDEV Q
  1. I $D(RASELDEV),$D(RAFLHCNT),RAEXLBLS=0 S RASELDEV="Select the FLASH CARD Printer"
  1. I '$D(RAFLHCNT),$D(RASELDEV),RAEXLBLS>0 S RASELDEV="Select the EXAM LABEL Printer"
  1. I $D(RAFLHCNT),$D(RASELDEV),RANUM=0,RAEXLBLS>0 S RASELDEV="Select the EXAM LABEL Printer"
  1. ;
  1. Q ;save off variables for TaskMan RACNI, RAMDIV, RASAV2, & RASAV3 added w/RA*5.0*47
  1. S ZTDTH=$H,ZTRTN="DQ^RAFLH"
  1. F RASV="RADFN","RADTI","RAFLHFL","RAFLH","RANUM","RAEXLBLS","RAEXFM","RAMDIV","RACNI" S ZTSAVE(RASV)=""
  1. S:$D(RAVISIT1) ZTSAVE("RAVISIT1")=""
  1. S:$D(RASAV2) ZTSAVE("RASAV2")=""
  1. S:$D(RASAV3) ZTSAVE("RASAV3")=""
  1. W ! D ZIS^RAUTL Q:RAPOP
  1. DQ U IO S U="^" S X="T",%DT="" D ^%DT S DT=Y G RAFLH
  1. ;
  1. ; If there is a flash card printer associated with the procedure, then
  1. ; one flash card will print out at that printer regardless of any
  1. ; division or location parameters concerning flash cards.
  1. ;
  1. ; If there is no flash card printer associated with the procedure and
  1. ; the division parameter is set to YES, then one flash card will print
  1. ; out at the flash card printer specified in the location parameter.
  1. ; If there is no printer specified in the location parameter, then
  1. ; the user will be prompted for a device.
  1. ;
  1. ; If there is no flash card printer associated with the procedure and
  1. ; the division parameter is set to NO, then the number of flash cards
  1. ; printed out will equal the value in the location parameter field,
  1. ; HOW MANY FLASH CARDS PER VISIT. The flash cards will print out at the
  1. ; flash card printer specified in the location parameter. If there is
  1. ; no printer specified in the location parameter, then the user will be
  1. ; prompted for a device.
  1. ;