LRGEN1.m

LRGEN1 ;SLC/RWF-GENERAL DATA DISPLAY ;2/19/91  10:35 [ 04/23/2003  7:42 AM ]

 ;;5.2T9;LR;**1004,1006,1013,1015,1018**;Nov 17, 2004

 ;;5.2;LAB SERVICE;**201,221**;Sep 27, 1994

DQ ;dequeued from LRGEN

 N LRPDT,LRPTF,LRPAGE

 S LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"5MZ")

 S LRPRTF="Report Range  [ "_$$FMTE^XLFDT($P(LRSDT,"."),"5MZ")_" - "_$$FMTE^XLFDT(9999999-$P(LREDT,"."),"5MZ")_" ]"

 K LRNOTE,LRSV S (LRPAGE,LRNOTE,LREND)=0

 S:'$G(LRIDT) LRIDT=1 W:$E(IOST,1,2)="C-" @IOF

 S $P(LRDASH,"-",(IOM-1))="",$P(LREQUAL,"=",(IOM-1))=""

 S LRWPL=IOSL-(3*LRIX)/LRIX

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

 S LRCW=LRCW-3,LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)

 D DT^LRX,PT^LRX,HEAD

 F  D NX Q:LREND!(LRIDT<1)!(LRIDT>LREDT)

 D WRTLN

 K LRDASH,LREQUAL,LRAGE,LRRB,LRTREAT,LRUNKNOW,SEX,AGE

 ;D KVAR^VADPT

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 D @$S($$ISPIMS^BLRUTIL:"KVAR^VADPT",1:"KVAR^BLRDPT")

 ;----- END IHS MODIFICSTIONS

 ;

 Q

WRTLN W ! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC Q

NX I LRY'<LRWPL D BOT:LRSC=LRIX,HEAD:'LREND Q:LREND  I LRSC>1,LRSUB(LRSC)=LRSUB(LRSC-1) D NSET Q

 S:LRIDT>1 LRIDT=+$O(^LR(LRDFN,LRSUB,LRIDT)) I LRIDT<1!(LRIDT>LREDT) D  Q

 . I LRSC>1,LRSUB(LRSC)=LRSUB(LRSC-1) D NSET

 . S LRY=LRWPL D BOT,LAST

 S Z=$S($D(^LR(LRDFN,LRSUB,LRIDT,0)):^(0),1:"") Q:'$P(Z,U,3)  I LRTP,LRTP'=$P(Z,U,5) Q

 S LRNOP=1,II=0 F  S II=+$O(LRND(II)) Q:II<1  S:$D(^LR(LRDFN,LRSUB,LRIDT,LRND(II))) LRNOP=0

 Q:LRNOP  I $D(LRSUB(LRSC+1)),LRSUB(LRSC+1)=LRSUB(LRSC) S LRSV(LRY)=LRIDT

 D LRPR

 Q

NSET S LRSSP=0 F  S LRSSP=+$O(LRSV(LRSSP)) Q:LRSSP<1  S LRIDT=LRSV(LRSSP),Z=^LR(LRDFN,LRSUB,LRIDT,0) D LRPR

 S LRIDT=LRIDT(LRSC-1),LRY=LRWPL

 Q

