LRUWL.m

LRUWL ; IHS/DIR/FJE - DISPLAY WORKLOAD FOR ACCESSION 13:40 ; 

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 D END

A W ! S DIC="^LRO(68,",DIC(0)="AEQM" D ^DIC K DIC G:Y<1 END S LRAA=+Y,LRAA(1)=$P(Y,U,2),LRY=$S($D(^LRO(68,LRAA,1,0)):$P(^(0),U,3),1:"")

D W ! S DIC="^LRO(68,LRAA,1,",DIC("B")=LRY,DIC(0)="AEQM",DIC("A")="Select "_LRAA(1)_" Date: " D ^DIC K DIC G:Y<1 A S LRAD=+Y,Y=$P(Y,U,2) D D^LRU S LRD=Y

B S LRY="" W !!,"Select ",LRAA(1)," Accession Number for ",LRD,": " R X:DTIME G:'X D I '$D(^LRO(68,LRAA,1,LRAD,1,X,0)) W !,"Accession Number doesn't exist for date selected." G B

 W ! S DA=X,DR=4,DIC="^LRO(68,LRAA,1,LRAD,1," I '$O(^LRO(68,LRAA,1,LRAD,1,DA,4,0)) W $C(7),!,"No tests entered for this accession." G B

 D EN^DIQ G B

END D V^LRU Q

LRUWL     ; IHS/DIR/FJE - DISPLAY WORKLOAD FOR ACCESSION 13:40 ; 

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4        DO END

A          WRITE !

           SET DIC="^LRO(68,"

           SET DIC(0)="AEQM"

           DO ^DIC

           KILL DIC

           IF Y<1

               GOTO END

           SET LRAA=+Y

           SET LRAA(1)=$PIECE(Y,U,2)

           SET LRY=$SELECT($DATA(^LRO(68,LRAA,1,0)):$PIECE(^(0),U,3),1:"")

D          WRITE !

           SET DIC="^LRO(68,LRAA,1,"

           SET DIC("B")=LRY

           SET DIC(0)="AEQM"

           SET DIC("A")="Select "_LRAA(1)_" Date: "

           DO ^DIC

           KILL DIC

           IF Y<1

               GOTO A

           SET LRAD=+Y

           SET Y=$PIECE(Y,U,2)

           DO D^LRU

           SET LRD=Y

B          SET LRY=""

           WRITE !!,"Select ",LRAA(1)," Accession Number for ",LRD,": "

           READ X:DTIME

           IF 'X

               GOTO D

           IF '$DATA(^LRO(68,LRAA,1,LRAD,1,X,0))

               WRITE !,"Accession Number doesn't exist for date selected."

               GOTO B

 +1        WRITE !

           SET DA=X

           SET DR=4

           SET DIC="^LRO(68,LRAA,1,LRAD,1,"

           IF '$ORDER(^LRO(68,LRAA,1,LRAD,1,DA,4,0))

               WRITE $CHAR(7),!,"No tests entered for this accession."

               GOTO B

 +2        DO EN^DIQ

           GOTO B

END        DO V^LRU

           QUIT