- LRAPV ;AVAMC/REG/WTY - ANAT PATH REPORTS NOT VERIFIED ;1/17/02
- ;;5.2;LAB SERVICE;**72,201,259,317**;Sep 27, 1994
- ;
- ;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
- 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("%")
- Q
- H1 ;
- D H Q:LR("Q") W !?19,$J($P(LRDATE,"^",6),5),?32,LRP,?63,SSN
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPV 3670 printed Feb 18, 2025@23:34:30 Page 2
- LRAPV ;AVAMC/REG/WTY - ANAT PATH REPORTS NOT VERIFIED ;1/17/02
- +1 ;;5.2;LAB SERVICE;**72,201,259,317**;Sep 27, 1994
- +2 ;
- +3 ;Reference to ^DIC supported by IA #916
- +4 ;
- 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 WRITE ?63,SSN
- +3 IF 'LR("AU1")
- Begin DoDot:1
- +4 SET LRA=0
- FOR
- SET LRA=$ORDER(^LR(LRPD,LRSS,LRI,97,LRA))
- if 'LRA!(LR("Q"))
- QUIT
- Begin DoDot:2
- +5 SET B=^LR(LRPD,LRSS,LRI,97,LRA,0)
- +6 if $Y>(IOSL-6)
- DO H1
- if LR("Q")
- QUIT
- WRITE !?3,B
- End DoDot:2
- End DoDot:1
- +7 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 WRITE !,"DATE",?15,"Accession number",?32,"Patient",?66,"SSN",!,LR("%")
- +13 QUIT
- H1 ;
- +1 DO H
- if LR("Q")
- QUIT
- WRITE !?19,$JUSTIFY($PIECE(LRDATE,"^",6),5),?32,LRP,?63,SSN
- +2 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