- LRLL1A ;SLC/RWF - LOAD LIST CONTROL ; 2/23/89 17:29 ;
- ;;5.2;LAB SERVICE;***538***;Sep 27, 1994;Build 9
- L1 W !,"All urgencys" S %=1,LRURX="I 1" D YN^DICN G END:%=-1 I %=0 W !,"Build the list with all urgencys or with a range." G L1
- I %=2 S DIC="^LAB(62.05,",DIC("S")="I '$P(^(0),U,3)",DIC(0)="AEMQ",DIC("A")="Most Urgent:" D ^DIC G END:Y<.1 S L1=+Y,DIC("A")="Least Urgent:" D ^DIC G END:Y<.1 S LRURX="I LRUS'<"_+L1_"&(LRUS'>"_+Y_")"
- L2 W !,"1 Allow splitting tests from each accession between load/worklists.",!,"2 Require all tests to build or build none at all (for each accession).",!,"Choose: 1//" R X:DTIME G:X="^" END I X'="",'(X=1!(X=2)) W !,"Enter 1 or 2." G L2
- S LRSPLIT=(X'=2),DUOUT=0
- D CLEAR^LRLL3:'$D(^LRO(68.2,LRINST,2)) S LAST=$S($D(^LRO(68.2,LRINST,2)):^(2),1:"^1^1^0^0") G END:DUOUT
- IF +LAST,+LAST'=DT W !!,"LOAD/WORK LIST SET FOR " S Y=+LAST D DD^LRX W Y S %=1 D CLEAR^LRLL3 G END:DUOUT
- C1 S LRAD=DT W !,"HOW MANY",$S(LRTYPE:" TRAYS",1:" ENTRIES")," TO BUILD: ALL//" R X:DTIME G END:X["^"
- W:X["?" !,"Accessions will be put on the list only to fill the number of",$S(LRTYPE:" trays",1:" entries")," specified." G C1:X["?" S:X=""!("Aa"[$E(X)) X=9999 S:X<1 X=1 S LRTRACNT=+X
- W:LRAA !," ACCESSION LIST: ",$P(^LRO(68,LRAA,0),U,1) I LRAA="" W !,"Need an accession area." S LRDEF=2 D NODEF
- K LRSTAR W !,"USE DEFAULT SETUP" S %=1 D YN^DICN Q:%<1 S LRDEF=% G BUILD:%=1
- NODEF K DIC
- W ! D CLEAR^LRLL3
- S DIC="^LRO(68,",DIC(0)="AEOQ",DIC("B")=$P(^LRO(68,LRAA,0),U,1) D ^DIC K DIC Q:Y<1 S LRAA=+Y
- D:$P(^LRO(68,LRAA,0),U,3)="Y" LRSTAR G BUILD:$D(LRSTAR)
- DAT R !,"Accession DATE: T//",X:DTIME S:X="" X="T" S %DT="EP" D ^%DT G DAT:X["?" S LRAD=Y
- R !,"ACCESSION NUMBER: FIRST//",LRST:DTIME S LRST=$S(LRST="":1,LRST:+LRST,1:-1) Q:LRST<0
- R !," GOTO: LAST//",LRLLT:DTIME S LRLLT=$S(LRLLT="":9999999,LRLLT:+LRLLT,1:-1) Q:LRLLT<0
- BUILD S LRTRAY=1+$P(LAST,U,4),LRCUP=1+$P(LAST,U,5)
- W !,$S(LRTYPE:"TRAY",1:"SEQUENCE #")," TO START WITH: ",$S(LRTYPE:LRTRAY,1:LRCUP),"//" R X:DTIME Q:X=U I X["?" W !?5,"Enter number to start with.",! G BUILD
- S X=$S(X="":$S(LRTYPE:LRTRAY,1:LRCUP),X<1:1,1:+X) S:LRTRAY'=$P(LAST,U,4) LRCUP=1
- S LRTRAY=$S(LRTYPE:+X,1:1),LRCUP=+$S(LRTYPE:$S($D(^LRO(68.2,LRINST,1,LRTRAY)):LRCUP,1:1),1:+X)
- IF $D(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0)) W $C(7),!," STARTING POINT IN USE. OK" S %=1 D YN^DICN G BUILD:%'=1
- I LRDEF=1,$P(^LRO(68,LRAA,0),U,3)="Y" D LRSTAR Q:%<0
- G B1:$D(LRSTAR)
- S X=$P(^LRO(68,LRAA,0),U,3),LRAD=$S(X="Y":$E(LRAD,1,3)_"0000","D"[X:LRAD,"M"[X:$E(LRAD,1,5)_"00","Q"[X:$E(LRAD,1,3)_"0000"+(($E(LRAD,4,5)-1)\3*300+100),1:LRAD)
- B1 S $P(^LRO(68.2,LRINST,2),U,2,3)=LRTRAY_U_LRCUP S:LRCUP>0 LRCUP=LRCUP-1 K % X LRLLINIT
- B2 K IO("Q") W !,"Queue build and print:" S %=2 D YN^DICN Q:%<0 S:%=1 IO("Q")=1 I %=0 W !?5,"Answer YES or NO.",! G B2
- G ^LRLL1
- LRSTAR W !,"Do you wish to build by date (rather than by accession number)" S %=1 D YN^DICN G LRSTAR:%=0 Q:%'=1
- S %DT="AEQ",%DT("A")="Enter earliest date received at lab to build: " D ^%DT K %DT S:Y<1 %=-1 Q:Y<0 S LRSTAR=Y
- K DUOUT S %DT="AEQ",%DT("A")="Enter latest date received at lab to build: " D ^%DT K %DT S LRLST=Y,%=$S($D(DUOUT):-1,1:0)
- ;LR*5.2*538 - do not subtract one from $E(LRSTAR,1,3) because routine LRLL1 will subtract the "1".
- S LRAD=$E(LRSTAR,1,3)_"0000" S:LRLST'=-1 LRWDTL=$E(LRLST,1,3)_"0000",LRLST=LRLST\1+.99 S:LRLST=-1 LRWDTL=$E(DT,1,3)_"0000"
- Q
- END G END^LRLL1
- ;LRTRAY = CURRENT TRAY #, LRCUP = CURRENT CUP #
- ;LRTYPE = 0 FOR SEQ., 1 FOR TRAY, 2 FOR BATCH
- ;LRFULL = 0 FOR ALL WORK, 1 FOR FULL TRAY'S ONLY
- ;MAXCUP = # OF LRCUP PER LRTRAY, 0 IF NO LIMIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRLL1A 3632 printed Jan 18, 2025@03:16:58 Page 2
- LRLL1A ;SLC/RWF - LOAD LIST CONTROL ; 2/23/89 17:29 ;
- +1 ;;5.2;LAB SERVICE;***538***;Sep 27, 1994;Build 9
- L1 WRITE !,"All urgencys"
- SET %=1
- SET LRURX="I 1"
- DO YN^DICN
- if %=-1
- GOTO END
- IF %=0
- WRITE !,"Build the list with all urgencys or with a range."
- GOTO L1
- +1 IF %=2
- SET DIC="^LAB(62.05,"
- SET DIC("S")="I '$P(^(0),U,3)"
- SET DIC(0)="AEMQ"
- SET DIC("A")="Most Urgent:"
- DO ^DIC
- if Y<.1
- GOTO END
- SET L1=+Y
- SET DIC("A")="Least Urgent:"
- DO ^DIC
- if Y<.1
- GOTO END
- SET LRURX="I LRUS'<"_+L1_"&(LRUS'>"_+Y_")"
- L2 WRITE !,"1 Allow splitting tests from each accession between load/worklists.",!,"2 Require all tests to build or build none at all (for each accession).",!,"Choose: 1//"
- READ X:DTIME
- if X="^"
- GOTO END
- IF X'=""
- IF '(X=1!(X=2))
- WRITE !,"Enter 1 or 2."
- GOTO L2
- +1 SET LRSPLIT=(X'=2)
- SET DUOUT=0
- +2 if '$DATA(^LRO(68.2,LRINST,2))
- DO CLEAR^LRLL3
- SET LAST=$SELECT($DATA(^LRO(68.2,LRINST,2)):^(2),1:"^1^1^0^0")
- if DUOUT
- GOTO END
- +3 IF +LAST
- IF +LAST'=DT
- WRITE !!,"LOAD/WORK LIST SET FOR "
- SET Y=+LAST
- DO DD^LRX
- WRITE Y
- SET %=1
- DO CLEAR^LRLL3
- if DUOUT
- GOTO END
- C1 SET LRAD=DT
- WRITE !,"HOW MANY",$SELECT(LRTYPE:" TRAYS",1:" ENTRIES")," TO BUILD: ALL//"
- READ X:DTIME
- if X["^"
- GOTO END
- +1 if X["?"
- WRITE !,"Accessions will be put on the list only to fill the number of",$SELECT(LRTYPE:" trays",1:" entries")," specified."
- if X["?"
- GOTO C1
- if X=""!("Aa"[$EXTRACT(X))
- SET X=9999
- if X<1
- SET X=1
- SET LRTRACNT=+X
- +2 if LRAA
- WRITE !," ACCESSION LIST: ",$PIECE(^LRO(68,LRAA,0),U,1)
- IF LRAA=""
- WRITE !,"Need an accession area."
- SET LRDEF=2
- DO NODEF
- +3 KILL LRSTAR
- WRITE !,"USE DEFAULT SETUP"
- SET %=1
- DO YN^DICN
- if %<1
- QUIT
- SET LRDEF=%
- if %=1
- GOTO BUILD
- NODEF KILL DIC
- +1 WRITE !
- DO CLEAR^LRLL3
- +2 SET DIC="^LRO(68,"
- SET DIC(0)="AEOQ"
- SET DIC("B")=$PIECE(^LRO(68,LRAA,0),U,1)
- DO ^DIC
- KILL DIC
- if Y<1
- QUIT
- SET LRAA=+Y
- +3 if $PIECE(^LRO(68,LRAA,0),U,3)="Y"
- DO LRSTAR
- if $DATA(LRSTAR)
- GOTO BUILD
- DAT READ !,"Accession DATE: T//",X:DTIME
- if X=""
- SET X="T"
- SET %DT="EP"
- DO ^%DT
- if X["?"
- GOTO DAT
- SET LRAD=Y
- +1 READ !,"ACCESSION NUMBER: FIRST//",LRST:DTIME
- SET LRST=$SELECT(LRST="":1,LRST:+LRST,1:-1)
- if LRST<0
- QUIT
- +2 READ !," GOTO: LAST//",LRLLT:DTIME
- SET LRLLT=$SELECT(LRLLT="":9999999,LRLLT:+LRLLT,1:-1)
- if LRLLT<0
- QUIT
- BUILD SET LRTRAY=1+$PIECE(LAST,U,4)
- SET LRCUP=1+$PIECE(LAST,U,5)
- +1 WRITE !,$SELECT(LRTYPE:"TRAY",1:"SEQUENCE #")," TO START WITH: ",$SELECT(LRTYPE:LRTRAY,1:LRCUP),"//"
- READ X:DTIME
- if X=U
- QUIT
- IF X["?"
- WRITE !?5,"Enter number to start with.",!
- GOTO BUILD
- +2 SET X=$SELECT(X="":$SELECT(LRTYPE:LRTRAY,1:LRCUP),X<1:1,1:+X)
- if LRTRAY'=$PIECE(LAST,U,4)
- SET LRCUP=1
- +3 SET LRTRAY=$SELECT(LRTYPE:+X,1:1)
- SET LRCUP=+$SELECT(LRTYPE:$SELECT($DATA(^LRO(68.2,LRINST,1,LRTRAY)):LRCUP,1:1),1:+X)
- +4 IF $DATA(^LRO(68.2,LRINST,1,LRTRAY,1,LRCUP,0))
- WRITE $CHAR(7),!," STARTING POINT IN USE. OK"
- SET %=1
- DO YN^DICN
- if %'=1
- GOTO BUILD
- +5 IF LRDEF=1
- IF $PIECE(^LRO(68,LRAA,0),U,3)="Y"
- DO LRSTAR
- if %<0
- QUIT
- +6 if $DATA(LRSTAR)
- GOTO B1
- +7 SET X=$PIECE(^LRO(68,LRAA,0),U,3)
- SET LRAD=$SELECT(X="Y":$EXTRACT(LRAD,1,3)_"0000","D"[X:LRAD,"M"[X:$EXTRACT(LRAD,1,5)_"00","Q"[X:$EXTRACT(LRAD,1,3)_"0000"+(($EXTRACT(LRAD,4,5)-1)\3*300+100),1:LRAD)
- B1 SET $PIECE(^LRO(68.2,LRINST,2),U,2,3)=LRTRAY_U_LRCUP
- if LRCUP>0
- SET LRCUP=LRCUP-1
- KILL %
- XECUTE LRLLINIT
- B2 KILL IO("Q")
- WRITE !,"Queue build and print:"
- SET %=2
- DO YN^DICN
- if %<0
- QUIT
- if %=1
- SET IO("Q")=1
- IF %=0
- WRITE !?5,"Answer YES or NO.",!
- GOTO B2
- +1 GOTO ^LRLL1
- LRSTAR WRITE !,"Do you wish to build by date (rather than by accession number)"
- SET %=1
- DO YN^DICN
- if %=0
- GOTO LRSTAR
- if %'=1
- QUIT
- +1 SET %DT="AEQ"
- SET %DT("A")="Enter earliest date received at lab to build: "
- DO ^%DT
- KILL %DT
- if Y<1
- SET %=-1
- if Y<0
- QUIT
- SET LRSTAR=Y
- +2 KILL DUOUT
- SET %DT="AEQ"
- SET %DT("A")="Enter latest date received at lab to build: "
- DO ^%DT
- KILL %DT
- SET LRLST=Y
- SET %=$SELECT($DATA(DUOUT):-1,1:0)
- +3 ;LR*5.2*538 - do not subtract one from $E(LRSTAR,1,3) because routine LRLL1 will subtract the "1".
- +4 SET LRAD=$EXTRACT(LRSTAR,1,3)_"0000"
- if LRLST'=-1
- SET LRWDTL=$EXTRACT(LRLST,1,3)_"0000"
- SET LRLST=LRLST\1+.99
- if LRLST=-1
- SET LRWDTL=$EXTRACT(DT,1,3)_"0000"
- +5 QUIT
- END GOTO END^LRLL1
- +1 ;LRTRAY = CURRENT TRAY #, LRCUP = CURRENT CUP #
- +2 ;LRTYPE = 0 FOR SEQ., 1 FOR TRAY, 2 FOR BATCH
- +3 ;LRFULL = 0 FOR ALL WORK, 1 FOR FULL TRAY'S ONLY
- +4 ;MAXCUP = # OF LRCUP PER LRTRAY, 0 IF NO LIMIT