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

LRLABELF.m

Go to the documentation of this file.
  1. LRLABELF ;SLC/CJS/DALISC/DRH - PRINT COLLECTION LIST (CONT.) ; 3/28/89 19:39
  1. ;;5.2;LAB SERVICE;**121,161**;Sep 27, 1994
  1. ; Called by LRLABLDS,LRLABLD0
  1. INIT ;
  1. U IO
  1. S (PAGE,LREND,CNT)=0,LRPRTDT=$$NOW^XLFDT
  1. I LRPICK=1,$E(IOST,1,2)="C-" W @IOF
  1. EN ;
  1. S LRODT=""
  1. F S LRODT=$O(^TMP($J,"LR",LRODT)) Q:LRODT=""!($G(LREND)) D
  1. . S LRCT=""
  1. . F S LRCT=$O(^TMP($J,"LR",LRODT,LRCT)) Q:LRCT=""!($G(LREND)) D
  1. . . S LRCLOC=""
  1. . . F S LRCLOC=$O(^TMP($J,"LR",LRODT,LRCT,LRCLOC)) Q:LRCLOC=""!($G(LREND)) D
  1. . . . I LRPICK=1 D HEAD
  1. . . . S LRPNM=""
  1. . . . F S LRPNM=$O(^TMP($J,"LR",LRODT,LRCT,LRCLOC,LRPNM)) Q:LRPNM=""!($G(LREND)) D PAT
  1. . I LRPICK=1 D
  1. . . S PAGE=0
  1. . . I $E(IOST,1,2)="C-" W !!
  1. . . E W @IOF
  1. Q
  1. ;
  1. Q:$G(LREND)
  1. I PAGE D
  1. . I $E(IOST,1,2)="C-" D EOP
  1. . W @IOF
  1. S PAGE=PAGE+1,LRHEAD=$$FMTE^XLFDT(LRODT)_" "_"Future Collection List"
  1. W !,$$CJ^XLFSTR(LRHEAD,IOM)
  1. S LRPAGE="Page: "_PAGE
  1. W !,"Print Date@Time : ",$$FMTE^XLFDT(LRPRTDT),?60,LRPAGE
  1. W !!,$$CJ^XLFSTR(LRCLOC,IOM,"-")
  1. W !,$$CJ^XLFSTR("WARD LOC/REQ LOC ",IOM," ")
  1. Q
  1. HDR ;
  1. D HEAD
  1. PHDR W:$G(CHDR) !?20,"< CONTINUATION >"
  1. S LRNEW=PNM
  1. W !,PNM I $L($G(LRRB))>1 W ?32,LRRB
  1. W ?42,SSN,?57,"Order #: ",LRCE
  1. W:$L($G(^LR(+LRNODE0,.091))) !?4,"Pat Info: ",^(.091)
  1. S LRPCT=$$FMTE^XLFDT(LRCT,1) S:$P(LRPCT,"@",2) LRPCT=$P(LRPCT,"@",2)_" "_$P(LRPCT,"@")
  1. W !?5,LRPCT,?25,"[ "_LRTYPE_" ]"
  1. N LRURG S NODE=LRNODE0,(S2,LRTVOL)=0
  1. D T^LRLABLD0
  1. S LRTOP=$P($G(^LAB(62,+$P(LRNODE0,U,3),0)),U,3) I $L(LRTOP) S S2=$P(^(0),U,5)
  1. W !?28,$S(S2="":" ",LRTVOL>S2:"Large ",1:"Small "),LRTOP," ",$S($G(LRTVOL):LRTVOL,1:1)," mL ",!
  1. Q
  1. ;
  1. CHDR ;
  1. W !?10,"<CONTINUE NEXT PAGE # "_PAGE+1_" >"
  1. S CHDR=1 D PHDR S CHDR=0
  1. Q
  1. ;
  1. PAT ;
  1. S LRSNN=""
  1. F S LRSNN=$O(^TMP($J,"LR",LRODT,LRCT,LRCLOC,LRPNM,LRSNN)) Q:LRSNN=""!($G(LREND)) D
  1. . W:LRPICK=1 !
  1. . K LRNEW
  1. . D PRINT
  1. Q
  1. PRINT ;
  1. S LRSN=+$P(LRSNN,"*",2)
  1. Q:'$D(^LRO(69,LRODT,1,LRSN,0))#2 S LRNODE0=^(0),LRCE=$G(^(.1)) Q:'LRCE
  1. I LRPICK=2 D SETUP^LRLABLD0 Q ; Print labels
  1. S LRDFN=+LRNODE0 K LRDPF
  1. D PT^LRX Q:$G(LREND)!(+LRDPF'=2)
  1. Q:$G(LREND)
  1. S LRTYPE="",LRPORD=1,LRTOP=$P($G(^LAB(62,+$P(LRNODE0,U,3),0)),U)
  1. S LRORD=$G(^LRO(69,LRODT,1,LRSN,.1))
  1. I $L($P(LRNODE0,U,4)) S LRTYPE=$G(LRCOLTY($P(LRNODE0,U,4))) ; Collection type
  1. I LRTYPE="" S LRTYPE="Unknown"
  1. I $Y>(IOSL-4) D HDR
  1. S LRSP=0 I '$D(LRNEW) D PHDR S LRNEW=LRPNM
  1. I LRNEW'=LRPNM D PHDR
  1. F TAB=5:35 S LRSP=$O(^LRO(69,LRODT,1,LRSN,2,LRSP)) Q:LRSP<1 D
  1. . N LRURGA
  1. . Q:'$D(^LRO(69,LRODT,1,LRSN,2,LRSP,0))
  1. . S LRTEST=^LRO(69,LRODT,1,LRSN,2,LRSP,0),LRURGN=$P(LRTEST,U,2) S:'LRURGN LRURGN=9
  1. . I $P(LRTEST,"^",11) Q ; Test cancelled
  1. . S LRURGA=$$URGA^LRLABLD(+LRURGN)
  1. . S LRTEST=$P($G(^LAB(60,+$P(LRTEST,U),0)),U)
  1. . I TAB>45 S TAB=5 W ! I $Y>(IOSL-4) D HDR
  1. . W ?TAB,$S(LRURGN<3:"** ",1:"")," (",$P(LRURGA,"^"),") ",LRTEST
  1. Q
  1. DEV ;
  1. K %ZIS S %ZIS="" D ^%ZIS Q:POP
  1. U IO D INIT W !! W:$E(IOST,1,2)'="C-" @IOF
  1. D ^%ZISC
  1. Q
  1. ;
  1. EOP ; End-of-page
  1. N DIR,DIRUT,DTOUT,DUOUT,X,Y
  1. S DIR(0)="E"
  1. D ^DIR
  1. I $D(DIRUT) S LREND=1
  1. Q
  1. ;
  1. END ;
  1. ; Called by LRLABLD0, LRLABLDS
  1. I $G(LRPICK)=1 W:$E(IOST,1,2)'="C-" @IOF
  1. I $D(ZTQUEUED) S ZTREQ="@"
  1. E D ^%ZISC
  1. D KVA^VADPT
  1. K ^TMP($J)
  1. K A,DIR,DUOUT,DTOUT,DIRUT
  1. K LRBARID,LRCOLTY,LREND,LRHEAD,LRNODE0,LRORD,LRPCT,LRUID
  1. K LRPERH,LRPERT,LRSP,LRTEST,LRTYPE,LRURGN,TAB
  1. K LRWRD,LRLOCF1,LRLOCF,LRCHLOC,LRDPF,J,S,C,%ZIS,%DT,DIC,DFN,I,L9,LRACC,LRCE,LRCLTY,LRDAT
  1. K LRPRAC,CNT,LRCLOC,LRCT,LRNEWL,LRORDN,LRPICK,LRPNM,LRSING,LRSNN,LRTREA
  1. K PAGE,D0,D1,LRPRTDT
  1. K LRDFN,LRINFW,LRLABEL,LRLLOC,LRODT,LRCT0,LRPREF,LRRB,LRSN,LRSSP
  1. K LRTJ,LRTJDATA,LRTOP,LRTS,LRTV,LRTVOL,LRURG,LRURGA,LRURG0,LN,LRSTOP,LRTIC
  1. K LRDTC,LRTXT,LRVOL,LRXL,N,NODE,S1,S2,T,Y,Y1,Y2
  1. K ZTSAVE,ZTIO,ZTRTN,ZTDESC
  1. K AGE,DOB,PNM,SEX,SSN,POP,E,VA,LRY1,VAERR,X
  1. Q