LAPFICH ;AVAMC/REG - MICROFICH PATH REPORTS ;7/20/90 09:59
;;5.2;AUTOMATED LAB INSTRUMENTS;**42**;Sep 27, 1994
EN ;
D:'$D(LRPARAM) ^LRPARAM D END W !,"MICROFICH PATH REPORTS"
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
S X=$P(Y,U,2) D ^LRUTL G:Y<0 END
S %DT=("A")="Select Accession YEAR: ",%DT="AEPQ" D ^%DT G:Y<1 END S LRY=$E(Y,1,3)
A R !,"Start with accession #: ",X:DTIME G:X[U!(X="") END I X'?1N.N W $C(7),!,"Enter a number." G A
S LR("A")=X-1
B R !,"Go to accession #: ",X:DTIME G:X[U!(X="") END I X'?1N.N W $C(7),!,"Enter a number." G B
S LR("B")=X
W !!,"Print SNOMED &/or ICD codes on final report " S %=2 D YN^LRU Q:%<1 I %=1 S (LRS(99),S(99))=1
;D EN^LRSPRPT2 ;*** USE THIS LINE FOR VER 5.0 COMMENT OUT THE LINE ABOVE
S ZTRTN="QUE^LRAPFICH" D BEG^LRUTL G:POP!($D(ZTSK)) END
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))
K LR("%1") S $P(LR("%1"),"=",IOM-1)="="
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")
D END^LRUTL,END Q
;
END D V^LRU K LRS(99),LR("%1"),S(99),LRPMD,LRRMD Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAPFICH 1382 printed Dec 13, 2024@01:43:58 Page 2
LAPFICH ;AVAMC/REG - MICROFICH PATH REPORTS ;7/20/90 09:59
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**42**;Sep 27, 1994
EN ;
+1 if '$DATA(LRPARAM)
DO ^LRPARAM
DO END
WRITE !,"MICROFICH PATH REPORTS"
+2 WRITE !
SET DIC("A")="Select ANATOMIC PATHOLOGY SECTION: "
SET DIC=68
SET DIC(0)="AEQM"
SET DIC("S")="I ""SPCYEM""[$P(^(0),U,2)"
DO ^DIC
KILL DIC
if Y<1
GOTO END
+3 SET X=$PIECE(Y,U,2)
DO ^LRUTL
if Y<0
GOTO END
+4 SET %DT=("A")="Select Accession YEAR: "
SET %DT="AEPQ"
DO ^%DT
if Y<1
GOTO END
SET LRY=$EXTRACT(Y,1,3)
A READ !,"Start with accession #: ",X:DTIME
if X[U!(X="")
GOTO END
IF X'?1N.N
WRITE $CHAR(7),!,"Enter a number."
GOTO A
+1 SET LR("A")=X-1
B READ !,"Go to accession #: ",X:DTIME
if X[U!(X="")
GOTO END
IF X'?1N.N
WRITE $CHAR(7),!,"Enter a number."
GOTO B
+1 SET LR("B")=X
+2 WRITE !!,"Print SNOMED &/or ICD codes on final report "
SET %=2
DO YN^LRU
if %<1
QUIT
IF %=1
SET (LRS(99),S(99))=1
+3 ;D EN^LRSPRPT2 ;*** USE THIS LINE FOR VER 5.0 COMMENT OUT THE LINE ABOVE
+4 SET ZTRTN="QUE^LRAPFICH"
DO BEG^LRUTL
if POP!($DATA(ZTSK))
GOTO END
QUE USE IO
SET S(5)="W"
SET (LR("Q"),LR,LR("A"),LR(1),LR(2),LR(3))=0
DO L^LRU
DO XR^LRU
DO EN2^LRUA
DO SET^LRUA
SET LRQ=0
SET LRA=1
SET LRQ(1)=^DD("SITE")
IF $DATA(DUZ(2))
SET LRQ(1)=$SELECT($DATA(^DIC(4,+DUZ(2),0)):$PIECE(^(0),U),1:LRQ(1))
+1 KILL LR("%1")
SET $PIECE(LR("%1"),"=",IOM-1)="="
+2 FOR LRAN=LR("A"):0
SET LRAN=$ORDER(^LR(LRXREF,LRY,LRAN))
if 'LRAN!(LRAN>LR("B"))!(LR("Q"))
QUIT
SET LRDFN=$ORDER(^LR(LRXREF,LRY,LRAN,0))
SET LRI=$ORDER(^(LRDFN,0))
DO EN^LRSPRPT
if LR("Q")
QUIT
+3 DO END^LRUTL
DO END
QUIT
+4 ;
END DO V^LRU
KILL LRS(99),LR("%1"),S(99),LRPMD,LRRMD
QUIT
