- 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 Jan 18, 2025@02:45:12 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