LRAUSTA ;AVAMC/REG/CYM - AUTOPSY STATUS LIST ;3/11/98 10:27 ;
;;5.2;LAB SERVICE;**134,201**;Sep 27, 1994
S LRDICS="AU" D ^LRAP G:'$D(Y) END W !!,LRO(68)," STATUS LIST"
YR W ! S %DT="AE",%DT(0)="-N",%DT("A")="Select year: " D ^%DT K %DT G:Y<0 END S H(1)=$E(Y,1,3) D XR^LRU I '$O(^LR(LRXREF,H(1),LRABV,0)) W $C(7),!!,"No entries for ",LRO(68)," (",LRABV,") in ",H(1)+1700 G YR
N1 R !,"Start with Acc #: ",N(1):DTIME G:N(1)=""!(N(1)[U) END I N(1)'?1N.N W $C(7),!!,"NUMBERS ONLY !!" G N1
N2 R !,"Go to Acc #: LAST // ",N(2):DTIME G:'$T!(N(2)[U) END S:N(2)="" N(2)=999999 I N(2)'?1N.N W $C(7),!!,"NUMBERS ONLY !!",!! G N2
I N(2)<N(1) S X=N(2),N(1)=N(2),N(2)=X
DEV S ZTRTN="QUE^LRAUSTA" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO S N(1)=N(1)-1 D L^LRU,S^LRU,H S LR("F")=1
F Z=N(1):0 S Z=$O(^LR(LRXREF,H(1),LRABV,Z)) Q:'Z!(Z>N(2))!(LR("Q")) S I=+$O(^(Z,0)) D WRT
D END^LRUTL,END Q
FIX S X=$$Y2K^LRX(X,"5D") Q
WRT Q:'$D(^LR(I,"AU")) S W=^("AU"),LRSENIOR=$P(W,"^",10),LRESIDEN=$P(W,"^",7),LRLLOC=$E($P(W,"^",5),1,5),P=^LR(I,0)
S P(1)=^DIC($P(P,"^",2),0,"GL"),P=$P(P,"^",3),P=@(P(1)_P_",0)"),P(9)=$E($P(P,"^",9),6,9),P=$E($P(P,"^"),1,19)
S X=$P(W,"^") D FIX S LRAUDT=X,X=$P(W,"^",3) D FIX S LRAUCOMP=X,X=$P(W,"^",4) D FIX S LRFAD=X,X=$P(W,"^",17) D FIX S LRPAD=X
D:$Y>(IOSL-7) H Q:LR("Q") W !!,$P(W,"^",6),?10,$E(P,1,14),?25,P(9),?30,LRLLOC,?36,$J(LRAUDT,8),?47,$J(LRPAD,8),?58,$J(LRFAD,8),?69,$J(LRAUCOMP,8)
I LRSENIOR,$D(^VA(200,LRSENIOR,0)) W !?36,$P(^(0),"^")
I LRESIDEN,$D(^VA(200,LRESIDEN,0)) W !?36,$P(^(0),"^")
Q
H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU W !,LRABV," Autopsy Status List",?36,"|--------------- Date --------------|",!,"Acc#",?12,"Patient",?25,"ID",?30,"Loc",?36,"Autopsy",?49,"PAD",?59,"FAD",?68,"Completed",!?36,"Pathologist(s)",!,LR("%") Q
;
END K LRSENIOR,LRESIDEN,LRAUDT,LRAUCOMP,LRFAD,LRPAD D V^LRU Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAUSTA 1876 printed Dec 13, 2024@02:09:49 Page 2
LRAUSTA ;AVAMC/REG/CYM - AUTOPSY STATUS LIST ;3/11/98 10:27 ;
+1 ;;5.2;LAB SERVICE;**134,201**;Sep 27, 1994
+2 SET LRDICS="AU"
DO ^LRAP
if '$DATA(Y)
GOTO END
WRITE !!,LRO(68)," STATUS LIST"
YR WRITE !
SET %DT="AE"
SET %DT(0)="-N"
SET %DT("A")="Select year: "
DO ^%DT
KILL %DT
if Y<0
GOTO END
SET H(1)=$EXTRACT(Y,1,3)
DO XR^LRU
IF '$ORDER(^LR(LRXREF,H(1),LRABV,0))
WRITE $CHAR(7),!!,"No entries for ",LRO(68)," (",LRABV,") in ",H(1)+1700
GOTO YR
N1 READ !,"Start with Acc #: ",N(1):DTIME
if N(1)=""!(N(1)[U)
GOTO END
IF N(1)'?1N.N
WRITE $CHAR(7),!!,"NUMBERS ONLY !!"
GOTO N1
N2 READ !,"Go to Acc #: LAST // ",N(2):DTIME
if '$TEST!(N(2)[U)
GOTO END
if N(2)=""
SET N(2)=999999
IF N(2)'?1N.N
WRITE $CHAR(7),!!,"NUMBERS ONLY !!",!!
GOTO N2
+1 IF N(2)<N(1)
SET X=N(2)
SET N(1)=N(2)
SET N(2)=X
DEV SET ZTRTN="QUE^LRAUSTA"
DO BEG^LRUTL
if POP!($DATA(ZTSK))
GOTO END
QUE USE IO
SET N(1)=N(1)-1
DO L^LRU
DO S^LRU
DO H
SET LR("F")=1
+1 FOR Z=N(1):0
SET Z=$ORDER(^LR(LRXREF,H(1),LRABV,Z))
if 'Z!(Z>N(2))!(LR("Q"))
QUIT
SET I=+$ORDER(^(Z,0))
DO WRT
+2 DO END^LRUTL
DO END
QUIT
FIX SET X=$$Y2K^LRX(X,"5D")
QUIT
WRT if '$DATA(^LR(I,"AU"))
QUIT
SET W=^("AU")
SET LRSENIOR=$PIECE(W,"^",10)
SET LRESIDEN=$PIECE(W,"^",7)
SET LRLLOC=$EXTRACT($PIECE(W,"^",5),1,5)
SET P=^LR(I,0)
+1 SET P(1)=^DIC($PIECE(P,"^",2),0,"GL")
SET P=$PIECE(P,"^",3)
SET P=@(P(1)_P_",0)")
SET P(9)=$EXTRACT($PIECE(P,"^",9),6,9)
SET P=$EXTRACT($PIECE(P,"^"),1,19)
+2 SET X=$PIECE(W,"^")
DO FIX
SET LRAUDT=X
SET X=$PIECE(W,"^",3)
DO FIX
SET LRAUCOMP=X
SET X=$PIECE(W,"^",4)
DO FIX
SET LRFAD=X
SET X=$PIECE(W,"^",17)
DO FIX
SET LRPAD=X
+3 if $Y>(IOSL-7)
DO H
if LR("Q")
QUIT
WRITE !!,$PIECE(W,"^",6),?10,$EXTRACT(P,1,14),?25,P(9),?30,LRLLOC,?36,$JUSTIFY(LRAUDT,8),?47,$JUSTIFY(LRPAD,8),?58,$JUSTIFY(LRFAD,8),?69,$JUSTIFY(LRAUCOMP,8)
+4 IF LRSENIOR
IF $DATA(^VA(200,LRSENIOR,0))
WRITE !?36,$PIECE(^(0),"^")
+5 IF LRESIDEN
IF $DATA(^VA(200,LRESIDEN,0))
WRITE !?36,$PIECE(^(0),"^")
+6 QUIT
H IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
if LR("Q")
QUIT
+1 DO F^LRU
WRITE !,LRABV," Autopsy Status List",?36,"|--------------- Date --------------|",!,"Acc#",?12,"Patient",?25,"ID",?30,"Loc",?36,"Autopsy",?49,"PAD",?59,"FAD",?68,"Completed",!?36,"Pathologist(s)",!,LR("%")
QUIT
+2 ;
END KILL LRSENIOR,LRESIDEN,LRAUDT,LRAUCOMP,LRFAD,LRPAD
DO V^LRU
QUIT
