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

LRARCR4.m

Go to the documentation of this file.
  1. LRARCR4 ;DALISC/CKA - WKLD REP GENERATOR-UTILITIES ;
  1. ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
  1. ;same as LRCAPR4 except archived wkld file
  1. BLDHDR ;
  1. S LRHDRLEN=0
  1. ; ** Divisions **
  1. S LRCODSTR="S LRDUMMY=""[ ""_LRSITSEL(A)_"" ] """
  1. S LRTITLE=" Division(s) "
  1. D ADDHDR(.LRSITSEL,LRTITLE,LRCODSTR)
  1. ; ** Locations **
  1. S LRCODSTR="S LRDUMMY=""[ ""_LRLOC(A)_"" ] """
  1. S LRTITLE=" Location(s) "
  1. D ADDHDR(.LRLOC,LRTITLE,LRCODSTR)
  1. ; ** Specimens **
  1. S LRCODSTR="S LRDUMMY=""[ ""_$P($G(^LAB(61,A,0)),U)_"" ] """
  1. S LRTITLE=" Specimen(s) "
  1. D ADDHDR(.LRSP,LRTITLE,LRCODSTR)
  1. ; ** Collection Samples **
  1. S LRCODSTR="S LRDUMMY=""[ ""_$P($G(^LAB(62,A,0)),U)_"" ] """
  1. S LRTITLE=" Collection sample(s) "
  1. D ADDHDR(.LRCOL,LRTITLE,LRCODSTR)
  1. ; ** Tests **
  1. S LRCODSTR="S LRDUMMY=""[ ""_$$TST^LRCAPR2(LRTSTS(A))_"" ] """
  1. S LRTITLE=" Test(s) "
  1. D ADDHDR(.LRTSTS,LRTITLE,LRCODSTR)
  1. ; ** Wkld Codes **
  1. S LRCODSTR="S LRDUMMY=""[ ""_LRCAPS(A)_"" ] """
  1. S LRTITLE=" Workload code(s) "
  1. D ADDHDR(.LRCAPS,LRTITLE,LRCODSTR)
  1. ; ** Instruments **
  1. S LRCODSTR="S LRDUMMY=""[ ""_$P($G(^LAB(64.2,LRCPSX(A),0)),U)_"" ] """
  1. S LRTITLE=" Instrument(s) "
  1. D ADDHDR(.LRCPSX,LRTITLE,LRCODSTR)
  1. ; ** Patient type **
  1. S LRHDRLEN=LRHDRLEN+1
  1. S LRHDR(LRHDRLEN)=" Patients "
  1. I LRIOPAT["A" S LRHDR(LRHDRLEN)=LRHDR(LRHDRLEN)_"[ ALL PATIENTS ] "
  1. E D
  1. . F I=1:1:$L(LRIOPAT) D
  1. . . S LRPTYP=$E(LRIOPAT,I)
  1. . . S LRHDR(LRHDRLEN)=LRHDR(LRHDRLEN)_$S(LRPTYP="I":"[ INPATIENTS ] ",LRPTYP="O":"[ OUTPATIENTS ] ",LRPTYP="R":"[ OTHER PATIENTS ] ",1:"[ UNKNOWN PATIENTS ] ")
  1. ; ** STAT only? **
  1. I $G(LRSTAT) D
  1. . S LRHDRLEN=LRHDRLEN+1
  1. . S LRHDR(LRHDRLEN)=" STAT tests only"
  1. ;
  1. S LRHDRFIT=$S(LRHDRLEN<12:1,1:0)
  1. Q
  1. ADDHDR(LRARY,LRTITLE,LRCODSTR) ;
  1. N A,LRDUMMY,I
  1. I $O(LRARY(0)) D
  1. . S LRHDRLEN=LRHDRLEN+1,LRHDR(LRHDRLEN)=LRTITLE
  1. . S A=""
  1. . F I=0:0 S A=$O(LRARY(A)) Q:A="" D
  1. . . X LRCODSTR
  1. . . I ($L(LRHDR(LRHDRLEN))+$L(LRDUMMY))>80 D
  1. . . . S LRHDRLEN=LRHDRLEN+1
  1. . . . S $P(LRHDR(LRHDRLEN)," ",$L(LRTITLE))=" "
  1. . . S LRHDR(LRHDRLEN)=LRHDR(LRHDRLEN)_LRDUMMY
  1. Q
  1. REPHDR ;
  1. W !!!!!!,$E(LRSTR,1,30)_$S(LRANS="D":" D E T A I L E D *",1:" C-O-N-D-E-N-S-E-D ")_$E(LRSTR,1,31)
  1. W !,LRSITE_"("_LRSITNUM_")",?33,"Workload Report"
  1. W ?53,LRDT,?80-(6+$L(LRPG)),"page ",LRPG
  1. W !,"ACCN AREA: ",LRX,?79-$L(LRDTH),LRDTH S LRPG=LRPG+1
  1. D HDR2
  1. W !,LRDSH
  1. D PAUSE Q:LREND
  1. W @IOF
  1. Q
  1. HDR ;
  1. W !!!,$E(LRSTR,1,31)_" D E T A I L E D "_$E(LRSTR,1,32)
  1. W !,LRSITE_"("_LRSITNUM_")",?29,"Archived Workload Report"
  1. W ?53,LRDT,?80-(6+$L(LRPG)),"Page ",LRPG
  1. W !,"ACCN AREA: ",LRX,?79-$L(LRDTH),LRDTH S LRPG=LRPG+1
  1. I LRHDRFIT D HDR2
  1. W !,LRDSH
  1. W !,"Lab Test "_$S(LRCONT:" **cont.**",1:"")
  1. W ?33,"Instrument",?59,"Location",!
  1. Q
  1. SUBH ;
  1. W !,LRTST,?33,LRCODE,?59,LRLC," = ",LRCPT
  1. W !,?3,"Accession # ",?36,"Date verified",?59,"WKLD CODE: ",LRCAP
  1. Q
  1. UP ;
  1. S LRCONT=$S(J'=LRCPT:1,1:0)
  1. W ?64,$S(LRCONT:"***continued***",1:"")
  1. D PAUSE Q:LREND
  1. Q
  1. UP1 ;
  1. D PAUSE Q:LREND
  1. W @IOF D HDR1 W !,"cont."
  1. W !?((80-$L(LRSUBH1))\2),LRSUBH1
  1. W !?((80-$L(LRSUBH1))\2),$E(LRDSH,1,$L(LRSUBH1))
  1. Q
  1. HDR1 ;
  1. W !!!,$E(LRSTR,1,30)_$S(LRANS="D":" D E T A I L E D *",1:" C-O-N-D-E-N-S-E-D ")_$E(LRSTR,1,31)
  1. W !,LRSITE_"("_LRSITNUM_")",?29," Archived Workload Report"
  1. W ?53,LRDT,?80-(6+$L(LRPG)),"page ",LRPG
  1. W !,"ACCN AREA: ",LRX,?79-$L(LRDTH),LRDTH S LRPG=LRPG+1
  1. I LRHDRFIT D HDR2
  1. W !,LRDSH
  1. Q
  1. HDR2 ;
  1. Q:'LRHDRLEN N A
  1. F A=1:1:LRHDRLEN W !,LRHDR(A)
  1. Q
  1. PAUSE ;
  1. Q:$E(IOST,1,2)'="C-"
  1. K DIR S DIR(0)="E" D ^DIR
  1. S:($D(DTOUT)#2)!($D(DUOUT)#2) LREND=1
  1. Q
  1. CLEAN ;
  1. D:'LREND PAUSE
  1. W @IOF D:'$D(ZTQUEUED) ^%ZISC
  1. K ^TMP("LRAR",$J)
  1. K %,%DT,%ZIS,DIC,DIR,DTOUT,DUOUT,DIRUT,DIROUT,I,J,K,X,Y,POP,DX,DY
  1. K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,LRCODSTR,LRPTYP,LRPATOK,LRCONT,LRACCREC
  1. K LRAA,LRAANO,LRANS,LRCAP,LRCAPS,LRCNT,LRCODE,LRCOL,LREND,LRMACN,LRTITLE
  1. K LRCPSX,LRCPT,LRDA,LRDAT,LRDATD,LRDATX,LRDOT,LRDSH,LRDT,LRDTH,LRFL,LRTO
  1. K LRFLG,LRFR,LRFRD,LRFRV,LRINST,LRLC,LRLMAC,LRLOC,LRMAC,LRTOD,LRCP,LRFIL
  1. K LRNT,LRNX,LRNX5,LRNX5D,LRPG,LRSITE,LRSITNUM,LRSITSEL,LRSP,LRST,LRSTCS
  1. K LRSTR,LRSTY,LRSUM,LRTEST,LRTESTCP,LRTMTOT,LRNODE,LRMCT,LRSTAT,LRCNTL
  1. K LRTSTS,LRTYCSP,LRVD,LRVERD,LRX,LRSUBH,LRSUBH1,LRHDR,LRHDRFIT,LRHDRLEN
  1. K LRIOPAT,LRLTYP,LRTST,LRURG,LRURGCNT,LRURGNAM,LRTOV,LRCTL,LRCPN,LRRTYP
  1. D WKLDCLN^LRARCU
  1. Q