LRAPONC ; IHS/DIR/FJE - FIND MALIGNANCIES FOR ONCOLOGY 11:43 ; [ 5/21/91 ]
;;5.2;LR;;NOV 01, 1997
;
;;5.2;LAB SERVICE;;Sep 27, 1994
D END W !!?31,"Find Malignancies for Oncology" D A G:'$D(Y) END D XR^LRU
I LRSS="CY" W !!,"Include suspicious for malignancy cases " S %=1 D YN^LRU G:%<1 END S:%=1 LRB=1
S S(2)="ALL",S(1)=3
W ! D B^LRU G:Y<0 END S LRSDT=LRSDT-.01,LRLDT=LRLDT+.99
F X=8,9 F Y=1,2,3,6,9 S Z=X_"***"_Y,LRM(Z)=5,LRN(Z)=Z
I $D(LRB) S LRM(69760)=5,LRN(69760)=69760
D WAIT^LRU
F LR=0:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) D LRDFN
Q
Y I $E(X,1,Y(1))=Y(2) S I=1 Q
Y1 S I=1 F I(1)=1:1:Y(1) S I(2)=$E(Y(2),I(1)) I I(2)'="*",I(2)'=$E(X,I(1)) S I=0 Q
Q
LRDFN F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,LRSDT,LRDFN)) Q:'LRDFN D @$S(LRSS'="AU":"LRI",1:"AU")
Q
LRI F LRI=0:0 S LRI=$O(^LR(LRXR,LRSDT,LRDFN,LRI)) Q:'LRI D T
Q
T F T=0:0 S T=$O(^LR(LRDFN,LRSS,LRI,2,T)) Q:'T S LRT=+^(T,0) D M
Q
M F M=0:0 S M=$O(^LR(LRDFN,LRSS,LRI,2,T,2,M)) Q:'M S X=^(M,0),LRD=+X,LRM=$P(X,"^",2) D MX
Q
MX Q:'$D(^LAB(61.1,LRD,0)) S W=^(0),X=$P(W,"^",2),Y=0 F Z=1:1 S Y=$O(LRN(Y)) Q:Y="" S Y(1)=LRM(Y),Y(2)=LRN(Y) D Y I I S ^TMP($J,LRDFN,LRI)=""
Q
AU S LRI=9999999 F T=0:0 S T=$O(^LR(LRDFN,"AY",T)) Q:'T S LRT=+^(T,0) D AUM
Q
AUM F M=0:0 S M=$O(^LR(LRDFN,"AY",T,2,M)) Q:'M S X=^(M,0),LRD=+X,LRM=$P(X,"^",2) D MX
Q
L ;S X=^LR(LRDFN,0),Y=$P(X,"^",3),(LRDPF,X)=^DIC($P(X,"^",2),0,"GL"),LRPPT=@(X_Y_",0)")
S X=^LR(LRDFN,0),(DFN,Y)=$P(X,"^",3),(LRDPF,X)=^DIC($P(X,"^",2),0,"GL"),LRPPT=@(X_Y_",0)") ;IHS/ANMC/CLS 11/1/95
S LRQ=0,LRP=$P(LRPPT,"^"),SEX=$P(LRPPT,"^",2),Y=$P(LRPPT,"^",3),SSN=$P(LRPPT,"^",9) D D^LRU,SSN^LRU S DOB=$S(Y[1700:"",1:Y)
Q
A ;
W ! S DIC=68,DIC(0)="AEOQMZ",DIC("A")="Select ANATOMIC PATHOLOGY section: ",DIC("S")="I ""AUSPCYEM""[$P(^(0),U,2)&($P(^(0),U,2)]"""")" D ^DIC K DIC G:Y<1 END
D ^LRUTL G:Y=-1 END Q
;
END D V^LRU Q
LRAPONC ; IHS/DIR/FJE - FIND MALIGNANCIES FOR ONCOLOGY 11:43 ; [ 5/21/91 ]
+1 ;;5.2;LR;;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
+4 DO END
WRITE !!?31,"Find Malignancies for Oncology"
DO A
IF '$DATA(Y)
GOTO END
DO XR^LRU
+5 IF LRSS="CY"
WRITE !!,"Include suspicious for malignancy cases "
SET %=1
DO YN^LRU
IF %<1
GOTO END
IF %=1
SET LRB=1
+6 SET S(2)="ALL"
SET S(1)=3
+7 WRITE !
DO B^LRU
IF Y<0
GOTO END
SET LRSDT=LRSDT-.01
SET LRLDT=LRLDT+.99
+8 FOR X=8,9
FOR Y=1,2,3,6,9
SET Z=X_"***"_Y
SET LRM(Z)=5
SET LRN(Z)=Z
+9 IF $DATA(LRB)
SET LRM(69760)=5
SET LRN(69760)=69760
+10 DO WAIT^LRU
+11 FOR LR=0:0
SET LRSDT=$ORDER(^LR(LRXR,LRSDT))
IF 'LRSDT!(LRSDT>LRLDT)
QUIT
DO LRDFN
+12 QUIT
Y IF $EXTRACT(X,1,Y(1))=Y(2)
SET I=1
QUIT
Y1 SET I=1
FOR I(1)=1:1:Y(1)
SET I(2)=$EXTRACT(Y(2),I(1))
IF I(2)'="*"
IF I(2)'=$EXTRACT(X,I(1))
SET I=0
QUIT
+1 QUIT
LRDFN FOR LRDFN=0:0
SET LRDFN=$ORDER(^LR(LRXR,LRSDT,LRDFN))
IF 'LRDFN
QUIT
DO @$SELECT(LRSS'="AU":"LRI",1:"AU")
+1 QUIT
LRI FOR LRI=0:0
SET LRI=$ORDER(^LR(LRXR,LRSDT,LRDFN,LRI))
IF 'LRI
QUIT
DO T
+1 QUIT
T FOR T=0:0
SET T=$ORDER(^LR(LRDFN,LRSS,LRI,2,T))
IF 'T
QUIT
SET LRT=+^(T,0)
DO M
+1 QUIT
M FOR M=0:0
SET M=$ORDER(^LR(LRDFN,LRSS,LRI,2,T,2,M))
IF 'M
QUIT
SET X=^(M,0)
SET LRD=+X
SET LRM=$PIECE(X,"^",2)
DO MX
+1 QUIT
MX IF '$DATA(^LAB(61.1,LRD,0))
QUIT
SET W=^(0)
SET X=$PIECE(W,"^",2)
SET Y=0
FOR Z=1:1
SET Y=$ORDER(LRN(Y))
IF Y=""
QUIT
SET Y(1)=LRM(Y)
SET Y(2)=LRN(Y)
DO Y
IF I
SET ^TMP($JOB,LRDFN,LRI)=""
+1 QUIT
AU SET LRI=9999999
FOR T=0:0
SET T=$ORDER(^LR(LRDFN,"AY",T))
IF 'T
QUIT
SET LRT=+^(T,0)
DO AUM
+1 QUIT
AUM FOR M=0:0
SET M=$ORDER(^LR(LRDFN,"AY",T,2,M))
IF 'M
QUIT
SET X=^(M,0)
SET LRD=+X
SET LRM=$PIECE(X,"^",2)
DO MX
+1 QUIT
L ;S X=^LR(LRDFN,0),Y=$P(X,"^",3),(LRDPF,X)=^DIC($P(X,"^",2),0,"GL"),LRPPT=@(X_Y_",0)")
+1 ;IHS/ANMC/CLS 11/1/95
SET X=^LR(LRDFN,0)
SET (DFN,Y)=$PIECE(X,"^",3)
SET (LRDPF,X)=^DIC($PIECE(X,"^",2),0,"GL")
SET LRPPT=@(X_Y_",0)")
+2 SET LRQ=0
SET LRP=$PIECE(LRPPT,"^")
SET SEX=$PIECE(LRPPT,"^",2)
SET Y=$PIECE(LRPPT,"^",3)
SET SSN=$PIECE(LRPPT,"^",9)
DO D^LRU
DO SSN^LRU
SET DOB=$SELECT(Y[1700:"",1:Y)
+3 QUIT
A ;
+1 WRITE !
SET DIC=68
SET DIC(0)="AEOQMZ"
SET DIC("A")="Select ANATOMIC PATHOLOGY section: "
SET DIC("S")="I ""AUSPCYEM""[$P(^(0),U,2)&($P(^(0),U,2)]"""")"
DO ^DIC
KILL DIC
IF Y<1
GOTO END
+2 DO ^LRUTL
IF Y=-1
GOTO END
QUIT
+3 ;
END DO V^LRU
QUIT
