LRAPV ;AVAMC/REG/WTY - ANAT PATH REPORTS NOT VERIFIED ;1/17/02
;;5.2;LAB SERVICE;**1002,1006,1030,1031**;NOV 01, 1997
;
;;VA LR Patche(s): 72,201,259,317
;
;Reference to ^DIC supported by IA #916
;
A ;Initialize some variables
N LRI,LRFILE,LRFILE1,LRFILE2,LRPD,LRA
D ^LRAP G:'$D(Y) END
S LR("AU1")=$S(LRSS="AU":1,1:0)
S:'LR("AU1") LRFILE="^LR(LRPD,LRSS,LRI",LRFILE1=LRFILE_",1.2,"
S:LR("AU1") LRFILE="^LR(LRPD,LRSS",LRFILE1="^LR(LRPD,84,"
ASK ;Ask which option to run
W !!?3,"1) List of Unverified ",LRO(68)," Reports"
W !?3,"2) List of Unverified ",LRO(68)," Supplementary Reports"
W !?3,"3) List of ",LRO(68)," Reports Missing SNOMED Codes"
W !!,"Select 1,2 or 3: "
R X:DTIME
I X=""!(X[U) D END Q
I X'?1N!("123"'[X) D G ASK
.W $C(7),!!,"Enter a single numeric digit 1,2 or 3"
;Give date ranges
S LRB=X D B^LRU
I Y<0 D END Q
DEV ;Get Device Info
W !
S %ZIS="Q" D ^%ZIS
I POP W ! D END Q
I $D(IO("Q")) D Q
.S ZTDESC="LIST OF ACC UNVERIF,MISSING SNOMED OR CPT"
.S ZTSAVE("LR*")="",ZTRTN="QUE^LRAPV"
.D ^%ZTLOAD W:$D(ZTSK) !,"Request Queued, #",ZTSK W !
.K ZTSK,IO("Q") D HOME^%ZIS
.D END
QUE ;
U IO W:IOST["C-" @IOF
S LRSDT=LRSDT-.01,LRLDT=LRLDT+.99
D XR^LRU,L^LRU,S^LRU,H S LR("F")=1
F S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT)!(LR("Q")) D Y
D END
Q
Y ;Get patient info
S LRPD=0 F S LRPD=$O(^LR(LRXR,LRSDT,LRPD)) Q:'LRPD!(LR("Q")) D
.S X=^LR(LRPD,0),Y=$P(X,"^",3),(LRDPF,X)=$P(X,"^",2)
.S X=^DIC(X,0,"GL"),X=@(X_Y_",0)"),LRP=$P(X,"^"),SSN=$P(X,"^",9)
.D SSN^LRU
.I 'LR("AU1") D I Q
.I LR("AU1") D SEL
Q
I ;Order through the cross reference
S LRI=0 F S LRI=$O(^LR(LRXR,LRSDT,LRPD,LRI)) Q:'LRI!(LR("Q")) D
.D:$Y>(IOSL-6) H Q:LR("Q")
.I $P($P($G(@(LRFILE_$S('LR("AU1"):",0)",1:")"))),"^",6)," ")'=LRABV Q
.D SEL
Q
SEL ;
D:LRB=1 RPT
D:LRB=2 SUPP
D:LRB=3 SNO
Q
N ;
Q
RPT ;Unverified reports
S X=$G(@(LRFILE_$S('LR("AU1"):",0)",1:")")))
I $L(X),'$P(X,"^",$S('LR("AU1"):11,1:15)) D
.S LRDATE=@(LRFILE_$S('LR("AU1"):",0)",1:")"))
.D W
Q
SUPP ;Unverified Supplementary Reports
;If RELEASE SUPPLEMENTARY REPORT is null, or if RELEASE SUPP
; REPORT MODIFIED is set to 1, then supp report is unverified
S (LRA,LRC)=0 F S LRA=$O(@(LRFILE1_"LRA)")) Q:'LRA!(LRC) D
.I '$P(@(LRFILE1_"LRA,0)"),"^",2) S LRC=1
.;Flag if released supp has been modified but not yet released
.I 'LRC,$P(@(LRFILE1_"LRA,0)"),"^",3) S LRC=1
I LRC D
.S LRDATE=@(LRFILE_$S('LR("AU1"):",0)",1:")"))
.D W
Q
SNO ;Missing SNOMED
S LRC=0
S:'LR("AU1") LRFILE2=LRFILE_",2"
S:LR("AU1") LRFILE2="^LR(LRPD,""AY"""
I '$D(@(LRFILE2_")")) S LRC=1
I 'LRC,'+$P($G(@(LRFILE2_",0)")),"^",4) S LRC=1
I LRC D
.S LRDATE=@(LRFILE_$S('LR("AU1"):",0)",1:")"))
.D W
Q
W ;Write the report
W !,$$FMTE^XLFDT(LRDATE,"D"),?19,$J($P(LRDATE,"^",6),5),?32,LRP
; W ?63,SSN
W ?63,$G(HRCN) ; IHS/MSC/MKK - LR*5.2*1031
I 'LR("AU1") D
.S LRA=0 F S LRA=$O(^LR(LRPD,LRSS,LRI,97,LRA)) Q:'LRA!(LR("Q")) D
..S B=^LR(LRPD,LRSS,LRI,97,LRA,0)
..D:$Y>(IOSL-6) H1 Q:LR("Q") W !?3,B
Q
H ;Header
I LRQ>0,IOST?1"C-".E D Q:LR("Q")
.K DIR S DIR(0)="E"
.D ^DIR W !
.S:$D(DTOUT)!(X[U) LR("Q")=1
W:LRQ>0 @IOF S LRQ=LRQ+1
S X="N",%DT="T" D ^%DT,D^LRU
W !,Y,?22,LRQ(1),?(IOM-10),"Pg: ",LRQ
W !,LRO(68)," (",LRABV,") "
I LRB<3 W "UNVERIFIED" W:LRB=2 " SUPPLEMENTARY" W " REPORTS"
W:LRB=3 "REPORTS MISSING SNOMED CODING"
W !,"BY DATE SPECIMEN TAKEN FROM ",LRSTR," TO ",LRLST
; W !,"DATE",?15,"Accession number",?32,"Patient",?66,"SSN",!,LR("%")
W !,"DATE",?15,"Accession number",?32,"Patient",?66,"HRCN",!,LR("%") ; IHS/MSC/MKK - LR*5.2*1031
Q
H1 ;
; D H Q:LR("Q") W !?19,$J($P(LRDATE,"^",6),5),?32,LRP,?63,SSN
D H Q:LR("Q") W !?19,$J($P(LRDATE,"^",6),5),?32,LRP,?63,$G(HRCN) ; IHS/MSC/MKK - LR*5.2*1031
Q
END ;
W:IOST?1"P-".E @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
K %,DIR,DTOUT,DUOUT,DIRUT,X,Y
D V^LRU
Q
LRAPV ;AVAMC/REG/WTY - ANAT PATH REPORTS NOT VERIFIED ;1/17/02
+1 ;;5.2;LAB SERVICE;**1002,1006,1030,1031**;NOV 01, 1997
+2 ;
+3 ;;VA LR Patche(s): 72,201,259,317
+4 ;
+5 ;Reference to ^DIC supported by IA #916
+6 ;
A ;Initialize some variables
+1 NEW LRI,LRFILE,LRFILE1,LRFILE2,LRPD,LRA
+2 DO ^LRAP
IF '$DATA(Y)
GOTO END
+3 SET LR("AU1")=$SELECT(LRSS="AU":1,1:0)
+4 IF 'LR("AU1")
SET LRFILE="^LR(LRPD,LRSS,LRI"
SET LRFILE1=LRFILE_",1.2,"
+5 IF LR("AU1")
SET LRFILE="^LR(LRPD,LRSS"
SET LRFILE1="^LR(LRPD,84,"
ASK ;Ask which option to run
+1 WRITE !!?3,"1) List of Unverified ",LRO(68)," Reports"
+2 WRITE !?3,"2) List of Unverified ",LRO(68)," Supplementary Reports"
+3 WRITE !?3,"3) List of ",LRO(68)," Reports Missing SNOMED Codes"
+4 WRITE !!,"Select 1,2 or 3: "
+5 READ X:DTIME
+6 IF X=""!(X[U)
DO END
QUIT
+7 IF X'?1N!("123"'[X)
Begin DoDot:1
+8 WRITE $CHAR(7),!!,"Enter a single numeric digit 1,2 or 3"
End DoDot:1
GOTO ASK
+9 ;Give date ranges
+10 SET LRB=X
DO B^LRU
+11 IF Y<0
DO END
QUIT
DEV ;Get Device Info
+1 WRITE !
+2 SET %ZIS="Q"
DO ^%ZIS
+3 IF POP
WRITE !
DO END
QUIT
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 SET ZTDESC="LIST OF ACC UNVERIF,MISSING SNOMED OR CPT"
+6 SET ZTSAVE("LR*")=""
SET ZTRTN="QUE^LRAPV"
+7 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !,"Request Queued, #",ZTSK
WRITE !
+8 KILL ZTSK,IO("Q")
DO HOME^%ZIS
+9 DO END
End DoDot:1
QUIT
QUE ;
+1 USE IO
IF IOST["C-"
WRITE @IOF
+2 SET LRSDT=LRSDT-.01
SET LRLDT=LRLDT+.99
+3 DO XR^LRU
DO L^LRU
DO S^LRU
DO H
SET LR("F")=1
+4 FOR
SET LRSDT=$ORDER(^LR(LRXR,LRSDT))
IF 'LRSDT!(LRSDT>LRLDT)!(LR("Q"))
QUIT
DO Y
+5 DO END
+6 QUIT
Y ;Get patient info
+1 SET LRPD=0
FOR
SET LRPD=$ORDER(^LR(LRXR,LRSDT,LRPD))
IF 'LRPD!(LR("Q"))
QUIT
Begin DoDot:1
+2 SET X=^LR(LRPD,0)
SET Y=$PIECE(X,"^",3)
SET (LRDPF,X)=$PIECE(X,"^",2)
+3 SET X=^DIC(X,0,"GL")
SET X=@(X_Y_",0)")
SET LRP=$PIECE(X,"^")
SET SSN=$PIECE(X,"^",9)
+4 DO SSN^LRU
+5 IF 'LR("AU1")
DO I
QUIT
+6 IF LR("AU1")
DO SEL
End DoDot:1
+7 QUIT
I ;Order through the cross reference
+1 SET LRI=0
FOR
SET LRI=$ORDER(^LR(LRXR,LRSDT,LRPD,LRI))
IF 'LRI!(LR("Q"))
QUIT
Begin DoDot:1
+2 IF $Y>(IOSL-6)
DO H
IF LR("Q")
QUIT
+3 IF $PIECE($PIECE($GET(@(LRFILE_$SELECT('LR("AU1"):",0)",1:")"))),"^",6)," ")'=LRABV
QUIT
+4 DO SEL
End DoDot:1
+5 QUIT
SEL ;
+1 IF LRB=1
DO RPT
+2 IF LRB=2
DO SUPP
+3 IF LRB=3
DO SNO
+4 QUIT
N ;
+1 QUIT
RPT ;Unverified reports
+1 SET X=$GET(@(LRFILE_$SELECT('LR("AU1"):",0)",1:")")))
+2 IF $LENGTH(X)
IF '$PIECE(X,"^",$SELECT('LR("AU1"):11,1:15))
Begin DoDot:1
+3 SET LRDATE=@(LRFILE_$SELECT('LR("AU1"):",0)",1:")"))
+4 DO W
End DoDot:1
+5 QUIT
SUPP ;Unverified Supplementary Reports
+1 ;If RELEASE SUPPLEMENTARY REPORT is null, or if RELEASE SUPP
+2 ; REPORT MODIFIED is set to 1, then supp report is unverified
+3 SET (LRA,LRC)=0
FOR
SET LRA=$ORDER(@(LRFILE1_"LRA)"))
IF 'LRA!(LRC)
QUIT
Begin DoDot:1
+4 IF '$PIECE(@(LRFILE1_"LRA,0)"),"^",2)
SET LRC=1
+5 ;Flag if released supp has been modified but not yet released
+6 IF 'LRC
IF $PIECE(@(LRFILE1_"LRA,0)"),"^",3)
SET LRC=1
End DoDot:1
+7 IF LRC
Begin DoDot:1
+8 SET LRDATE=@(LRFILE_$SELECT('LR("AU1"):",0)",1:")"))
+9 DO W
End DoDot:1
+10 QUIT
SNO ;Missing SNOMED
+1 SET LRC=0
+2 IF 'LR("AU1")
SET LRFILE2=LRFILE_",2"
+3 IF LR("AU1")
SET LRFILE2="^LR(LRPD,""AY"""
+4 IF '$DATA(@(LRFILE2_")"))
SET LRC=1
+5 IF 'LRC
IF '+$PIECE($GET(@(LRFILE2_",0)")),"^",4)
SET LRC=1
+6 IF LRC
Begin DoDot:1
+7 SET LRDATE=@(LRFILE_$SELECT('LR("AU1"):",0)",1:")"))
+8 DO W
End DoDot:1
+9 QUIT
W ;Write the report
+1 WRITE !,$$FMTE^XLFDT(LRDATE,"D"),?19,$JUSTIFY($PIECE(LRDATE,"^",6),5),?32,LRP
+2 ; W ?63,SSN
+3 ; IHS/MSC/MKK - LR*5.2*1031
WRITE ?63,$GET(HRCN)
+4 IF 'LR("AU1")
Begin DoDot:1
+5 SET LRA=0
FOR
SET LRA=$ORDER(^LR(LRPD,LRSS,LRI,97,LRA))
IF 'LRA!(LR("Q"))
QUIT
Begin DoDot:2
+6 SET B=^LR(LRPD,LRSS,LRI,97,LRA,0)
+7 IF $Y>(IOSL-6)
DO H1
IF LR("Q")
QUIT
WRITE !?3,B
End DoDot:2
End DoDot:1
+8 QUIT
H ;Header
+1 IF LRQ>0
IF IOST?1"C-".E
Begin DoDot:1
+2 KILL DIR
SET DIR(0)="E"
+3 DO ^DIR
WRITE !
+4 IF $DATA(DTOUT)!(X[U)
SET LR("Q")=1
End DoDot:1
IF LR("Q")
QUIT
+5 IF LRQ>0
WRITE @IOF
SET LRQ=LRQ+1
+6 SET X="N"
SET %DT="T"
DO ^%DT
DO D^LRU
+7 WRITE !,Y,?22,LRQ(1),?(IOM-10),"Pg: ",LRQ
+8 WRITE !,LRO(68)," (",LRABV,") "
+9 IF LRB<3
WRITE "UNVERIFIED"
IF LRB=2
WRITE " SUPPLEMENTARY"
WRITE " REPORTS"
+10 IF LRB=3
WRITE "REPORTS MISSING SNOMED CODING"
+11 WRITE !,"BY DATE SPECIMEN TAKEN FROM ",LRSTR," TO ",LRLST
+12 ; W !,"DATE",?15,"Accession number",?32,"Patient",?66,"SSN",!,LR("%")
+13 ; IHS/MSC/MKK - LR*5.2*1031
WRITE !,"DATE",?15,"Accession number",?32,"Patient",?66,"HRCN",!,LR("%")
+14 QUIT
H1 ;
+1 ; D H Q:LR("Q") W !?19,$J($P(LRDATE,"^",6),5),?32,LRP,?63,SSN
+2 ; IHS/MSC/MKK - LR*5.2*1031
DO H
IF LR("Q")
QUIT
WRITE !?19,$JUSTIFY($PIECE(LRDATE,"^",6),5),?32,LRP,?63,$GET(HRCN)
+3 QUIT
END ;
+1 IF IOST?1"P-".E
WRITE @IOF
DO ^%ZISC
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL %,DIR,DTOUT,DUOUT,DIRUT,X,Y
+3 DO V^LRU
+4 QUIT
