- LRAPAUL ; IHS/DIR/AAB - PATHOLOGY LIST BY PATHOLOGIST/TECH 2/9/98 13:59 ; [ 02/03/1999 2:07 PM ]
- ;;5.2;LR;**1002,1003,1006**;SEP 01, 1998
- ;
- ;;5.2;LAB SERVICE;**72,173,201**;Sep 27, 1994
- D ^LRAP G:'$D(Y) END
- S LRP=$S("SPAU"[LRSS:"Resident Pathologist",LRSS="CY":"Cytotechnologist",1:"Resident or EM Technologist")
- ASK W !!?17,"1. ",LRO(68)," list by ",LRP,!?17,"2. ",LRO(68)," list by Senior Pathologist",!?17,"3. ",LRO(68)," list by Surgeon/Physician",!,"Select 1,2 or 3: "
- R X:DTIME G:X=""!(X[U) END I X<1!(X>3) W $C(7)," Enter 1, 2 or 3" G ASK
- S Y=$S(LRSS="AU":"7^10",1:"4^2"),LRA=$S(X=1:$P(Y,U)_";200",1:$P(Y,U,2)_";200")
- I X=3 D P G END:Y<1,R
- S DIC(0)="AEQM",DIC=$P(LRA,";",2),DIC("A")="Select "_$S(X=1:LRP,1:"SENIOR PATHOLOGIST")_": " D ^DIC K DIC G:Y<1 END S LRB=+Y,X=$P(Y,U,2),LRA=+LRA S:X X=$P(^VA(200,X,0),U)
- R S LRD=0,LRB(1)=$P(X,",",2)_" "_$P(X,",")_"'s" I "SPCYEM"[LRSS W !!,"List only reports not released " S %=2 D YN^LRU G:%<1 END S:%=1 LRD=1 W !
- D B^LRU G:Y<0 END S LRLDT=LRLDT+.99,LRSDT=LRSDT-.0001
- S LRF=0 W !!,"Print total count only " S %=2 D YN^LRU G:%<1 END I %=1 S LRF=1,LRV=0 G DEV
- W !!,"Print Topography and Morphology entries " S %=2 D YN^LRU G:%<1 END S LRV=$S(%=1:1,1:0)
- DEV S ZTRTN="QUE^LRAPAUL" D BEG^LRUTL G:POP!($D(ZTSK)) END
- QUE U IO D FIELD^DID(63,13.7,"","POINTER","LRS") S LRE=0 S:LRSS="AU" LRS=LRS("POINTER") D L^LRU,S^LRU,XR^LRU,H S LR("F")=1
- F LRC=LRSDT:0 S LRC=$O(^LR(LRXR,LRC)) Q:'LRC!(LRC>LRLDT)!(LR("Q")) F LRP=0:0 S LRP=$O(^LR(LRXR,LRC,LRP)) Q:'LRP D @$S(LRSS="AU":"W",1:"SP")
- W:'LRE !,"No "_LRO(68)_" reports found." W:LRE&(LRF) !!,"Total cases (list not requested): ",LRE D END,END^LRUTL Q
- W D:$Y>(IOSL-6) H Q:LR("Q") I '$D(^LR(LRP,"AU")) K ^LR("AAU",LRC,LRP) Q
- Q:$P($P($G(^LR(LRP,"AU")),U,6)," ")'=LRABV Q:$P(^LR(LRP,"AU"),"^",LRA)'=LRB S LRE=LRE+1,Z=^("AU")
- PRT Q:LRF D:$Y>(IOSL-6) H Q:LR("Q")
- ;W !,LRE,")",?3,$J($P(Z,"^",6),4),?18 S Y=+Z D DT W Y,?35 S X=^LR(LRP,0),Y=$P(X,"^",3),(LRDPF,X)=$P(X,"^",2),X=^DIC(X,0,"GL"),V=@(X_Y_",0)"),SSN=$P(V,"^",9) D SSN^LRU W $P(V,"^") W:LRSS'="AU" " ",SSN Q:LRSS'="AU"
- W !,LRE,")",?3,$J($P(Z,"^",6),4),?18 S Y=+Z D DT W Y,?35 S X=^LR(LRP,0),Y=$P(X,"^",3),(LRDPF,X)=$P(X,"^",2),X=^DIC(X,0,"GL"),V=@(X_Y_",0)"),SSN=$P(V,"^",9) D SSN^LRU W $P(V,"^") W:LRSS'="AU" " ",HRCN Q:LRSS'="AU"
- ;PREVIOUS LINE COMMENTED IHS/DIR TUC/AAB 5/4/98
- S DA=LRP D D^LRAUAW S X2=$P(V,"^",3),X1=LR(63,12) D ^%DTC S X=X\365.25 S:X<1 X="<1" W ?62,$J(X,2)
- S X=$P(Z,"^",11)_":" W ?66,$E($P($P(LRS,X,2),";"),1,12) Q:'LRV
- F T=0:0 S T=$O(^LR(LRP,"AY",T)) Q:'T S B=+^(T,0),B=$S($D(^LAB(61,B,0)):$P(^(0),"^"),1:B) D:$Y>(IOSL-6) H1 Q:LR("Q") W !?16,B D M
- Q
- M F M=0:0 S M=$O(^LR(LRP,"AY",T,2,M)) Q:'M S N=+^(M,0),N=$S($D(^LAB(61.1,N,0)):$P(^(0),"^"),1:N) D:$Y>(IOSL-6) H2 Q:LR("Q") W !?21,N
- Q
- ;
- DT D DD^LRX Q
- SP F LRI=0:0 S LRI=$O(^LR(LRXR,LRC,LRP,LRI)) Q:'LRI D WR
- Q
- WR D:$Y>(IOSL-6) H1 Q:LR("Q") I '$D(^LR(LRP,LRSS,LRI,0)) K ^LR(LRXR,LRC,LRP,LRI) Q
- S X=^LR(LRP,LRSS,LRI,0) Q:$P($P(X,U,6)," ")'=LRABV Q:$P(X,"^",LRA)'=LRB I LRD,$P(X,"^",11) Q
- S LRE=LRE+1,Z=X D PRT Q:'LRV
- F T=0:0 S T=$O(^LR(LRP,LRSS,LRI,2,T)) Q:'T S B=+^(T,0),B=$S($D(^LAB(61,B,0)):$P(^(0),"^"),1:B) D:$Y>(IOSL-6) H1 Q:LR("Q") W !?16,B D MR
- Q
- MR F M=0:0 S M=$O(^LR(LRP,LRSS,LRI,2,T,2,M)) Q:'M S N=+^(M,0),N=$S($D(^LAB(61.1,N,0)):$P(^(0),"^"),1:N) D:$Y>(IOSL-6) H2 Q:LR("Q") W !?21,N
- Q
- P K DIC S DIC("A")="PROVIDER : ",DIC(0)="AEQN",DIC="^VA(200,",D="AK.PROVIDER" D IX^DIC K DIC Q:Y<1 S LRB=+Y,LRA=7,X=$P(Y,U,2) Q
- ;
- H I $D(LR("F")),$E(IOST,1,2)="C-" D M^LRU Q:LR("Q")
- ;D F^LRU W !,LRB(1)," ",LRO(68)," list from:",LRSTR," to:",LRLST W:LRD !,"List of reports not released" W !,"Count",?6,"Case#",?18,"Case date",?35,"Patient" W:LRSS="AU" ?62,"Age",?66,"Autopsy type" W:LRSS'="AU" "/SSN" W !,LR("%") Q
- D F^LRU W !,LRB(1)," ",LRO(68)," list from:",LRSTR," to:",LRLST W:LRD !,"List of reports not released" ;IHS/DIR TUC/FJE
- W !,"Count",?6,"Case#",?18,"Case date",?35,"Patient" W:LRSS="AU" ?62,"Age",?66,"Autopsy type" W:LRSS'="AU" "/HRCN" W !,LR("%") Q ;IHS/DIR TUC/AAB
- H1 D H Q:LR("Q") W !,LRE,")",?3,$J($P(Z,"^",6),4),?18 S Y=+Z D DT W Y,?31,$P(V,"^") Q
- H2 D H1 Q:LR("Q") W !?16,B Q
- ;
- END D V^LRU Q
- LRAPAUL ; IHS/DIR/AAB - PATHOLOGY LIST BY PATHOLOGIST/TECH 2/9/98 13:59 ; [ 02/03/1999 2:07 PM ]
- +1 ;;5.2;LR;**1002,1003,1006**;SEP 01, 1998
- +2 ;
- +3 ;;5.2;LAB SERVICE;**72,173,201**;Sep 27, 1994
- +4 DO ^LRAP
- IF '$DATA(Y)
- GOTO END
- +5 SET LRP=$SELECT("SPAU"[LRSS:"Resident Pathologist",LRSS="CY":"Cytotechnologist",1:"Resident or EM Technologist")
- ASK WRITE !!?17,"1. ",LRO(68)," list by ",LRP,!?17,"2. ",LRO(68)," list by Senior Pathologist",!?17,"3. ",LRO(68)," list by Surgeon/Physician",!,"Select 1,2 or 3: "
- +1 READ X:DTIME
- IF X=""!(X[U)
- GOTO END
- IF X<1!(X>3)
- WRITE $CHAR(7)," Enter 1, 2 or 3"
- GOTO ASK
- +2 SET Y=$SELECT(LRSS="AU":"7^10",1:"4^2")
- SET LRA=$SELECT(X=1:$PIECE(Y,U)_";200",1:$PIECE(Y,U,2)_";200")
- +3 IF X=3
- DO P
- IF Y<1
- GOTO END
- GOTO R
- +4 SET DIC(0)="AEQM"
- SET DIC=$PIECE(LRA,";",2)
- SET DIC("A")="Select "_$SELECT(X=1:LRP,1:"SENIOR PATHOLOGIST")_": "
- DO ^DIC
- KILL DIC
- IF Y<1
- GOTO END
- SET LRB=+Y
- SET X=$PIECE(Y,U,2)
- SET LRA=+LRA
- IF X
- SET X=$PIECE(^VA(200,X,0),U)
- R SET LRD=0
- SET LRB(1)=$PIECE(X,",",2)_" "_$PIECE(X,",")_"'s"
- IF "SPCYEM"[LRSS
- WRITE !!,"List only reports not released "
- SET %=2
- DO YN^LRU
- IF %<1
- GOTO END
- IF %=1
- SET LRD=1
- WRITE !
- +1 DO B^LRU
- IF Y<0
- GOTO END
- SET LRLDT=LRLDT+.99
- SET LRSDT=LRSDT-.0001
- +2 SET LRF=0
- WRITE !!,"Print total count only "
- SET %=2
- DO YN^LRU
- IF %<1
- GOTO END
- IF %=1
- SET LRF=1
- SET LRV=0
- GOTO DEV
- +3 WRITE !!,"Print Topography and Morphology entries "
- SET %=2
- DO YN^LRU
- IF %<1
- GOTO END
- SET LRV=$SELECT(%=1:1,1:0)
- DEV SET ZTRTN="QUE^LRAPAUL"
- DO BEG^LRUTL
- IF POP!($DATA(ZTSK))
- GOTO END
- QUE USE IO
- DO FIELD^DID(63,13.7,"","POINTER","LRS")
- SET LRE=0
- IF LRSS="AU"
- SET LRS=LRS("POINTER")
- DO L^LRU
- DO S^LRU
- DO XR^LRU
- DO H
- SET LR("F")=1
- +1 FOR LRC=LRSDT:0
- SET LRC=$ORDER(^LR(LRXR,LRC))
- IF 'LRC!(LRC>LRLDT)!(LR("Q"))
- QUIT
- FOR LRP=0:0
- SET LRP=$ORDER(^LR(LRXR,LRC,LRP))
- IF 'LRP
- QUIT
- DO @$SELECT(LRSS="AU":"W",1:"SP")
- +2 IF 'LRE
- WRITE !,"No "_LRO(68)_" reports found."
- IF LRE&(LRF)
- WRITE !!,"Total cases (list not requested): ",LRE
- DO END
- DO END^LRUTL
- QUIT
- W IF $Y>(IOSL-6)
- DO H
- IF LR("Q")
- QUIT
- IF '$DATA(^LR(LRP,"AU"))
- KILL ^LR("AAU",LRC,LRP)
- QUIT
- +1 IF $PIECE($PIECE($GET(^LR(LRP,"AU")),U,6)," ")'=LRABV
- QUIT
- IF $PIECE(^LR(LRP,"AU"),"^",LRA)'=LRB
- QUIT
- SET LRE=LRE+1
- SET Z=^("AU")
- PRT IF LRF
- QUIT
- IF $Y>(IOSL-6)
- DO H
- IF LR("Q")
- QUIT
- +1 ;W !,LRE,")",?3,$J($PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P(Z,"^",6),4),?18 S Y=+Z D DT W Y,?35 S X=^LR(LRPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P,0),Y=$PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P(X,"^",3),(LRDPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PF,X)=$PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P(X,"^",2),X=^DIC(X,0,"GL"),V=@(X_Y_",0)"),SSN=$PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P(V,"^",9) D SSN^LRU W $PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P">PAUL_source.html#xP">PAUL_source.html#xPAUL_source.html#xP">P">PAUL_source.html#xP">P(V,"^") W:LRSS'="AU" " ",SSN Q:LRSS'="AU"
- +2 WRITE !,LRE,")",?3,$JUSTIFY($PIECE(Z,"^",6),4),?18
- SET Y=+Z
- DO DT
- WRITE Y,?35
- SET X=^LR(LRP,0)
- SET Y=$PIECE(X,"^",3)
- SET (LRDPF,X)=$PIECE(X,"^",2)
- SET X=^DIC(X,0,"GL")
- SET V=@(X_Y_",0)")
- SET SSN=$PIECE(V,"^",9)
- DO SSN^LRU
- WRITE $PIECE(V,"^")
- IF LRSS'="AU"
- WRITE " ",HRCN
- IF LRSS'="AU"
- QUIT
- +3 ;PREVIOUS LINE COMMENTED IHS/DIR TUC/AAB 5/4/98
- +4 SET DA=LRP
- DO D^LRAUAW
- SET X2=$PIECE(V,"^",3)
- SET X1=LR(63,12)
- DO ^%DTC
- SET X=X\365.25
- IF X<1
- SET X="<1"
- WRITE ?62,$JUSTIFY(X,2)
- +5 SET X=$PIECE(Z,"^",11)_":"
- WRITE ?66,$EXTRACT($PIECE($PIECE(LRS,X,2),";"),1,12)
- IF 'LRV
- QUIT
- +6 FOR T=0:0
- SET T=$ORDER(^LR(LRP,"AY",T))
- IF 'T
- QUIT
- SET B=+^(T,0)
- SET B=$SELECT($DATA(^LAB(61,B,0)):$PIECE(^(0),"^"),1:B)
- IF $Y>(IOSL-6)
- DO H1
- IF LR("Q")
- QUIT
- WRITE !?16,B
- DO M
- +7 QUIT
- M FOR M=0:0
- SET M=$ORDER(^LR(LRP,"AY",T,2,M))
- IF 'M
- QUIT
- SET N=+^(M,0)
- SET N=$SELECT($DATA(^LAB(61.1,N,0)):$PIECE(^(0),"^"),1:N)
- IF $Y>(IOSL-6)
- DO H2
- IF LR("Q")
- QUIT
- WRITE !?21,N
- +1 QUIT
- +2 ;
- DT DO DD^LRX
- QUIT
- SP FOR LRI=0:0
- SET LRI=$ORDER(^LR(LRXR,LRC,LRP,LRI))
- IF 'LRI
- QUIT
- DO WR
- +1 QUIT
- WR IF $Y>(IOSL-6)
- DO H1
- IF LR("Q")
- QUIT
- IF '$DATA(^LR(LRP,LRSS,LRI,0))
- KILL ^LR(LRXR,LRC,LRP,LRI)
- QUIT
- +1 SET X=^LR(LRP,LRSS,LRI,0)
- IF $PIECE($PIECE(X,U,6)," ")'=LRABV
- QUIT
- IF $PIECE(X,"^",LRA)'=LRB
- QUIT
- IF LRD
- IF $PIECE(X,"^",11)
- QUIT
- +2 SET LRE=LRE+1
- SET Z=X
- DO PRT
- IF 'LRV
- QUIT
- +3 FOR T=0:0
- SET T=$ORDER(^LR(LRP,LRSS,LRI,2,T))
- IF 'T
- QUIT
- SET B=+^(T,0)
- SET B=$SELECT($DATA(^LAB(61,B,0)):$PIECE(^(0),"^"),1:B)
- IF $Y>(IOSL-6)
- DO H1
- IF LR("Q")
- QUIT
- WRITE !?16,B
- DO MR
- +4 QUIT
- MR FOR M=0:0
- SET M=$ORDER(^LR(LRP,LRSS,LRI,2,T,2,M))
- IF 'M
- QUIT
- SET N=+^(M,0)
- SET N=$SELECT($DATA(^LAB(61.1,N,0)):$PIECE(^(0),"^"),1:N)
- IF $Y>(IOSL-6)
- DO H2
- IF LR("Q")
- QUIT
- WRITE !?21,N
- +1 QUIT
- P KILL DIC
- SET DIC("A")="PROVIDER : "
- SET DIC(0)="AEQN"
- SET DIC="^VA(200,"
- SET D="AK.PROVIDER"
- DO IX^DIC
- KILL DIC
- IF Y<1
- QUIT
- SET LRB=+Y
- SET LRA=7
- SET X=$PIECE(Y,U,2)
- QUIT
- +1 ;
- H IF $DATA(LR("F"))
- IF $EXTRACT(IOST,1,2)="C-"
- DO M^LRU
- IF LR("Q")
- QUIT
- +1 ;D F^LRU W !,LRB(1)," ",LRO(68)," list from:",LRSTR," to:",LRLST W:LRD !,"List of reports not released" W !,"Count",?6,"Case#",?18,"Case date",?35,"Patient" W:LRSS="AU" ?62,"Age",?66,"Autopsy type" W:LRSS'="AU" "/SSN" W !,LR("%") Q
- +2 ;IHS/DIR TUC/FJE
- DO F^LRU
- WRITE !,LRB(1)," ",LRO(68)," list from:",LRSTR," to:",LRLST
- IF LRD
- WRITE !,"List of reports not released"
- +3 ;IHS/DIR TUC/AAB
- WRITE !,"Count",?6,"Case#",?18,"Case date",?35,"Patient"
- IF LRSS="AU"
- WRITE ?62,"Age",?66,"Autopsy type"
- IF LRSS'="AU"
- WRITE "/HRCN"
- WRITE !,LR("%")
- QUIT
- H1 DO H
- IF LR("Q")
- QUIT
- WRITE !,LRE,")",?3,$JUSTIFY($PIECE(Z,"^",6),4),?18
- SET Y=+Z
- DO DT
- WRITE Y,?31,$PIECE(V,"^")
- QUIT
- H2 DO H1
- IF LR("Q")
- QUIT
- WRITE !?16,B
- QUIT
- +1 ;
- END DO V^LRU
- QUIT
