- LRMINEW2 ;DALOI/STAFF - NEW DATA TO BE REVIEWED/VERIFIED ;Nov 10, 2008
- ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
- ;
- Q2 ;
- ;
- N DIR,DIRUT,DTOUT,DUOUT,X,Y
- S DIR(0)="Y",DIR("B")="YES"
- S DIR("?")="Answer ""NO"" if you want to look at it now!"
- S DIR("?",1)="Answer ""YES"" to queue printing"
- S DIR("A")="Do you want to queue the data to print and review/approve it later"
- D ^DIR
- I $D(DIRUT) Q
- I Y=1 S %ZIS="MQ",%ZIS("B")="",IOP="Q"
- W ! S ZTRTN="DQ^LRMINEW2" D IO^LRWU
- Q
- ;
- ;
- DQ ;
- ;
- N LRAN,LRLOCA,LRPG
- U IO K ^TMP($J) S LREND=0,LRONETST="",LRONESPC=""
- S LRAN=0
- F S LRAN=+$O(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)) Q:LRAN<1!($G(LREND)) D:+^(LRAN)=LRDXZ!(LRDXZ=0) SORT
- S LRLOCA="",LRPG=1
- F S LRLOCA=$O(^TMP($J,LRLOCA)) Q:LRLOCA=""!($G(LREND)) D
- . S LRLTR=$E(LRLOCA,1,4),LRPG=1
- . W @IOF I $E(IOST,1,2)'="C-" D ^LRLTR
- . S LRAN=0
- . F S LRAN=+$O(^TMP($J,LRLOCA,LRAN)) Q:LRAN<1!($G(LREND)) D SENDUP Q:LREND
- ;
- K ^TMP($J),LRWRDVEW
- ;
- I $D(ZTQUEUED) S ZTREQ="@"
- Q
- ;
- ;
- SORT ;
- Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LRLOCA=$P(^(0),U,7)
- I LRLOCA'="" S ^TMP($J,LRLOCA,LRAN)=""
- Q
- ;
- ;
- SENDUP ;
- Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3))!($G(LREND)) S LRIDT=9999999-^(3),LRDFN=+^(0)
- S LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRLLT,U,6),LRCMNT=$S($D(^(99)):^(99),1:"")
- D EN^LRMIPSZ1
- I $E(IOST,1,2)'="C-" W @IOF
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMINEW2 1381 printed Jan 18, 2025@03:17:50 Page 2
- LRMINEW2 ;DALOI/STAFF - NEW DATA TO BE REVIEWED/VERIFIED ;Nov 10, 2008
- +1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
- +2 ;
- Q2 ;
- +1 ;
- +2 NEW DIR,DIRUT,DTOUT,DUOUT,X,Y
- +3 SET DIR(0)="Y"
- SET DIR("B")="YES"
- +4 SET DIR("?")="Answer ""NO"" if you want to look at it now!"
- +5 SET DIR("?",1)="Answer ""YES"" to queue printing"
- +6 SET DIR("A")="Do you want to queue the data to print and review/approve it later"
- +7 DO ^DIR
- +8 IF $DATA(DIRUT)
- QUIT
- +9 IF Y=1
- SET %ZIS="MQ"
- SET %ZIS("B")=""
- SET IOP="Q"
- +10 WRITE !
- SET ZTRTN="DQ^LRMINEW2"
- DO IO^LRWU
- +11 QUIT
- +12 ;
- +13 ;
- DQ ;
- +1 ;
- +2 NEW LRAN,LRLOCA,LRPG
- +3 USE IO
- KILL ^TMP($JOB)
- SET LREND=0
- SET LRONETST=""
- SET LRONESPC=""
- +4 SET LRAN=0
- +5 FOR
- SET LRAN=+$ORDER(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN))
- if LRAN<1!($GET(LREND))
- QUIT
- if +^(LRAN)=LRDXZ!(LRDXZ=0)
- DO SORT
- +6 SET LRLOCA=""
- SET LRPG=1
- +7 FOR
- SET LRLOCA=$ORDER(^TMP($JOB,LRLOCA))
- if LRLOCA=""!($GET(LREND))
- QUIT
- Begin DoDot:1
- +8 SET LRLTR=$EXTRACT(LRLOCA,1,4)
- SET LRPG=1
- +9 WRITE @IOF
- IF $EXTRACT(IOST,1,2)'="C-"
- DO ^LRLTR
- +10 SET LRAN=0
- +11 FOR
- SET LRAN=+$ORDER(^TMP($JOB,LRLOCA,LRAN))
- if LRAN<1!($GET(LREND))
- QUIT
- DO SENDUP
- if LREND
- QUIT
- End DoDot:1
- +12 ;
- +13 KILL ^TMP($JOB),LRWRDVEW
- +14 ;
- +15 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +16 QUIT
- +17 ;
- +18 ;
- SORT ;
- +1 if '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
- QUIT
- SET LRLOCA=$PIECE(^(0),U,7)
- +2 IF LRLOCA'=""
- SET ^TMP($JOB,LRLOCA,LRAN)=""
- +3 QUIT
- +4 ;
- +5 ;
- SENDUP ;
- +1 if '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,3))!($GET(LREND))
- QUIT
- SET LRIDT=9999999-^(3)
- SET LRDFN=+^(0)
- +2 SET LRLLT=^LR(LRDFN,"MI",LRIDT,0)
- SET LRACC=$PIECE(LRLLT,U,6)
- SET LRCMNT=$SELECT($DATA(^(99)):^(99),1:"")
- +3 DO EN^LRMIPSZ1
- +4 IF $EXTRACT(IOST,1,2)'="C-"
- WRITE @IOF
- +5 QUIT