- 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 Feb 18, 2025@23:06:07 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
