LRSPDA ;AVAMC/REG - SURGICAL PATH DATA ENTRY ; 9/11/88 17:13 ;
;;5.2;LAB SERVICE;;Sep 27, 1994
L S X="SURGICAL PATHOLOGY" D ^LRUTL Q
;
H ;blocks, stains, procedures
D END,L G:Y=-1 END K DR,Y W ! F X=1,2,3 S Y(X)=$P(^DD(63.812,X,0),"^") W !?15,X,". ",Y(X)
S Z="",B=1 F A=0:0 W !,"Selection (",B,"): " R X:DTIME Q:X=""!(X[U) D:X<1!(X>3)!(X'=+X) HELP I X>0&(X<4)&(X=+X) W " ",Y(X) S:Z'[X Z=Z_X_";" S B=B+1 Q:B=4
Q:Z="" S DR=.012,(DR(3,63.8121),DR(3,63.822),DR(3,63.824))=".01;1//^S X=""H & E STAIN""",(DR(4,63.8122),DR(4,63.823),DR(4,63.824))=".01;.02//1;.03;.04"
S DR(2,63.812)=Z D ^LRAPDA,END Q
HELP W $C(7),!!,"Enter a number from 1 to 3",! Q
;
END D V^LRU Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRSPDA 681 printed Sep 23, 2025@19:56:16 Page 2
LRSPDA ;AVAMC/REG - SURGICAL PATH DATA ENTRY ; 9/11/88 17:13 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
L SET X="SURGICAL PATHOLOGY"
DO ^LRUTL
QUIT
+1 ;
H ;blocks, stains, procedures
+1 DO END
DO L
if Y=-1
GOTO END
KILL DR,Y
WRITE !
FOR X=1,2,3
SET Y(X)=$PIECE(^DD(63.812,X,0),"^")
WRITE !?15,X,". ",Y(X)
+2 SET Z=""
SET B=1
FOR A=0:0
WRITE !,"Selection (",B,"): "
READ X:DTIME
if X=""!(X[U)
QUIT
if X<1!(X>3)!(X'=+X)
DO HELP
IF X>0&(X<4)&(X=+X)
WRITE " ",Y(X)
if Z'[X
SET Z=Z_X_";"
SET B=B+1
if B=4
QUIT
+3 if Z=""
QUIT
SET DR=.012
SET (DR(3,63.8121),DR(3,63.822),DR(3,63.824))=".01;1//^S X=""H & E STAIN"""
SET (DR(4,63.8122),DR(4,63.823),DR(4,63.824))=".01;.02//1;.03;.04"
+4 SET DR(2,63.812)=Z
DO ^LRAPDA
DO END
QUIT
HELP WRITE $CHAR(7),!!,"Enter a number from 1 to 3",!
QUIT
+1 ;
END DO V^LRU
QUIT
