Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRAPV

LRAPV.m

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