- LRAPWU ;AVAMC/REG - AP WORKLOAD UTILITY ;8/12/95 19:30
- ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- I '$O(^LR(LRDFN,LRSS,LRI,.1,0)) W $C(7),!!?20,"*** No specimen entered ***" S F=1 Q
- S F=0 F A=0:0 S A=$O(^LR(LRDFN,LRSS,LRI,.1,A)) Q:'A!(F) D F Q:F
- Q
- F I '$O(^LR(LRDFN,LRSS,LRI,.1,A,0)) S F=1 W $C(7),!!,"*** No blocks or preps entered for ",$P(^(0),U)," ***" Q
- F E=0:0 S E=$O(^LR(LRDFN,LRSS,LRI,.1,A,E)) Q:'E!(F) D E Q:F
- Q
- E Q:$P($G(^LR(LRDFN,LRSS,LRI,.1,A,E,0)),U,4)<1 I '$O(^(0)) S F=1 W $C(7),!!,"No blocks or preps for ",$P(^LR(LRDFN,LRSS,LRI,.1,A,0),U) Q
- F B=0:0 S B=$O(^LR(LRDFN,LRSS,LRI,.1,A,E,B)) Q:'B!(F) D X
- Q
- X I '$O(^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,0)) S F=1 W $C(7),!!,"No stains for ",$P(^LR(LRDFN,LRSS,LRI,.1,A,0),U)," ",$P(^(E,B,0),U) Q
- I LRSS="EM" D EM Q
- F C=0:0 S C=$O(^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,C)) Q:'C!(F) S G=^(C,0),G(4)=$P(G,"^",4),G(5)=$P(G,"^",5) S:'G(4) F=1 I 'F,'G(5) S:G(4)<LRK $P(^(0),"^",5)=LRK I G(4)'<LRK S T=LRK D CK
- Q
- EM S G=$G(^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,LRW,0)),G(4)=$P(G,"^",4),G(5)=$P(G,"^",5),G(11)=$P(X,"^",11) S:'G(4) F=1 Q:F I LRK(1),'G(5) S:G(4)<LRK(1) $P(^(0),"^",5)=LRK(1) I G(4)'<LRK(1) S C=LRW,T=LRK(1) D CK
- I LRK,'G(11) S:G(4)<LRK $P(^(0),"^",11)=LRK I G(4)'<LRK S C=LRW D C W !?3,"Date/time prints made (" S Y=LRK D CK1
- Q
- A ;from LRAPLG,LRAPBS
- S A="63."_$S(LRSS="CY":902,LRSS="SP":812,LRSS="EM":202,1:"033") F X=.999:0 S X=$O(^DD(A,X)) Q:'X S Y=^(X,0),LRZ($P(Y,"^"))=$P($P(Y,"^",4),";")_"^"_$P(Y,"^",2)_"^"_$P(^DD(+$P(Y,"^",2),1,0),"^",2)
- S A="" F S A=$O(LRZ(A)) Q:A="" S X=+$O(^LRO(69.2,LRAA,.3,"B",A,0)),Y=$P($G(^LRO(69.2,LRAA,.3,X,0)),"^",2),$P(LRZ(A),"^",4)=Y
- K A,Y Q
- ;
- W S %DT="AEQTXR",%DT(0)="-N",%DT("B")="NOW" S:'$D(%DT("A")) %DT("A")="Workload date/time: " D ^%DT S LRK=Y I Y>1 W " OK " S %=1 D YN^LRU G:%'=1 W
- K %DT Q
- ;
- CK D C W !?3,"Date/time ",$S(LRSS="EM":"grids scanned ",1:"slides examined")," (" S Y=T
- CK1 D DD^%DT W Y,") cannot be before",!?3,"Date/time ",$S(LRSS="EM":"grids prepared",1:"slides stained")," ("
- S Y=G(4) D DD^%DT W Y,")",$C(7),!!,"Press Return or Enter key: " R X:DTIME Q
- C W !!,$P(^LR(LRDFN,LRSS,LRI,.1,A,0),U)," ",$P(^LR(LRDFN,LRSS,LRI,.1,A,E,B,0),U)," ",$P(^LAB(60,C,0),U) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPWU 2220 printed Mar 13, 2025@21:13:07 Page 2
- LRAPWU ;AVAMC/REG - AP WORKLOAD UTILITY ;8/12/95 19:30
- +1 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- +2 IF '$ORDER(^LR(LRDFN,LRSS,LRI,.1,0))
- WRITE $CHAR(7),!!?20,"*** No specimen entered ***"
- SET F=1
- QUIT
- +3 SET F=0
- FOR A=0:0
- SET A=$ORDER(^LR(LRDFN,LRSS,LRI,.1,A))
- if 'A!(F)
- QUIT
- DO F
- if F
- QUIT
- +4 QUIT
- F IF '$ORDER(^LR(LRDFN,LRSS,LRI,.1,A,0))
- SET F=1
- WRITE $CHAR(7),!!,"*** No blocks or preps entered for ",$PIECE(^(0),U)," ***"
- QUIT
- +1 FOR E=0:0
- SET E=$ORDER(^LR(LRDFN,LRSS,LRI,.1,A,E))
- if 'E!(F)
- QUIT
- DO E
- if F
- QUIT
- +2 QUIT
- E if $PIECE($GET(^LR(LRDFN,LRSS,LRI,.1,A,E,0)),U,4)<1
- QUIT
- IF '$ORDER(^(0))
- SET F=1
- WRITE $CHAR(7),!!,"No blocks or preps for ",$PIECE(^LR(LRDFN,LRSS,LRI,.1,A,0),U)
- QUIT
- +1 FOR B=0:0
- SET B=$ORDER(^LR(LRDFN,LRSS,LRI,.1,A,E,B))
- if 'B!(F)
- QUIT
- DO X
- +2 QUIT
- X IF '$ORDER(^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,0))
- SET F=1
- WRITE $CHAR(7),!!,"No stains for ",$PIECE(^LR(LRDFN,LRSS,LRI,.1,A,0),U)," ",$PIECE(^(E,B,0),U)
- QUIT
- +1 IF LRSS="EM"
- DO EM
- QUIT
- +2 FOR C=0:0
- SET C=$ORDER(^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,C))
- if 'C!(F)
- QUIT
- SET G=^(C,0)
- SET G(4)=$PIECE(G,"^",4)
- SET G(5)=$PIECE(G,"^",5)
- if 'G(4)
- SET F=1
- IF 'F
- IF 'G(5)
- if G(4)<LRK
- SET $PIECE(^(0),"^",5)=LRK
- IF G(4)'<LRK
- SET T=LRK
- DO CK
- +3 QUIT
- EM SET G=$GET(^LR(LRDFN,LRSS,LRI,.1,A,E,B,1,LRW,0))
- SET G(4)=$PIECE(G,"^",4)
- SET G(5)=$PIECE(G,"^",5)
- SET G(11)=$PIECE(X,"^",11)
- if 'G(4)
- SET F=1
- if F
- QUIT
- IF LRK(1)
- IF 'G(5)
- if G(4)<LRK(1)
- SET $PIECE(^(0),"^",5)=LRK(1)
- IF G(4)'<LRK(1)
- SET C=LRW
- SET T=LRK(1)
- DO CK
- +1 IF LRK
- IF 'G(11)
- if G(4)<LRK
- SET $PIECE(^(0),"^",11)=LRK
- IF G(4)'<LRK
- SET C=LRW
- DO C
- WRITE !?3,"Date/time prints made ("
- SET Y=LRK
- DO CK1
- +2 QUIT
- A ;from LRAPLG,LRAPBS
- +1 SET A="63."_$SELECT(LRSS="CY":902,LRSS="SP":812,LRSS="EM":202,1:"033")
- FOR X=.999:0
- SET X=$ORDER(^DD(A,X))
- if 'X
- QUIT
- SET Y=^(X,0)
- SET LRZ($PIECE(Y,"^"))=$PIECE($PIECE(Y,"^",4),";")_"^"_$PIECE(Y,"^",2)_"^"_$PIECE(^DD(+$PIECE(Y,"^",2),1,0),"^",2)
- +2 SET A=""
- FOR
- SET A=$ORDER(LRZ(A))
- if A=""
- QUIT
- SET X=+$ORDER(^LRO(69.2,LRAA,.3,"B",A,0))
- SET Y=$PIECE($GET(^LRO(69.2,LRAA,.3,X,0)),"^",2)
- SET $PIECE(LRZ(A),"^",4)=Y
- +3 KILL A,Y
- QUIT
- +4 ;
- W SET %DT="AEQTXR"
- SET %DT(0)="-N"
- SET %DT("B")="NOW"
- if '$DATA(%DT("A"))
- SET %DT("A")="Workload date/time: "
- DO ^%DT
- SET LRK=Y
- IF Y>1
- WRITE " OK "
- SET %=1
- DO YN^LRU
- if %'=1
- GOTO W
- +1 KILL %DT
- QUIT
- +2 ;
- CK DO C
- WRITE !?3,"Date/time ",$SELECT(LRSS="EM":"grids scanned ",1:"slides examined")," ("
- SET Y=T
- CK1 DO DD^%DT
- WRITE Y,") cannot be before",!?3,"Date/time ",$SELECT(LRSS="EM":"grids prepared",1:"slides stained")," ("
- +1 SET Y=G(4)
- DO DD^%DT
- WRITE Y,")",$CHAR(7),!!,"Press Return or Enter key: "
- READ X:DTIME
- QUIT
- C WRITE !!,$PIECE(^LR(LRDFN,LRSS,LRI,.1,A,0),U)," ",$PIECE(^LR(LRDFN,LRSS,LRI,.1,A,E,B,0),U)," ",$PIECE(^LAB(60,C,0),U)
- QUIT
