- LRAPQAMR ;AVAMC/REG/CYM - MALIGNANCY REVIEW ;10/3/96 08:56
- ;;5.2;LAB SERVICE;**72,134,242,252**;Sep 27, 1994
- D A^LRAPD G:'$D(Y) END
- W !!?31,"Malignancy review",!,"This report may take a while and should be queued to print at non-peak hours.",!,"OK to continue " S %=2 D YN^LRU G:%'=1 END
- I LRSS="CY" W !!,"Include suspicious for malignancy cases " S %=1 D YN^LRU G:%<1 END S:%=1 LRB=1
- ASK W !!?18,"1. Bone and soft tissue",!?18,"2. Female genital tract",!?18,"3. Other topography" R !,"Select 1,2, or 3: ",X:DTIME G:X["^"!(X="") END I +X'=X!(X<1)!(X>3) W !!,$C(7),"Enter a number from 1 to 3" G ASK
- I X'=3 S S(1)=1,S(2)=$S(X=1:1,1:8) G CUM
- TP K A("B") W !!,"TOPOGRAPHY (Organ/Tissue)",!?5,"Select 1 or more characters of the code",!?5 R "For all sites type 'ALL' : ",X:DTIME Q:X=""!(X[U) I X["ALL" S S(2)="ALL"
- E D CK^LRAUSM G:$D(A("B")) TP S S(2)=X,S(1)=$L(X)
- CUM D ASK^LRAPQAFS G:%<1 END S:'$D(LRC) LRC=0
- W ! D B^LRU G:Y<0 END S LRSDT=LRSDT-.01,LRLDT=LRLDT+.99
- K Y S ZTRTN="QUE^LRAPQAMR" D BEG^LRUTL G:POP!($D(ZTSK)) END
- QUE U IO K ^TMP($J),^TMP("LRAP",$J) S LRN="MALIGNANT",(LRS(99),LR("W"),LRLR("DIWF"),LRQ(3),LRS(5),LRQ(9))=1,LR("DIWF")="W",(LR,LR("A"),LR(1),LR(2),LR(3),LRQ(2))=0,LRO=""
- D L^LRU,S^LRU,XR^LRU,L1^LRU,EN^LRUA S S(7)="MORPHOLOGY",LRSN=61.1,V=2
- 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
- S ^TMP($J,0)=S(2)_U_"MR"_U_LRAA(1)_U_S(7)
- F X=0:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) D LRDFN^LRAPSM
- D ^LRAPSM1 G:LR("Q") OUT D EN2^LRUA,SET^LRUA S LRQ=0,LRA=1
- I LRQA F A=0:0 S A=$O(^TMP($J,A)) Q:'A S X=A,%DT="" D ^%DT S LRY=$E(X,1,3) F B=0:0 S B=$O(^TMP($J,A,B)) Q:'B S ^TMP("LRAP",$J,LRY,B)=""
- F LRY=0:0 S LRY=$O(^TMP("LRAP",$J,LRY)) Q:'LRY!(LR("Q")) F LRAN=0:0 S LRAN=$O(^TMP("LRAP",$J,LRY,LRAN)) Q:'LRAN!(LR("Q")) S LRDFN=$O(^LR(LRXREF,LRY,LRABV,LRAN,0)) Q:'LRDFN S LRI=$O(^(LRDFN,0)) Q:'LRI D EN^LRSPRPT Q:LR("Q") D:LRC L
- OUT K ^TMP("LRAP",$J) D END^LRUTL,END Q
- L ;also used by LRAPQAR,LRAPQAFS
- S X=^LR(LRDFN,0),Y=$P(X,"^",3),(LRDPF,X)=^DIC($P(X,"^",2),0,"GL"),LRPPT=@(X_Y_",0)")
- 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)
- G:'$D(^LR(LRDFN,"SP"))&('$D(^LR(LRDFN,"CY")))&('$D(^LR(LRDFN,"EM"))) AU
- D ^LRAPT1 Q:LR("Q")
- AU I $D(^LR(LRDFN,"AU")),+^("AU") D ^LRAPT2
- Q
- ;
- END D V^LRU Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPQAMR 2402 printed Mar 13, 2025@21:12:20 Page 2
- LRAPQAMR ;AVAMC/REG/CYM - MALIGNANCY REVIEW ;10/3/96 08:56
- +1 ;;5.2;LAB SERVICE;**72,134,242,252**;Sep 27, 1994
- +2 DO A^LRAPD
- if '$DATA(Y)
- GOTO END
- +3 WRITE !!?31,"Malignancy review",!,"This report may take a while and should be queued to print at non-peak hours.",!,"OK to continue "
- SET %=2
- DO YN^LRU
- if %'=1
- GOTO END
- +4 IF LRSS="CY"
- WRITE !!,"Include suspicious for malignancy cases "
- SET %=1
- DO YN^LRU
- if %<1
- GOTO END
- if %=1
- SET LRB=1
- ASK WRITE !!?18,"1. Bone and soft tissue",!?18,"2. Female genital tract",!?18,"3. Other topography"
- READ !,"Select 1,2, or 3: ",X:DTIME
- if X["^"!(X="")
- GOTO END
- IF +X'=X!(X<1)!(X>3)
- WRITE !!,$CHAR(7),"Enter a number from 1 to 3"
- GOTO ASK
- +1 IF X'=3
- SET S(1)=1
- SET S(2)=$SELECT(X=1:1,1:8)
- GOTO CUM
- TP KILL A("B")
- WRITE !!,"TOPOGRAPHY (Organ/Tissue)",!?5,"Select 1 or more characters of the code",!?5
- READ "For all sites type 'ALL' : ",X:DTIME
- if X=""!(X[U)
- QUIT
- IF X["ALL"
- SET S(2)="ALL"
- +1 IF '$TEST
- DO CK^LRAUSM
- if $DATA(A("B"))
- GOTO TP
- SET S(2)=X
- SET S(1)=$LENGTH(X)
- CUM DO ASK^LRAPQAFS
- if %<1
- GOTO END
- if '$DATA(LRC)
- SET LRC=0
- +1 WRITE !
- DO B^LRU
- if Y<0
- GOTO END
- SET LRSDT=LRSDT-.01
- SET LRLDT=LRLDT+.99
- +2 KILL Y
- SET ZTRTN="QUE^LRAPQAMR"
- DO BEG^LRUTL
- if POP!($DATA(ZTSK))
- GOTO END
- QUE USE IO
- KILL ^TMP($JOB),^TMP("LRAP",$JOB)
- SET LRN="MALIGNANT"
- SET (LRS(99),LR("W"),LRLR("DIWF"),LRQ(3),LRS(5),LRQ(9))=1
- SET LR("DIWF")="W"
- SET (LR,LR("A"),LR(1),LR(2),LR(3),LRQ(2))=0
- SET LRO=""
- +1 DO L^LRU
- DO S^LRU
- DO XR^LRU
- DO L1^LRU
- DO EN^LRUA
- SET S(7)="MORPHOLOGY"
- SET LRSN=61.1
- SET V=2
- +2 FOR X=8,9
- FOR Y=1,2,3,6,9
- SET Z=X_"***"_Y
- SET LRM(Z)=5
- SET LRN(Z)=Z
- +3 IF $DATA(LRB)
- SET LRM(69760)=5
- SET LRN(69760)=69760
- +4 SET ^TMP($JOB,0)=S(2)_U_"MR"_U_LRAA(1)_U_S(7)
- +5 FOR X=0:0
- SET LRSDT=$ORDER(^LR(LRXR,LRSDT))
- if 'LRSDT!(LRSDT>LRLDT)
- QUIT
- DO LRDFN^LRAPSM
- +6 DO ^LRAPSM1
- if LR("Q")
- GOTO OUT
- DO EN2^LRUA
- DO SET^LRUA
- SET LRQ=0
- SET LRA=1
- +7 IF LRQA
- FOR A=0:0
- SET A=$ORDER(^TMP($JOB,A))
- if 'A
- QUIT
- SET X=A
- SET %DT=""
- DO ^%DT
- SET LRY=$EXTRACT(X,1,3)
- FOR B=0:0
- SET B=$ORDER(^TMP($JOB,A,B))
- if 'B
- QUIT
- SET ^TMP("LRAP",$JOB,LRY,B)=""
- +8 FOR LRY=0:0
- SET LRY=$ORDER(^TMP("LRAP",$JOB,LRY))
- if 'LRY!(LR("Q"))
- QUIT
- FOR LRAN=0:0
- SET LRAN=$ORDER(^TMP("LRAP",$JOB,LRY,LRAN))
- if 'LRAN!(LR("Q"))
- QUIT
- SET LRDFN=$ORDER(^LR(LRXREF,LRY,LRABV,LRAN,0))
- if 'LRDFN
- QUIT
- SET LRI=$ORDER(^(LRDFN,0))
- if 'LRI
- QUIT
- DO EN^LRSPRPT
- if LR("Q")
- QUIT
- if LRC
- DO L
- OUT KILL ^TMP("LRAP",$JOB)
- DO END^LRUTL
- DO END
- QUIT
- L ;also used by LRAPQAR,LRAPQAFS
- +1 SET X=^LR(LRDFN,0)
- SET 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 if '$DATA(^LR(LRDFN,"SP"))&('$DATA(^LR(LRDFN,"CY")))&('$DATA(^LR(LRDFN,"EM")))
- GOTO AU
- +4 DO ^LRAPT1
- if LR("Q")
- QUIT
- AU IF $DATA(^LR(LRDFN,"AU"))
- IF +^("AU")
- DO ^LRAPT2
- +1 QUIT
- +2 ;
- END DO V^LRU
- QUIT
