Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRMINEW2

LRMINEW2.m

Go to the documentation of this file.
  1. LRMINEW2 ;DALOI/STAFF - NEW DATA TO BE REVIEWED/VERIFIED ;Nov 10, 2008
  1. ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
  1. ;
  1. Q2 ;
  1. ;
  1. N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="Y",DIR("B")="YES"
  1. S DIR("?")="Answer ""NO"" if you want to look at it now!"
  1. S DIR("?",1)="Answer ""YES"" to queue printing"
  1. S DIR("A")="Do you want to queue the data to print and review/approve it later"
  1. D ^DIR
  1. I $D(DIRUT) Q
  1. I Y=1 S %ZIS="MQ",%ZIS("B")="",IOP="Q"
  1. W ! S ZTRTN="DQ^LRMINEW2" D IO^LRWU
  1. Q
  1. ;
  1. ;
  1. DQ ;
  1. ;
  1. N LRAN,LRLOCA,LRPG
  1. U IO K ^TMP($J) S LREND=0,LRONETST="",LRONESPC=""
  1. S LRAN=0
  1. F S LRAN=+$O(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)) Q:LRAN<1!($G(LREND)) D:+^(LRAN)=LRDXZ!(LRDXZ=0) SORT
  1. S LRLOCA="",LRPG=1
  1. F S LRLOCA=$O(^TMP($J,LRLOCA)) Q:LRLOCA=""!($G(LREND)) D
  1. . S LRLTR=$E(LRLOCA,1,4),LRPG=1
  1. . W @IOF I $E(IOST,1,2)'="C-" D ^LRLTR
  1. . S LRAN=0
  1. . F S LRAN=+$O(^TMP($J,LRLOCA,LRAN)) Q:LRAN<1!($G(LREND)) D SENDUP Q:LREND
  1. ;
  1. K ^TMP($J),LRWRDVEW
  1. ;
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. Q
  1. ;
  1. ;
  1. SORT ;
  1. Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LRLOCA=$P(^(0),U,7)
  1. I LRLOCA'="" S ^TMP($J,LRLOCA,LRAN)=""
  1. Q
  1. ;
  1. ;
  1. SENDUP ;
  1. Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3))!($G(LREND)) S LRIDT=9999999-^(3),LRDFN=+^(0)
  1. S LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRLLT,U,6),LRCMNT=$S($D(^(99)):^(99),1:"")
  1. D EN^LRMIPSZ1
  1. I $E(IOST,1,2)'="C-" W @IOF
  1. Q