source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPFICH.m@ 1604

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1LRAPFICH ;AVAMC/REG/WTY/KLL - MICROFICH PATH REPORTS ;03/21/2002
2 ;;5.2;LAB SERVICE;**72,173,248,259**;Sep 27, 1994
3 ;
4 D END ;Final path reports by accession number
5 N LRQUIT
6 W ! S LRDICS="SPCYEM" D ^LRAP G:'$D(Y) END
7 ;KLL - Final Office Copy prints SNOMED codes on a separate page
8 D FOC
9 ;Variable LR("DVD") is used to divide reports displayed in the browser
10 K LR("DVD")
11 S $P(LR("DVD"),"|",IOM)=""
12 S %DT("A")="Select Accession YEAR: ",%DT="AEQ" D ^%DT K %DT G:Y<1 END S LR("Y")=$E(Y,1,3)
13A R !,"Start with accession #: ",X:DTIME G:X[U!(X="") END I X'?1N.N W $C(7),!,"Enter a number." G A
14 S LR("B")=X
15B R !,"Go to accession #: ",X:DTIME G:X[U!(X="") END I X'?1N.N W $C(7),!,"Enter a number." G B
16 S LR("E")=X I LR("E")<LR("B") S X=LR("B"),LR("B")=LR("E"),LR("E")=X
17 S LR("B")=LR("B")-1
18SETUP ;
19 W !
20 S %ZIS="Q" D ^%ZIS
21 I POP W ! D END Q
22 I $D(IO("Q")) D Q
23 .S ZTDESC="Final path reports by accession #"
24 .S ZTSAVE("*")="",ZTRTN="QUE^LRAPFICH",ZTREQ="@",ZTIO=ION
25 .D ^%ZTLOAD W:$D(ZTSK) !,"Report Queued to device ",ION K ZTIO
26 .D HOME^%ZIS K ZTSK,IO("Q"),ZTREQ
27QUE ;
28 U IO S LR("DIWF")="W",(LR,LR("A"),LR(1),LR(2),LR(3))=0
29 S (LRA,LRQ(3))=1
30 D L^LRU,S^LRU,XR^LRU,L1^LRU,EN2^LRUA,SET^LRUA
31 S LRAN=LR("B")
32 F S LRAN=$O(^LR(LRXREF,LR("Y"),LRABV,LRAN)) Q:'LRAN!(LRAN>LR("E"))!(LR("Q")) D
33 .S LRDFN=$O(^LR(LRXREF,LR("Y"),LRABV,LRAN,0)),LRI=$O(^(LRDFN,0))
34 .S LRSF515=1,LRQUIT=0
35 .K LR("F")
36 .D TIUCHK^LRAPUTL(.LRPTR,LRDFN,LRSS,LRI)
37 .I +$G(LRPTR) D Q
38 ..D MAIN^LRAPTIUP(LRPTR,0)
39 ..W:IOST["BROWSER" !!,LR("DVD")
40 ..K LRPTR
41 ..;KLL-Print SNOMED Codes if Final Office Copy selected
42 ..I LRFOC D FOC^LRSPRPT
43 ..I LRQUIT S LR("Q")=1 Q
44 ..S LR("F")=1
45 ..I 'LR("Q"),$D(LR("F")),IOST?1"C-".E D CONT
46 .W:IOST?1"C-".E @IOF
47 .D EN^LRSPRPT
48 .W:IOST?1"P-".E @IOF
49 .W:IOST["BROWSER" !!,LR("DVD")
50 .I LRFOC D FOC^LRSPRPT
51 .I 'LR("Q"),$D(LR("F")),IOST?1"C-".E D CONT
52 D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
53 K %,DIR,DTOUT,DUOUT,DIRUT,X,Y
54 D END
55 Q
56FOC ;Final Office Copy
57 W !
58 K DIR
59 S LRFOC=0
60 S DIR(0)="Y",DIR("A")="Is this a final office copy"
61 S DIR("B")="YES"
62 S DIR("?",1)="SNOMED codes no longer appear on the report. The final"
63 S DIR("?",1)=DIR("?",1)_" office copy prints"
64 S DIR("?")="these codes on a separate page. Enter 'Yes' to include "
65 S DIR("?")=DIR("?")_"this page."
66 D ^DIR
67 I Y S LRFOC=1
68 Q
69CONT ;
70 K DIR S DIR(0)="E"
71 D ^DIR W !
72 S:$D(DTOUT)!(X[U) LR("Q")=1
73 Q
74END D V^LRU
75 K LRSF515
76 Q
Note: See TracBrowser for help on using the repository browser.