| [613] | 1 | LAPFICH ;AVAMC/REG - MICROFICH PATH REPORTS ;7/20/90 09:59
|
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;**42**;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | D:'$D(LRPARAM) ^LRPARAM D END W !,"MICROFICH PATH REPORTS"
|
|---|
| 5 | W ! S DIC("A")="Select ANATOMIC PATHOLOGY SECTION: ",DIC=68,DIC(0)="AEQM",DIC("S")="I ""SPCYEM""[$P(^(0),U,2)" D ^DIC K DIC G:Y<1 END
|
|---|
| 6 | S X=$P(Y,U,2) D ^LRUTL G:Y<0 END
|
|---|
| 7 | S %DT=("A")="Select Accession YEAR: ",%DT="AEPQ" D ^%DT G:Y<1 END S LRY=$E(Y,1,3)
|
|---|
| 8 | A R !,"Start with accession #: ",X:DTIME G:X[U!(X="") END I X'?1N.N W $C(7),!,"Enter a number." G A
|
|---|
| 9 | S LR("A")=X-1
|
|---|
| 10 | B R !,"Go to accession #: ",X:DTIME G:X[U!(X="") END I X'?1N.N W $C(7),!,"Enter a number." G B
|
|---|
| 11 | S LR("B")=X
|
|---|
| 12 | W !!,"Print SNOMED &/or ICD codes on final report " S %=2 D YN^LRU Q:%<1 I %=1 S (LRS(99),S(99))=1
|
|---|
| 13 | ;D EN^LRSPRPT2 ;*** USE THIS LINE FOR VER 5.0 COMMENT OUT THE LINE ABOVE
|
|---|
| 14 | S ZTRTN="QUE^LRAPFICH" D BEG^LRUTL G:POP!($D(ZTSK)) END
|
|---|
| 15 | QUE U IO S S(5)="W",(LR("Q"),LR,LR("A"),LR(1),LR(2),LR(3))=0 D L^LRU,XR^LRU,EN2^LRUA,SET^LRUA S LRQ=0,LRA=1,LRQ(1)=^DD("SITE") I $D(DUZ(2)) S LRQ(1)=$S($D(^DIC(4,+DUZ(2),0)):$P(^(0),U),1:LRQ(1))
|
|---|
| 16 | K LR("%1") S $P(LR("%1"),"=",IOM-1)="="
|
|---|
| 17 | F LRAN=LR("A"):0 S LRAN=$O(^LR(LRXREF,LRY,LRAN)) Q:'LRAN!(LRAN>LR("B"))!(LR("Q")) S LRDFN=$O(^LR(LRXREF,LRY,LRAN,0)),LRI=$O(^(LRDFN,0)) D EN^LRSPRPT Q:LR("Q")
|
|---|
| 18 | D END^LRUTL,END Q
|
|---|
| 19 | ;
|
|---|
| 20 | END D V^LRU K LRS(99),LR("%1"),S(99),LRPMD,LRRMD Q
|
|---|
