source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAFLH.m@ 1590

Last change on this file since 1590 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.9 KB
Line 
1RAFLH ;HISC/FPT AISC/MJK-Print Radiology Flash Cards ;12/4/97 12:25
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
31 Q:'$D(^RADPT(RADFN,0)) S RAY1=^(0) Q:'$D(^DPT(RADFN,0)) S RAY0=^(0)
4 Q:'$D(^RADPT(RADFN,"DT",RADTI,0)) S RAY2=^(0)
5 ;
6 I $D(ZTQUEUED) S ZTREQ="@"
7 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
8 ; pce 2 of RAFLHFL, is set only if 'Add Exams to Last Visit',
9 ; so that loop is done only thru newly added exams
10 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
11EXIT D ^RAFLH1,Q^RAFLH1 Q
12CASE K RAX S RAFL=$S($P(X,"^",3)="":1,'$D(^%ZIS(1,+$P(X,"^",3),0)):1,1:0) Q:'RAFL
13 ; if $D(RADIF) and using img loc's 'how many flash cards each visit',
14 ; then RAVISIT1 is ignored, which may result in extra flash cards
15 I RAFLHFL["ALL"!($D(RADIF)) D PRT Q
16 ; RAVISIT1 defined if img loc param specifies exactly how many
17 ; flash cards should print per visit (and div param is 'no') .
18 ; When exactly that many cards have been printed, RANUMF is defined.
19 D PRT S:$D(RAVISIT1) RANUMF=1
20 Q
21 ;
22RAFMT K RADIF S RAFMT=$S($P(X,"^",4):$P(X,"^",4),1:RAFLH) S:RAFMT'=RAFLH RADIF="" Q
23 ;
24PRT I '$D(^RA(78.2,RAFMT,0)) W @$S($G(RAFFLF)]"":RAFFLF,1:IOF) Q
25 N RACNT,RAIND1,RAIND2 D PSET^%ZISP
26 N RAMEMLOW,RAPRTSET,RAEXSPEC,RAVAL
27 D EN1^RAUTL20
28 ; RAEXSPEC = array to store print fld that's exam specific
29 I '$D(RATEST) F RAI=0:0 S RAI=$O(^RA(78.2,RAFMT,1,RAI)) Q:RAI'>0 I $D(^(RAI,0)),$D(^RA(78.7,+^(0),"E")) X ^("E") I $P(^RA(78.7,+^RA(78.2,RAFMT,1,RAI,0),0),"^",6)="Y",$P(^(0),"^",5)]"" S RAEXSPEC($P(^(0),"^",5))=1
30 F RAII=1:1:RANUM D
31 . F RAI=0:0 S RAI=$O(^RA(78.2,RAFMT,"E",RAI)) Q:RAI'>0 D
32 .. I $G(^RA(78.2,RAFMT,"E",RAI,0))'["@" D
33 ... X ^RA(78.2,RAFMT,"E",RAI,0)
34 ... S RAVAL=$P(^RA(78.2,RAFMT,"E",RAI,0),",RA",2) S:RAVAL]"" RAVAL="RA"_RAVAL
35 ... I RAVAL]"",@RAVAL]"",$G(RAEXSPEC(RAVAL)),RAPRTSET W "+"
36 ... Q
37 .. E D XECFLH^RAFLH2(RAFMT,RAI)
38 .. Q
39 . I $G(RAFMT)=$G(RAHDFM) Q
40 . W @$S($G(RAFFLF)]"":RAFFLF,1:IOF)
41 . Q
42 D PKILL^%ZISP K RAI,RAII
43 Q
44 ;
45FLH ; Flash card entry point.
46 N RAPRNT S RAPRNT=$$PRINT^RAFLH2(RAMDIV,RAMLC,.RAPX) Q:'RAPRNT
47 ; from orig. devlprs -- if NO default flashcard format, set RAFLH to 1
48 S (RAEXFM,RAEXLBLS)=0,RANUM=1,RAFLH=$S($P(RAMLC,"^",7):$P(RAMLC,"^",7),1:1)
49 K RAFLHCNT
50 F I=0:0 S I=$O(RAPX(I)) Q:I'>0 S RAFLHCNT(I)=""
51 ; Print a flash card for each proc whose 'Required Flash Card Printer'
52 ; field contains a valid printer regardless of other loc and div params
53 ; For each card printed, its corresponding RAFLHCNT(I) is deleted.
54 ; Any RAFLHCNT() left would mean continuing on to paragragh 1
55 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
56 .S RAMES="W !!?3,""NOTE: Case No. "",$P(RAPX(I),""^""),"" ("",$E($P(RAPX(I),""^"",2),1,20),"") has been queued to printer "",ION,""."",!"
57 .S RAMESCNT=$G(RAMESCNT)+1
58 .K RAFLHCNT(I)
59 S RAMES="W !?5,""...all needed flash cards and exam labels queued to print on "",ION,""."",!"
60 ; known problem inheritied :
61 ; when all flash cards have been printed because all the procedures
62 ; had REQUIRED FLASH CARD PRINTER defined, then the following msg
63 ; should not print, but as inherited, it does
64 S:$D(RAMESCNT) RAMES="W !?5,""...all remaining flash cards and exam labels queued to print on "",ION,""."",!"
65 K RAMESCNT S ION=$P(RAMLC,"^",3),IOP=$S(ION]"":"Q;"_ION,1:"Q")
66 I IOP="Q" S RASELDEV="Select the FLASH CARD/EXAM LABEL Printer"
67 ; RAVSTFLG is from 'Add Exams to Last Visit'
68 S RAFLHFL=$S($P(RAMDV,"^",2):"ALL",1:"") S:$D(RAVSTFLG) RAFLHFL=RAFLHFL_";"_($O(RAPX(0))-1)
69 S RANUM=$S($P(RAMDV,"^",2):1,1:$P(RAMLC,"^",2))
70 ; no. flash cards to print :
71 ; if from RAMDV = 1 card only for each exam (procedure)
72 ; if from RAMLC = n cards for the first procedure
73 S RAEXLBLS=+$P(RAMLC,"^",8)
74 ; from orig. devlprs -- if NO default flashcard format, set RAEXFM to 1
75 S RAEXFM=$S($P(RAMLC,"^",9):$P(RAMLC,"^",9),1:1)
76 K RAVISIT1 I '$P(RAMDV,U,2),$P(RAMLC,U,2) S RAVISIT1=1
77 ; RAVISIT1 = 1 if paragraph 1's For-loop should be done once only
78 I $D(RASELDEV),RANUM=0,RAEXLBLS=0 K IOP,RAMES,RASELDEV Q
79 ; known problem inherited :
80 ; in the next line, this early quit would mean not printing full amt of
81 ; flash cards, if HOW MANY FLASH CARDS PER VISIT > # procs already prt'd
82 I '$D(RAFLHCNT),$D(RASELDEV),RAEXLBLS=0 K IOP,RAMES,RASELDEV Q
83 I $D(RASELDEV),$D(RAFLHCNT),RAEXLBLS=0 S RASELDEV="Select the FLASH CARD Printer"
84 I '$D(RAFLHCNT),$D(RASELDEV),RAEXLBLS>0 S RASELDEV="Select the EXAM LABEL Printer"
85 I $D(RAFLHCNT),$D(RASELDEV),RANUM=0,RAEXLBLS>0 S RASELDEV="Select the EXAM LABEL Printer"
86 ;
87Q S ZTDTH=$H,ZTRTN="DQ^RAFLH" F RASV="RADFN","RADTI","RAFLHFL","RAFLH","RANUM","RAEXLBLS","RAEXFM" S ZTSAVE(RASV)=""
88 S:$D(RAVISIT1) ZTSAVE("RAVISIT1")=""
89 W ! D ZIS^RAUTL Q:RAPOP
90DQ U IO S U="^" S X="T",%DT="" D ^%DT S DT=Y G RAFLH
91 ;
92 ; If there is a flash card printer associated with the procedure, then
93 ; one flash card will print out at that printer regardless of any
94 ; division or location parameters concerning flash cards.
95 ;
96 ; If there is no flash card printer associated with the procedure and
97 ; the division parameter is set to YES, then one flash card will print
98 ; out at the flash card printer specified in the location parameter.
99 ; If there is no printer specified in the location parameter, then
100 ; the user will be prompted for a device.
101 ;
102 ; If there is no flash card printer associated with the procedure and
103 ; the division parameter is set to NO, then the number of flash cards
104 ; printed out will equal the value in the location parameter field,
105 ; HOW MANY FLASH CARDS PER VISIT. The flash cards will print out at the
106 ; flash card printer specified in the location parameter. If there is
107 ; no printer specified in the location parameter, then the user will be
108 ; prompted for a device.
109 ;
Note: See TracBrowser for help on using the repository browser.