LRPR N LRSAMP

 S X=+Z,LRTN=$P(Z,U,5),LRSAMP="?" S:LRTN'="" LRSAMP=$S($D(^LAB(61,LRTN,0)):$E(^(0),1,3),1:"?")

 S LRDAT=$$FMTE^XLFDT(X,"5MZ")

 S T="      "

 S:X["." T=" "_$E(X_"00000",9,10)_":"_$E(X_"0000",11,12)_" "

 S LRFOOT=" "

 I $O(^LR(LRDFN,LRSUB,LRIDT,1,0))>0 D

 . S:'$D(LRNOTE(-1,LRIDT)) LRNOTE=$G(LRNOTE)+1,LRNOTE(LRNOTE)=LRIDT,LRNOTE(-1,LRIDT)=LRNOTE S LRFOOT=$C(LRNOTE(-1,LRIDT)+64)

 ;W !,LRFOOT," ",LRDAT S LRY=LRY+1

 ;W !,?13,LRSAMP,?20 S X=$D(^LR(LRDFN,LRSUB,LRIDT,0)),LRX=$X,LRY=LRY+1

 ;W !,LRFOOT,?3,$P(LRDAT,"@"),?14,T,?21,S,?24 S LRY=LRY+1,X=$D(^LR(LRDFN,LRSUB,LRIDT,0)),LRX=$X  ;IHS/ITSC/TPF 10/1/01 MODIFY DISPLAY PATCH **1013**

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 W !,LRFOOT,?3,$P(LRDAT,"@"),?14,T,?21,LRSAMP,?24 S LRY=LRY+1,X=$D(^LR(LRDFN,LRSUB,LRIDT,0)),LRX=$X  ;IHS/ITSC/TPF 10/1/01 MODIFY DISPLAY PATCH **1013**

 ;----- END IHS MODIFICATIONS

 F I=S1:1:S2 D

 . S X=$S($D(^LR(LRDFN,LRSUB,LRIDT,LRND(I))):^(LRND(I)),1:""),LRFFLG=$P(X,U,2),X=$P(X,U)

 . W ?LRX,@$S(X'=""&$D(LRPR(I)):LRPR(I),1:"$J(X,LRCW)")," ",LRFFLG

 . S LRX=LRX+3+LRCW

 Q

HEAD Q:'$G(LRIDT)!($G(LREND))

 S:'$G(LRY) LRY=2 S:'$D(LRPRTF) $P(LRPRTF," ",20)=""

 S $P(LRDASH,"-",(IOM-1))="",$P(LREQUAL,"=",(IOM-1))=""

 S LREND=0 I '$G(LRBOT) F  Q:LREND  D HD1 Q:'(LRIDT<1!(LRIDT>LREDT))  S LREND=1 F II=1:1:LRIX I LRIDT(II)>0,LRIDT(II)<LREDT S LREND=0 Q

 Q:$G(LREND)

 S:'$D(LRPDT) LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"5MZ")

 I $G(LRSC)=1 D

 . S LRPAGE=$G(LRPAGE)+1,LRY=2 W @IOF

 . ;W !,"WORK COPY: ",PNM,"  ",SSN,"  Age:",AGE," ",?50,"Prt Date:",LRPDT

 .;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 . W !,"WORK COPY: ",PNM,"  ",HRCN,"  Age:",AGE," ",?50,"Prt Date:",LRPDT

 .;----- END IHS MODIFICATIONS

 . W !,$$CJ^XLFSTR(LRPRTF_"     Pg:"_LRPAGE,IOM) S LRY=LRY+1

 S X=9999999-$O(^LR(LRDFN,"CH",LRIDT)) W !! W:'$L($G(LRHDR(LRSC,1))) ?13,"SPEC" W ?20,LRHDR(LRSC) S LRY=LRY+2

 I $L(LRHDR(LRSC,2)) W !,$S($D(LRTHER):" Ther.",1:"  Ref")," Range",?17,LRHDR(LRSC,2) S LRY=LRY+1

 I $L(LRHDR(LRSC,1)) W !,?13,"SPEC",?20,LRHDR(LRSC,1) S LRY=LRY+1

 W !,LREQUAL S LRY=LRY+1

 Q

HD1 Q:$G(LREND)

 S LRIDT(LRSC)=LRIDT,LRSC=$S(LRSC<LRIX:LRSC+1,1:1),LRIDT=$G(LRIDT(LRSC)) Q:'LRIDT  S S1=LRIX(LRSC)+1,S2=LRIX(LRSC+1)

 I LRSC=1 K LRNOTE,LRSV S LRNOTE=0

 I LRSUB'=LRSUB(LRSC) S LRSUB=LRSUB(LRSC) K LRSV

 Q

LAST W !,$$CJ^XLFSTR("[  *** End Of Report ***  ]",IOM),!

 S LREND=1

 Q

BOT D KEYCOM^LRX:$E(IOST,1,2)'="C-"

 N II

 W !,LRDASH

 I $G(LRNOTE) F II=1:1:LRNOTE  S LRIDT1=LRNOTE(II) D

 . I LRY'<LRWPL D B1 Q:$G(LREND)  S LRBOT=1 D HEAD K LRBOT

 . W !,$C(II+64) S J=0 F  S J=$O(^LR(LRDFN,LRSUB,LRIDT1,1,J)) Q:J<1  D

 . . W ?5,^(J,0) W:$O(^LR(LRDFN,LRSUB,LRIDT1,1,J)) !

 K LRNOTE S LRNOTE=0

B1 ;W !,"WORK COPY - DO NOT FILE   ",PNM,?60,SSN S LRY=2

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 W !,"WORK COPY - DO NOT FILE   ",PNM,?60,HRCN S LRY=2

 ;----- END IHS MODIFICATIONS

 I $E(IOST,1,2)="C-" W !?20," PRESS '^' TO STOP REPORT " R X:DTIME S:X="" X=1 S LREND=".^"[X Q:$G(LREND)

 Q

LRGEN1    ;SLC/RWF-GENERAL DATA DISPLAY ;2/19/91  10:35 [ 04/23/2003  7:42 AM ]

 +1       ;;5.2T9;LR;**1004,1006,1013,1015,1018**;Nov 17, 2004

 +2       ;;5.2;LAB SERVICE;**201,221**;Sep 27, 1994

DQ        ;dequeued from LRGEN

 +1        NEW LRPDT,LRPTF,LRPAGE

 +2        SET LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"5MZ")

 +3        SET LRPRTF="Report Range  [ "_$$FMTE^XLFDT($PIECE(LRSDT,"."),"5MZ")_" - "_$$FMTE^XLFDT(9999999-$PIECE(LREDT,"."),"5MZ")_" ]"

 +4        KILL LRNOTE,LRSV

           SET (LRPAGE,LRNOTE,LREND)=0

 +5        IF '$GET(LRIDT)

               SET LRIDT=1

           IF $EXTRACT(IOST,1,2)="C-"

               WRITE @IOF

 +6        SET $PIECE(LRDASH,"-",(IOM-1))=""

           SET $PIECE(LREQUAL,"=",(IOM-1))=""

 +7        SET LRWPL=IOSL-(3*LRIX)/LRIX

 +8        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

           USE IO

 +9        SET LRCW=LRCW-3

           SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)

           SET DFN=$PIECE(^(0),U,3)

 +10       DO DT^LRX

           DO PT^LRX

           DO HEAD

 +11       FOR 

               DO NX

               IF LREND!(LRIDT<1)!(LRIDT>LREDT)

                   QUIT 

 +12       DO WRTLN

 +13       KILL LRDASH,LREQUAL,LRAGE,LRRB,LRTREAT,LRUNKNOW,SEX,AGE

 +14      ;D KVAR^VADPT

 +15      ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +16       DO @$SELECT($$ISPIMS^BLRUTIL:"KVAR^VADPT",1:"KVAR^BLRDPT")

 +17      ;----- END IHS MODIFICSTIONS

 +18      ;

 +19       QUIT 

WRTLN      WRITE !

           IF $EXTRACT(IOST,1,2)="P-"

               WRITE @IOF

           DO ^%ZISC

           QUIT 

NX         IF LRY'<LRWPL

               IF LRSC=LRIX

                   DO BOT

               IF 'LREND

                   DO HEAD

               IF LREND

                   QUIT 

               IF LRSC>1

                   IF LRSUB(LRSC)=LRSUB(LRSC-1)

                       DO NSET

                       QUIT 

 +1        IF LRIDT>1

               SET LRIDT=+$ORDER(^LR(LRDFN,LRSUB,LRIDT))

           IF LRIDT<1!(LRIDT>LREDT)

               Begin DoDot:1

 +2                IF LRSC>1

                       IF LRSUB(LRSC)=LRSUB(LRSC-1)

                           DO NSET

 +3                SET LRY=LRWPL

                   DO BOT

                   DO LAST

               End DoDot:1

               QUIT 

 +4        SET Z=$SELECT($DATA(^LR(LRDFN,LRSUB,LRIDT,0)):^(0),1:"")

           IF '$PIECE(Z,U,3)

               QUIT 

           IF LRTP

               IF LRTP'=$PIECE(Z,U,5)

                   QUIT 

 +5        SET LRNOP=1

           SET II=0

           FOR 

               SET II=+$ORDER(LRND(II))

               IF II<1

                   QUIT 

               IF $DATA(^LR(LRDFN,LRSUB,LRIDT,LRND(II)))

                   SET LRNOP=0

 +6        IF LRNOP

               QUIT 

           IF $DATA(LRSUB(LRSC+1))

               IF LRSUB(LRSC+1)=LRSUB(LRSC)

                   SET LRSV(LRY)=LRIDT

 +7        DO LRPR

 +8        QUIT 

NSET       SET LRSSP=0

           FOR 

               SET LRSSP=+$ORDER(LRSV(LRSSP))

               IF LRSSP<1

                   QUIT 

               SET LRIDT=LRSV(LRSSP)

               SET Z=^LR(LRDFN,LRSUB,LRIDT,0)

               DO LRPR

 +1        SET LRIDT=LRIDT(LRSC-1)

           SET LRY=LRWPL

 +2        QUIT 

LRPR       NEW LRSAMP

 +1        SET X=+Z

           SET LRTN=$PIECE(Z,U,5)

           SET LRSAMP="?"

           IF LRTN'=""

               SET LRSAMP=$SELECT($DATA(^LAB(61,LRTN,0)):$EXTRACT(^(0),1,3),1:"?")

 +2        SET LRDAT=$$FMTE^XLFDT(X,"5MZ")

 +3        SET T="      "

 +4        IF X["."

               SET T=" "_$EXTRACT(X_"00000",9,10)_":"_$EXTRACT(X_"0000",11,12)_" "

 +5        SET LRFOOT=" "

 +6        IF $ORDER(^LR(LRDFN,LRSUB,LRIDT,1,0))>0

               Begin DoDot:1

 +7                IF '$DATA(LRNOTE(-1,LRIDT))

                       SET LRNOTE=$GET(LRNOTE)+1

                       SET LRNOTE(LRNOTE)=LRIDT

                       SET LRNOTE(-1,LRIDT)=LRNOTE

                   SET LRFOOT=$CHAR(LRNOTE(-1,LRIDT)+64)

               End DoDot:1

 +8       ;W !,LRFOOT," ",LRDAT S LRY=LRY+1

 +9       ;W !,?13,LRSAMP,?20 S X=$D(^LR(LRDFN,LRSUB,LRIDT,0)),LRX=$X,LRY=LRY+1

 +10      ;W !,LRFOOT,?3,$P(LRDAT,"@"),?14,T,?21,S,?24 S LRY=LRY+1,X=$D(^LR(LRDFN,LRSUB,LRIDT,0)),LRX=$X  ;IHS/ITSC/TPF 10/1/01 MODIFY DISPLAY PATCH **1013**

 +11      ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +12      ;IHS/ITSC/TPF 10/1/01 MODIFY DISPLAY PATCH **1013**

           WRITE !,LRFOOT,?3,$PIECE(LRDAT,"@"),?14,T,?21,LRSAMP,?24

           SET LRY=LRY+1

           SET X=$DATA(^LR(LRDFN,LRSUB,LRIDT,0))

           SET LRX=$X

 +13      ;----- END IHS MODIFICATIONS

 +14       FOR I=S1:1:S2

               Begin DoDot:1

 +15               SET X=$SELECT($DATA(^LR(LRDFN,LRSUB,LRIDT,LRND(I))):^(LRND(I)),1:"")

                   SET LRFFLG=$PIECE(X,U,2)

                   SET X=$PIECE(X,U)

 +16               WRITE ?LRX,@$SELECT(X'=""&$DATA(LRPR(I)):LRPR(I),1:"$J(X,LRCW)")," ",LRFFLG

 +17               SET LRX=LRX+3+LRCW

               End DoDot:1

 +18       QUIT 

HEAD       IF '$GET(LRIDT)!($GET(LREND))

               QUIT 

 +1        IF '$GET(LRY)

               SET LRY=2

           IF '$DATA(LRPRTF)

               SET $PIECE(LRPRTF," ",20)=""

 +2        SET $PIECE(LRDASH,"-",(IOM-1))=""

           SET $PIECE(LREQUAL,"=",(IOM-1))=""

 +3        SET LREND=0

           IF '$GET(LRBOT)

               FOR 

                   IF LREND

                       QUIT 

                   DO HD1

                   IF '(LRIDT<1!(LRIDT>LREDT))

                       QUIT 

                   SET LREND=1

                   FOR II=1:1:LRIX

                       IF LRIDT(II)>0

                           IF LRIDT(II)<LREDT

                               SET LREND=0

                               QUIT 

 +4        IF $GET(LREND)

               QUIT 

 +5        IF '$DATA(LRPDT)

               SET LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"5MZ")

 +6        IF $GET(LRSC)=1

               Begin DoDot:1

 +7                SET LRPAGE=$GET(LRPAGE)+1

                   SET LRY=2

                   WRITE @IOF

 +8       ;W !,"WORK COPY: ",PNM,"  ",SSN,"  Age:",AGE," ",?50,"Prt Date:",LRPDT

 +9       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +10               WRITE !,"WORK COPY: ",PNM,"  ",HRCN,"  Age:",AGE," ",?50,"Prt Date:",LRPDT

 +11      ;----- END IHS MODIFICATIONS

 +12               WRITE !,$$CJ^XLFSTR(LRPRTF_"     Pg:"_LRPAGE,IOM)

                   SET LRY=LRY+1

               End DoDot:1

 +13       SET X=9999999-$ORDER(^LR(LRDFN,"CH",LRIDT))

           WRITE !!

           IF '$LENGTH($GET(LRHDR(LRSC,1)))

               WRITE ?13,"SPEC"

           WRITE ?20,LRHDR(LRSC)

           SET LRY=LRY+2

 +14       IF $LENGTH(LRHDR(LRSC,2))

               WRITE !,$SELECT($DATA(LRTHER):" Ther.",1:"  Ref")," Range",?17,LRHDR(LRSC,2)

               SET LRY=LRY+1

 +15       IF $LENGTH(LRHDR(LRSC,1))

               WRITE !,?13,"SPEC",?20,LRHDR(LRSC,1)

               SET LRY=LRY+1

 +16       WRITE !,LREQUAL

           SET LRY=LRY+1

 +17       QUIT 

HD1        IF $GET(LREND)

               QUIT 

 +1        SET LRIDT(LRSC)=LRIDT

           SET LRSC=$SELECT(LRSC<LRIX:LRSC+1,1:1)

           SET LRIDT=$GET(LRIDT(LRSC))

           IF 'LRIDT

               QUIT 

           SET S1=LRIX(LRSC)+1

           SET S2=LRIX(LRSC+1)

 +2        IF LRSC=1

               KILL LRNOTE,LRSV

               SET LRNOTE=0

 +3        IF LRSUB'=LRSUB(LRSC)

               SET LRSUB=LRSUB(LRSC)

               KILL LRSV

 +4        QUIT 

LAST       WRITE !,$$CJ^XLFSTR("[  *** End Of Report ***  ]",IOM),!

 +1        SET LREND=1

 +2        QUIT 

BOT        IF $EXTRACT(IOST,1,2)'="C-"

               DO KEYCOM^LRX

 +1        NEW II

 +2        WRITE !,LRDASH

 +3        IF $GET(LRNOTE)

               FOR II=1:1:LRNOTE

                   SET LRIDT1=LRNOTE(II)

                   Begin DoDot:1

 +4                    IF LRY'<LRWPL

                           DO B1

                           IF $GET(LREND)

                               QUIT 

                           SET LRBOT=1

                           DO HEAD

                           KILL LRBOT

 +5                    WRITE !,$CHAR(II+64)

                       SET J=0

                       FOR 

                           SET J=$ORDER(^LR(LRDFN,LRSUB,LRIDT1,1,J))

                           IF J<1

                               QUIT 

                           Begin DoDot:2

 +6                            WRITE ?5,^(J,0)

                               IF $ORDER(^LR(LRDFN,LRSUB,LRIDT1,1,J))

                                   WRITE !

                           End DoDot:2

                   End DoDot:1

 +7        KILL LRNOTE

           SET LRNOTE=0

B1        ;W !,"WORK COPY - DO NOT FILE   ",PNM,?60,SSN S LRY=2

 +1       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +2        WRITE !,"WORK COPY - DO NOT FILE   ",PNM,?60,HRCN

           SET LRY=2

 +3       ;----- END IHS MODIFICATIONS

 +4        IF $EXTRACT(IOST,1,2)="C-"

               WRITE !?20," PRESS '^' TO STOP REPORT "

               READ X:DTIME

               IF X=""

                   SET X=1

               SET LREND=".^"[X

               IF $GET(LREND)

                   QUIT 

 +5        QUIT