- 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
