LRAPJNC ; IHS/DIR/AAB - INCOMPLETE PATH RPTS 2/10/98 20:30 ; [ 07/08/1998 9:57 AM ]
;;5.2;LR;**1002,1006**;SEP 01, 1998
;
;;5.2;LAB SERVICE;**72,201**;Sep 27, 1994
D ^LRAP G:'$D(Y) END W !!,LRO(68)," Incomplete Reports" D B^LRU G:Y<0 END
S LRSDT=LRSDT-.01,LRLDT=LRLDT+.99
S ZTRTN="QUE^LRAPJNC" D BEG^LRUTL G:POP!($D(ZTSK)) END
QUE U IO K ^TMP($J) D XR^LRU,L^LRU,S^LRU
F X=0:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) D I
D H I '$D(^TMP($J)) W !!,"There are no incomplete reports within specified time." G OUT
S LR("F")=1,H(2)=0 F A=0:0 S H(2)=$O(^TMP($J,H(2))) Q:H(2)=""!(LR("Q")) D N
OUT K ^TMP($J) W:IOST'?1"C".E @IOF D END^LRUTL,END Q
N S Z=0 F LRB=0:0 S Z=$O(^TMP($J,H(2),Z)) Q:Z=""!(LR("Q")) D:$Y>(IOSL-6) H Q:LR("Q") S Y=^(Z) D W
Q
W W !,$J(Z,5),?7,$J($P(Y,"^"),8),?18,$E($P(Y,"^",2),1,20),?39,$P(Y,"^",3),?44,$P(Y,"^",4),?62,$E($P(Y,"^",5),1,18) W:$P(Y,"^",6)]"" !?62,$E($P(Y,"^",6),1,18) Q
;
I F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,LRSDT,LRDFN)) Q:'LRDFN S M(2)="" D @($S("CYEMSP"[LRSS:"L",1:"A"))
Q
L Q:'$D(^LR(LRDFN,0))
F LRI=0:0 S LRI=$O(^LR(LRXR,LRSDT,LRDFN,LRI)) Q:'LRI S X=$G(^LR(LRDFN,LRSS,LRI,0)) I $P($P(X,U,6)," ")=LRABV,'$P(X,U,3) S Z=+$P($P(X,U,6)," ",3),LRDTINT=$P(X,U,10),M(1)=$P(X,U,8),M=$P(X,U,2),X=^LR(LRDFN,0) D S
Q
S D ^LRUP S M=$S('M:"",1:$P($G(^VA(200,+M,0)),U)) I M(2),$D(^VA(200,M(2),0)) S M(2)=$P(^(0),U)
S LRDTEXT=$$Y2K^LRX(LRDTINT,"5D")
;S:'LRDTINT LRDTINT="?" S:Z="" Z="?" S ^TMP($J,$E(LRDTINT,1,3),Z)=LRDTEXT_"^"_LRP_"^"_SSN(1)_"^"_M(1)_"^"_M_"^"_M(2) Q
S:'LRDTINT LRDTINT="?" S:Z="" Z="?" S ^TMP($J,$E(LRDTINT,1,3),Z)=LRDTEXT_"^"_LRP_"^"_HRCN_"^"_M(1)_"^"_M_"^"_M(2) Q ;IHS/DIR TUC/AAB 7/8/98
A S X=$G(^LR(LRDFN,"AU")) Q:$P($P(X,U,6)," ")'=LRABV I '$P(X,U,3) S LRDTINT=$P(X,U),M(1)=$P(X,U,5),Z=+$P($P(X,U,6)," ",3),M=$P(X,U,10),M(2)=$P(X,U,7),X=^LR(LRDFN,0) D S
Q
H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
D F^LRU W !,"Incomplete ",LRO(68)," (",LRABV,") Reports",!,LRABV,?23,"FROM ",LRSTR," TO ",LRLST,!,"Acc #",?7,"Date",?18,"Patient",?39,"ID",?44,"Location",?62,$S(LRSS="AU":"Pathologist(s)",1:"Pathologist"),!,LR("%") Q
;
END K LRDTEXT,LRDTINT D V^LRU Q
LRAPJNC ; IHS/DIR/AAB - INCOMPLETE PATH RPTS 2/10/98 20:30 ; [ 07/08/1998 9:57 AM ]
+1 ;;5.2;LR;**1002,1006**;SEP 01, 1998
+2 ;
+3 ;;5.2;LAB SERVICE;**72,201**;Sep 27, 1994
+4 DO ^LRAP
IF '$DATA(Y)
GOTO END
WRITE !!,LRO(68)," Incomplete Reports"
DO B^LRU
IF Y<0
GOTO END
+5 SET LRSDT=LRSDT-.01
SET LRLDT=LRLDT+.99
+6 SET ZTRTN="QUE^LRAPJNC"
DO BEG^LRUTL
IF POP!($DATA(ZTSK))
GOTO END
QUE USE IO
KILL ^TMP($JOB)
DO XR^LRU
DO L^LRU
DO S^LRU
+1 FOR X=0:0
SET LRSDT=$ORDER(^LR(LRXR,LRSDT))
IF 'LRSDT!(LRSDT>LRLDT)
QUIT
DO I
+2 DO H
IF '$DATA(^TMP($JOB))
WRITE !!,"There are no incomplete reports within specified time."
GOTO OUT
+3 SET LR("F")=1
SET H(2)=0
FOR A=0:0
SET H(2)=$ORDER(^TMP($JOB,H(2)))
IF H(2)=""!(LR("Q"))
QUIT
DO N
OUT KILL ^TMP($JOB)
IF IOST'?1"C".E
WRITE @IOF
DO END^LRUTL
DO END
QUIT
N SET Z=0
FOR LRB=0:0
SET Z=$ORDER(^TMP($JOB,H(2),Z))
IF Z=""!(LR("Q"))
QUIT
IF $Y>(IOSL-6)
DO H
IF LR("Q")
QUIT
SET Y=^(Z)
DO W
+1 QUIT
W WRITE !,$JUSTIFY(Z,5),?7,$JUSTIFY($PIECE(Y,"^"),8),?18,$EXTRACT($PIECE(Y,"^",2),1,20),?39,$PIECE(Y,"^",3),?44,$PIECE(Y,"^",4),?62,$EXTRACT($PIECE(Y,"^",5),1,18)
IF $PIECE(Y,"^",6)]""
WRITE !?62,$EXTRACT($PIECE(Y,"^",6),1,18)
QUIT
+1 ;
I FOR LRDFN=0:0
SET LRDFN=$ORDER(^LR(LRXR,LRSDT,LRDFN))
IF 'LRDFN
QUIT
SET M(2)=""
DO @($SELECT("CYEMSP"[LRSS:"L",1:"A"))
+1 QUIT
L IF '$DATA(^LR(LRDFN,0))
QUIT
+1 FOR LRI=0:0
SET LRI=$ORDER(^LR(LRXR,LRSDT,LRDFN,LRI))
IF 'LRI
QUIT
SET X=$GET(^LR(LRDFN,LRSS,LRI,0))
IF $PIECE($PIECE(X,U,6)," ")=LRABV
IF '$PIECE(X,U,3)
SET Z=+$PIECE($PIECE(X,U,6)," ",3)
SET LRDTINT=$PIECE(X,U,10)
SET M(1)=$PIECE(X,U,8)
SET M=$PIECE(X,U,2)
SET X=^LR(LRDFN,0)
DO S
+2 QUIT
S DO ^LRUP
SET M=$SELECT('M:"",1:$PIECE($GET(^VA(200,+M,0)),U))
IF M(2)
IF $DATA(^VA(200,M(2),0))
SET M(2)=$PIECE(^(0),U)
+1 SET LRDTEXT=$$Y2K^LRX(LRDTINT,"5D")
+2 ;S:'LRDTINT LRDTINT="?" S:Z="" Z="?" S ^TMP($J,$E(LRDTINT,1,3),Z)=LRDTEXT_"^"_LRP_"^"_SSN(1)_"^"_M(1)_"^"_M_"^"_M(2) Q
+3 ;IHS/DIR TUC/AAB 7/8/98
IF 'LRDTINT
SET LRDTINT="?"
IF Z=""
SET Z="?"
SET ^TMP($JOB,$EXTRACT(LRDTINT,1,3),Z)=LRDTEXT_"^"_LRP_"^"_HRCN_"^"_M(1)_"^"_M_"^"_M(2)
QUIT
A SET X=$GET(^LR(LRDFN,"AU"))
IF $PIECE($PIECE(X,U,6)," ")'=LRABV
QUIT
IF '$PIECE(X,U,3)
SET LRDTINT=$PIECE(X,U)
SET M(1)=$PIECE(X,U,5)
SET Z=+$PIECE($PIECE(X,U,6)," ",3)
SET M=$PIECE(X,U,10)
SET M(2)=$PIECE(X,U,7)
SET X=^LR(LRDFN,0)
DO S
+1 QUIT
H IF $DATA(LR("F"))
IF IOST?1"C".E
DO M^LRU
IF LR("Q")
QUIT
+1 DO F^LRU
WRITE !,"Incomplete ",LRO(68)," (",LRABV,") Reports",!,LRABV,?23,"FROM ",LRSTR," TO ",LRLST,!,"Acc #",?7,"Date",?18,"Patient",?39,"ID",?44,"Location",?62,$SELECT(LRSS="AU":"Pathologist(s)",1:"Pathologist"),!,LR("%")
QUIT
+2 ;
END KILL LRDTEXT,LRDTINT
DO V^LRU
QUIT
