LA7SSR ;DALISC/SED - ORDERS STATUS REPORT ;6/5/97 14:00
;;5.2;LAB MESSAGING;**27**;Sep 27, 1994
EN ;SELECT THE CRITERIA TO REPORT ON
K ^TMP($J),DIRUT
STAT S LRMSG="Statuses " D ALL G:$D(DIRUT) EXIT
K DIRUT,^TMP($J,"S"),DIR
I +Y'>0 D
.F Q:$D(DIRUT) D
..S DIR(0)="PAO^64.061:EMZ",DIR("A")="Select Status: "
..S DIR("?")="Select the status to be included on the report."
..S DIR("S")="I $P(^(0),U,7)=""U"",('$D(^TMP($J,""S"",+Y)))"
..D ^DIR
..Q:$D(DIRUT)
..S ^TMP($J,"S",+Y)=""
SITE S LRMSG="Collection Sites " D ALL G:$D(DIRUT) STAT
K DIR,DIRUT,^TMP($J,"C")
I +Y'>0 D
.F Q:$D(DIRUT) D
..S DIR(0)="PAO^4:EMZ",DIR("A")="Select Collection Site: "
..S DIR("?")="Select the Collection Site to be included on the report."
..S DIR("S")="I '$D(^TMP($J,""C"",+Y))"
..D ^DIR
..Q:$D(DIRUT)
..S ^TMP($J,"C",+Y)=""
MAN S LRMSG="Shipping Manifests" D ALL G:$D(DIRUT) SITE
K DIR,DIROUT,DUOUT,DIRUT,^TMP($J,"M")
I +Y'>0 D
.K Y F Q:$D(DIRUT) D
..S NDX=0 K ^TMP($J,"LRI")
..S LRI=0 F S LRI=$O(^LRO(69.6,"AD",LRI)) Q:+LRI'>0!$D(DIRUT) D
...Q:$D(^TMP($J,"M",LRI))
...S NDX=NDX+1
...W !,$J(NDX,3),". ",LRI
...S ^TMP($J,"LRI",NDX)=LRI
...I NDX>1,NDX#20=0 D SEL(NDX)
..I '$D(DIRUT) D SEL(NDX)
K ^TMP($J,"LRI")
PRINT ;
S L=0,DIC="69.6",FLDS="[CAPTIONED]",BY="[LA7S EXEP SORT]"
S DHD="Lab Order Status Report",DIS(0)="D CHECK^LA7SSR I +LRI"
D EN1^DIP
EXIT ;EXIT
K ^TMP($J),DIR,LRI,DIRUT,LRMSG,NDX,X,Y,DIC
Q
ALL S DIR(0)="Y",DIR("B")="YES",DIR("A")="Include All "_LRMSG
S DIR("?")="Enter (Y)es or return for all entries on the report."
D ^DIR
Q
SEL(N) ;MAKE A SELECTION
K DTOUT,DUOUT,DIROUT
W ! S DIR(0)="NOA^1:"_N_":0"
S DIR("A")="Select Shipping Manifest 1 - "_N_": " D ^DIR
I +Y S ^TMP($J,"M",$G(^TMP($J,"LRI",Y)))=""
Q
CHECK ;ENTER HERE TO SCREEN THE ENTRIES
S LRI=1
I $D(^TMP($J,"S")) D
.S LRTST=0 F S LRTST=$O(^LRO(69.6,D0,2,LRTST)) Q:+LRTST'>0 D
..S LRST=$P(^LRO(69.6,D0,2,LRTST,0),U,6)
..I +$G(LRST)'>0 S LRI=0 Q
..S:'$D(^TMP($J,"S",LRST)) LRI=0
I $D(^TMP($J,"C")),(LRI=1),+$P(^LRO(69.6,D0,0),U,5)'="",'$D(^TMP($J,"C",+$P(^LRO(69.6,D0,0),U,5))) S LRI=0
I $D(^TMP($J,"M")),(LRI=1),$P(^LRO(69.6,D0,0),U,14)'="",'$D(^TMP($J,"M",$P(^LRO(69.6,D0,0),U,14))) S LRI=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7SSR 2271 printed Dec 13, 2024@01:39:44 Page 2
LA7SSR ;DALISC/SED - ORDERS STATUS REPORT ;6/5/97 14:00
+1 ;;5.2;LAB MESSAGING;**27**;Sep 27, 1994
EN ;SELECT THE CRITERIA TO REPORT ON
+1 KILL ^TMP($JOB),DIRUT
STAT SET LRMSG="Statuses "
DO ALL
if $DATA(DIRUT)
GOTO EXIT
+1 KILL DIRUT,^TMP($JOB,"S"),DIR
+2 IF +Y'>0
Begin DoDot:1
+3 FOR
if $DATA(DIRUT)
QUIT
Begin DoDot:2
+4 SET DIR(0)="PAO^64.061:EMZ"
SET DIR("A")="Select Status: "
+5 SET DIR("?")="Select the status to be included on the report."
+6 SET DIR("S")="I $P(^(0),U,7)=""U"",('$D(^TMP($J,""S"",+Y)))"
+7 DO ^DIR
+8 if $DATA(DIRUT)
QUIT
+9 SET ^TMP($JOB,"S",+Y)=""
End DoDot:2
End DoDot:1
SITE SET LRMSG="Collection Sites "
DO ALL
if $DATA(DIRUT)
GOTO STAT
+1 KILL DIR,DIRUT,^TMP($JOB,"C")
+2 IF +Y'>0
Begin DoDot:1
+3 FOR
if $DATA(DIRUT)
QUIT
Begin DoDot:2
+4 SET DIR(0)="PAO^4:EMZ"
SET DIR("A")="Select Collection Site: "
+5 SET DIR("?")="Select the Collection Site to be included on the report."
+6 SET DIR("S")="I '$D(^TMP($J,""C"",+Y))"
+7 DO ^DIR
+8 if $DATA(DIRUT)
QUIT
+9 SET ^TMP($JOB,"C",+Y)=""
End DoDot:2
End DoDot:1
MAN SET LRMSG="Shipping Manifests"
DO ALL
if $DATA(DIRUT)
GOTO SITE
+1 KILL DIR,DIROUT,DUOUT,DIRUT,^TMP($JOB,"M")
+2 IF +Y'>0
Begin DoDot:1
+3 KILL Y
FOR
if $DATA(DIRUT)
QUIT
Begin DoDot:2
+4 SET NDX=0
KILL ^TMP($JOB,"LRI")
+5 SET LRI=0
FOR
SET LRI=$ORDER(^LRO(69.6,"AD",LRI))
if +LRI'>0!$DATA(DIRUT)
QUIT
Begin DoDot:3
+6 if $DATA(^TMP($JOB,"M",LRI))
QUIT
+7 SET NDX=NDX+1
+8 WRITE !,$JUSTIFY(NDX,3),". ",LRI
+9 SET ^TMP($JOB,"LRI",NDX)=LRI
+10 IF NDX>1
IF NDX#20=0
DO SEL(NDX)
End DoDot:3
+11 IF '$DATA(DIRUT)
DO SEL(NDX)
End DoDot:2
End DoDot:1
+12 KILL ^TMP($JOB,"LRI")
PRINT ;
+1 SET L=0
SET DIC="69.6"
SET FLDS="[CAPTIONED]"
SET BY="[LA7S EXEP SORT]"
+2 SET DHD="Lab Order Status Report"
SET DIS(0)="D CHECK^LA7SSR I +LRI"
+3 DO EN1^DIP
EXIT ;EXIT
+1 KILL ^TMP($JOB),DIR,LRI,DIRUT,LRMSG,NDX,X,Y,DIC
+2 QUIT
ALL SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Include All "_LRMSG
+1 SET DIR("?")="Enter (Y)es or return for all entries on the report."
+2 DO ^DIR
+3 QUIT
SEL(N) ;MAKE A SELECTION
+1 KILL DTOUT,DUOUT,DIROUT
+2 WRITE !
SET DIR(0)="NOA^1:"_N_":0"
+3 SET DIR("A")="Select Shipping Manifest 1 - "_N_": "
DO ^DIR
+4 IF +Y
SET ^TMP($JOB,"M",$GET(^TMP($JOB,"LRI",Y)))=""
+5 QUIT
CHECK ;ENTER HERE TO SCREEN THE ENTRIES
+1 SET LRI=1
+2 IF $DATA(^TMP($JOB,"S"))
Begin DoDot:1
+3 SET LRTST=0
FOR
SET LRTST=$ORDER(^LRO(69.6,D0,2,LRTST))
if +LRTST'>0
QUIT
Begin DoDot:2
+4 SET LRST=$PIECE(^LRO(69.6,D0,2,LRTST,0),U,6)
+5 IF +$GET(LRST)'>0
SET LRI=0
QUIT
+6 if '$DATA(^TMP($JOB,"S",LRST))
SET LRI=0
End DoDot:2
End DoDot:1
+7 IF $DATA(^TMP($JOB,"C"))
IF (LRI=1)
IF +$PIECE(^LRO(69.6,D0,0),U,5)'=""
IF '$DATA(^TMP($JOB,"C",+$PIECE(^LRO(69.6,D0,0),U,5)))
SET LRI=0
+8 IF $DATA(^TMP($JOB,"M"))
IF (LRI=1)
IF $PIECE(^LRO(69.6,D0,0),U,14)'=""
IF '$DATA(^TMP($JOB,"M",$PIECE(^LRO(69.6,D0,0),U,14)))
SET LRI=0
+9 QUIT
