- 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
