LRMIPLOG.m

LRMIPLOG ; IHS/DIR/FJE - PRINT BY LOG NUMBER 2/19/91 10:53 ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 ;from option LRMIPLOG

BEGIN D ^LRPARAM D LOG

END ;K D,DFN,DIC,DOB,I,J,K,LRAA,LRACC,LRAD,LRAN,LRCMNT,LRDAT,LRDFN,LRDPF,LREND,LRIDT,LRLLT,LRONESPC,LRONETST,LRPG,PNM,POP,R,SSN,X,X1,Y

 K D,DFN,DIC,DOB,I,J,K,LRAA,LRACC,LRAD,LRAN,LRCMNT,LRDAT,LRDFN,LRDPF,LREND,LRIDT,LRLLT,LRONESPC,LRONETST,LRPG,PNM,POP,R,SSN,HRCN,X,X1,Y  ;IHS/ANMC/CLS 08/18/96

 Q

LOG D LRAA^LRMIUT Q:LRAA<1  S LREND=0 S LRDAT=LRDT0,(LRADX,LRONETST,LRONESPC)=""

 F I=0:0 S LRAD=$E(DT,2,3),%DT="",%DT("A")="Accession Date: ",%DT("B")=LRAD D DATE^LRWU Q:LREND!(Y'<2800000)

 Q:LREND

 S LRAD=$S($P(^LRO(68,LRAA,0),U,3)="Y":$E(Y,1,3)_"0000",1:Y)

 W !!,"Enter Accession Numbers"

 D LRAN^LRMIUT Q:'$O(LRAN(0))

 S %ZIS("B")="",%ZIS="MQ" S ZTRTN="DQ^LRMIPLOG" D IO^LRWU

 Q

DQ ;dequeued

 S:$D(ZTQUEUED) ZTREQ="@" U IO D DT^LRX

 S LRAN=0 F I=0:0 S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1  D SENDUP Q:LREND

 Q

SENDUP Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3))  S LRIDT=9999999-^(3),LRDFN=+^(0),LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRLLT,U,6),LRCMNT=$S($D(^(99)):^(99),1:""),LRPG=0 D EN^LRMIPSZ1 Q:LREND

 Q

LRMIPLOG  ; IHS/DIR/FJE - PRINT BY LOG NUMBER 2/19/91 10:53 ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4       ;from option LRMIPLOG

BEGIN      DO ^LRPARAM

           DO LOG

END       ;K D,DFN,DIC,DOB,I,J,K,LRAA,LRACC,LRAD,LRAN,LRCMNT,LRDAT,LRDFN,LRDPF,LREND,LRIDT,LRLLT,LRONESPC,LRONETST,LRPG,PNM,POP,R,SSN,X,X1,Y

 +1       ;IHS/ANMC/CLS 08/18/96

           KILL D,DFN,DIC,DOB,I,J,K,LRAA,LRACC,LRAD,LRAN,LRCMNT,LRDAT,LRDFN,LRDPF,LREND,LRIDT,LRLLT,LRONESPC,LRONETST,LRPG,PNM,POP,R,SSN,HRCN,X,X1,Y

 +2        QUIT 

LOG        DO LRAA^LRMIUT

           IF LRAA<1

               QUIT 

           SET LREND=0

           SET LRDAT=LRDT0

           SET (LRADX,LRONETST,LRONESPC)=""

 +1        FOR I=0:0

               SET LRAD=$EXTRACT(DT,2,3)

               SET %DT=""

               SET %DT("A")="Accession Date: "

               SET %DT("B")=LRAD

               DO DATE^LRWU

               IF LREND!(Y'<2800000)

                   QUIT 

 +2        IF LREND

               QUIT 

 +3        SET LRAD=$SELECT($PIECE(^LRO(68,LRAA,0),U,3)="Y":$EXTRACT(Y,1,3)_"0000",1:Y)

 +4        WRITE !!,"Enter Accession Numbers"

 +5        DO LRAN^LRMIUT

           IF '$ORDER(LRAN(0))

               QUIT 

 +6        SET %ZIS("B")=""

           SET %ZIS="MQ"

           SET ZTRTN="DQ^LRMIPLOG"

           DO IO^LRWU

 +7        QUIT 

DQ        ;dequeued

 +1        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

           USE IO

           DO DT^LRX

 +2        SET LRAN=0

           FOR I=0:0

               SET LRAN=+$ORDER(LRAN(LRAN))

               IF LRAN<1

                   QUIT 

               DO SENDUP

               IF LREND

                   QUIT 

 +3        QUIT 

SENDUP     IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,3))

               QUIT 

           SET LRIDT=9999999-^(3)

           SET LRDFN=+^(0)

           SET LRLLT=^LR(LRDFN,"MI",LRIDT,0)

           SET LRACC=$PIECE(LRLLT,U,6)

           SET LRCMNT=$SELECT($DATA(^(99)):^(99),1:"")

           SET LRPG=0

           DO EN^LRMIPSZ1

           IF LREND

               QUIT 

 +1        QUIT