- 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
