LRARCR4 ;DALISC/CKA - WKLD REP GENERATOR-UTILITIES ;
;;5.2;LAB SERVICE;**59**;Aug 31, 1995
;same as LRCAPR4 except archived wkld file
BLDHDR ;
S LRHDRLEN=0
; ** Divisions **
S LRCODSTR="S LRDUMMY=""[ ""_LRSITSEL(A)_"" ] """
S LRTITLE=" Division(s) "
D ADDHDR(.LRSITSEL,LRTITLE,LRCODSTR)
; ** Locations **
S LRCODSTR="S LRDUMMY=""[ ""_LRLOC(A)_"" ] """
S LRTITLE=" Location(s) "
D ADDHDR(.LRLOC,LRTITLE,LRCODSTR)
; ** Specimens **
S LRCODSTR="S LRDUMMY=""[ ""_$P($G(^LAB(61,A,0)),U)_"" ] """
S LRTITLE=" Specimen(s) "
D ADDHDR(.LRSP,LRTITLE,LRCODSTR)
; ** Collection Samples **
S LRCODSTR="S LRDUMMY=""[ ""_$P($G(^LAB(62,A,0)),U)_"" ] """
S LRTITLE=" Collection sample(s) "
D ADDHDR(.LRCOL,LRTITLE,LRCODSTR)
; ** Tests **
S LRCODSTR="S LRDUMMY=""[ ""_$$TST^LRCAPR2(LRTSTS(A))_"" ] """
S LRTITLE=" Test(s) "
D ADDHDR(.LRTSTS,LRTITLE,LRCODSTR)
; ** Wkld Codes **
S LRCODSTR="S LRDUMMY=""[ ""_LRCAPS(A)_"" ] """
S LRTITLE=" Workload code(s) "
D ADDHDR(.LRCAPS,LRTITLE,LRCODSTR)
; ** Instruments **
S LRCODSTR="S LRDUMMY=""[ ""_$P($G(^LAB(64.2,LRCPSX(A),0)),U)_"" ] """
S LRTITLE=" Instrument(s) "
D ADDHDR(.LRCPSX,LRTITLE,LRCODSTR)
; ** Patient type **
S LRHDRLEN=LRHDRLEN+1
S LRHDR(LRHDRLEN)=" Patients "
I LRIOPAT["A" S LRHDR(LRHDRLEN)=LRHDR(LRHDRLEN)_"[ ALL PATIENTS ] "
E D
. F I=1:1:$L(LRIOPAT) D
. . S LRPTYP=$E(LRIOPAT,I)
. . S LRHDR(LRHDRLEN)=LRHDR(LRHDRLEN)_$S(LRPTYP="I":"[ INPATIENTS ] ",LRPTYP="O":"[ OUTPATIENTS ] ",LRPTYP="R":"[ OTHER PATIENTS ] ",1:"[ UNKNOWN PATIENTS ] ")
; ** STAT only? **
I $G(LRSTAT) D
. S LRHDRLEN=LRHDRLEN+1
. S LRHDR(LRHDRLEN)=" STAT tests only"
;
S LRHDRFIT=$S(LRHDRLEN<12:1,1:0)
Q
ADDHDR(LRARY,LRTITLE,LRCODSTR) ;
N A,LRDUMMY,I
I $O(LRARY(0)) D
. S LRHDRLEN=LRHDRLEN+1,LRHDR(LRHDRLEN)=LRTITLE
. S A=""
. F I=0:0 S A=$O(LRARY(A)) Q:A="" D
. . X LRCODSTR
. . I ($L(LRHDR(LRHDRLEN))+$L(LRDUMMY))>80 D
. . . S LRHDRLEN=LRHDRLEN+1
. . . S $P(LRHDR(LRHDRLEN)," ",$L(LRTITLE))=" "
. . S LRHDR(LRHDRLEN)=LRHDR(LRHDRLEN)_LRDUMMY
Q
REPHDR ;
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)
W !,LRSITE_"("_LRSITNUM_")",?33,"Workload Report"
W ?53,LRDT,?80-(6+$L(LRPG)),"page ",LRPG
W !,"ACCN AREA: ",LRX,?79-$L(LRDTH),LRDTH S LRPG=LRPG+1
D HDR2
W !,LRDSH
D PAUSE Q:LREND
W @IOF
Q
HDR ;
W !!!,$E(LRSTR,1,31)_" D E T A I L E D "_$E(LRSTR,1,32)
W !,LRSITE_"("_LRSITNUM_")",?29,"Archived Workload Report"
W ?53,LRDT,?80-(6+$L(LRPG)),"Page ",LRPG
W !,"ACCN AREA: ",LRX,?79-$L(LRDTH),LRDTH S LRPG=LRPG+1
I LRHDRFIT D HDR2
W !,LRDSH
W !,"Lab Test "_$S(LRCONT:" **cont.**",1:"")
W ?33,"Instrument",?59,"Location",!
Q
SUBH ;
W !,LRTST,?33,LRCODE,?59,LRLC," = ",LRCPT
W !,?3,"Accession # ",?36,"Date verified",?59,"WKLD CODE: ",LRCAP
Q
UP ;
S LRCONT=$S(J'=LRCPT:1,1:0)
W ?64,$S(LRCONT:"***continued***",1:"")
D PAUSE Q:LREND
Q
UP1 ;
D PAUSE Q:LREND
W @IOF D HDR1 W !,"cont."
W !?((80-$L(LRSUBH1))\2),LRSUBH1
W !?((80-$L(LRSUBH1))\2),$E(LRDSH,1,$L(LRSUBH1))
Q
HDR1 ;
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)
W !,LRSITE_"("_LRSITNUM_")",?29," Archived Workload Report"
W ?53,LRDT,?80-(6+$L(LRPG)),"page ",LRPG
W !,"ACCN AREA: ",LRX,?79-$L(LRDTH),LRDTH S LRPG=LRPG+1
I LRHDRFIT D HDR2
W !,LRDSH
Q
HDR2 ;
Q:'LRHDRLEN N A
F A=1:1:LRHDRLEN W !,LRHDR(A)
Q
PAUSE ;
Q:$E(IOST,1,2)'="C-"
K DIR S DIR(0)="E" D ^DIR
S:($D(DTOUT)#2)!($D(DUOUT)#2) LREND=1
Q
CLEAN ;
D:'LREND PAUSE
W @IOF D:'$D(ZTQUEUED) ^%ZISC
K ^TMP("LRAR",$J)
K %,%DT,%ZIS,DIC,DIR,DTOUT,DUOUT,DIRUT,DIROUT,I,J,K,X,Y,POP,DX,DY
K ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,LRCODSTR,LRPTYP,LRPATOK,LRCONT,LRACCREC
K LRAA,LRAANO,LRANS,LRCAP,LRCAPS,LRCNT,LRCODE,LRCOL,LREND,LRMACN,LRTITLE
K LRCPSX,LRCPT,LRDA,LRDAT,LRDATD,LRDATX,LRDOT,LRDSH,LRDT,LRDTH,LRFL,LRTO
K LRFLG,LRFR,LRFRD,LRFRV,LRINST,LRLC,LRLMAC,LRLOC,LRMAC,LRTOD,LRCP,LRFIL
K LRNT,LRNX,LRNX5,LRNX5D,LRPG,LRSITE,LRSITNUM,LRSITSEL,LRSP,LRST,LRSTCS
K LRSTR,LRSTY,LRSUM,LRTEST,LRTESTCP,LRTMTOT,LRNODE,LRMCT,LRSTAT,LRCNTL
K LRTSTS,LRTYCSP,LRVD,LRVERD,LRX,LRSUBH,LRSUBH1,LRHDR,LRHDRFIT,LRHDRLEN
K LRIOPAT,LRLTYP,LRTST,LRURG,LRURGCNT,LRURGNAM,LRTOV,LRCTL,LRCPN,LRRTYP
D WKLDCLN^LRARCU
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARCR4 4452 printed Apr 09, 2024@21:24:27 Page 2
LRARCR4 ;DALISC/CKA - WKLD REP GENERATOR-UTILITIES ;
+1 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
+2 ;same as LRCAPR4 except archived wkld file
BLDHDR ;
+1 SET LRHDRLEN=0
+2 ; ** Divisions **
+3 SET LRCODSTR="S LRDUMMY=""[ ""_LRSITSEL(A)_"" ] """
+4 SET LRTITLE=" Division(s) "
+5 DO ADDHDR(.LRSITSEL,LRTITLE,LRCODSTR)
+6 ; ** Locations **
+7 SET LRCODSTR="S LRDUMMY=""[ ""_LRLOC(A)_"" ] """
+8 SET LRTITLE=" Location(s) "
+9 DO ADDHDR(.LRLOC,LRTITLE,LRCODSTR)
+10 ; ** Specimens **
+11 SET LRCODSTR="S LRDUMMY=""[ ""_$P($G(^LAB(61,A,0)),U)_"" ] """
+12 SET LRTITLE=" Specimen(s) "
+13 DO ADDHDR(.LRSP,LRTITLE,LRCODSTR)
+14 ; ** Collection Samples **
+15 SET LRCODSTR="S LRDUMMY=""[ ""_$P($G(^LAB(62,A,0)),U)_"" ] """
+16 SET LRTITLE=" Collection sample(s) "
+17 DO ADDHDR(.LRCOL,LRTITLE,LRCODSTR)
+18 ; ** Tests **
+19 SET LRCODSTR="S LRDUMMY=""[ ""_$$TST^LRCAPR2(LRTSTS(A))_"" ] """
+20 SET LRTITLE=" Test(s) "
+21 DO ADDHDR(.LRTSTS,LRTITLE,LRCODSTR)
+22 ; ** Wkld Codes **
+23 SET LRCODSTR="S LRDUMMY=""[ ""_LRCAPS(A)_"" ] """
+24 SET LRTITLE=" Workload code(s) "
+25 DO ADDHDR(.LRCAPS,LRTITLE,LRCODSTR)
+26 ; ** Instruments **
+27 SET LRCODSTR="S LRDUMMY=""[ ""_$P($G(^LAB(64.2,LRCPSX(A),0)),U)_"" ] """
+28 SET LRTITLE=" Instrument(s) "
+29 DO ADDHDR(.LRCPSX,LRTITLE,LRCODSTR)
+30 ; ** Patient type **
+31 SET LRHDRLEN=LRHDRLEN+1
+32 SET LRHDR(LRHDRLEN)=" Patients "
+33 IF LRIOPAT["A"
SET LRHDR(LRHDRLEN)=LRHDR(LRHDRLEN)_"[ ALL PATIENTS ] "
+34 IF '$TEST
Begin DoDot:1
+35 FOR I=1:1:$LENGTH(LRIOPAT)
Begin DoDot:2
+36 SET LRPTYP=$EXTRACT(LRIOPAT,I)
+37 SET LRHDR(LRHDRLEN)=LRHDR(LRHDRLEN)_$SELECT(LRPTYP="I":"[ INPATIENTS ] ",LRPTYP="O":"[ OUTPATIENTS ] ",LRPTYP="R":"[ OTHER PATIENTS ] ",1:"[ UNKNOWN PATIENTS ] ")
End DoDot:2
End DoDot:1
+38 ; ** STAT only? **
+39 IF $GET(LRSTAT)
Begin DoDot:1
+40 SET LRHDRLEN=LRHDRLEN+1
+41 SET LRHDR(LRHDRLEN)=" STAT tests only"
End DoDot:1
+42 ;
+43 SET LRHDRFIT=$SELECT(LRHDRLEN<12:1,1:0)
+44 QUIT
ADDHDR(LRARY,LRTITLE,LRCODSTR) ;
+1 NEW A,LRDUMMY,I
+2 IF $ORDER(LRARY(0))
Begin DoDot:1
+3 SET LRHDRLEN=LRHDRLEN+1
SET LRHDR(LRHDRLEN)=LRTITLE
+4 SET A=""
+5 FOR I=0:0
SET A=$ORDER(LRARY(A))
if A=""
QUIT
Begin DoDot:2
+6 XECUTE LRCODSTR
+7 IF ($LENGTH(LRHDR(LRHDRLEN))+$LENGTH(LRDUMMY))>80
Begin DoDot:3
+8 SET LRHDRLEN=LRHDRLEN+1
+9 SET $PIECE(LRHDR(LRHDRLEN)," ",$LENGTH(LRTITLE))=" "
End DoDot:3
+10 SET LRHDR(LRHDRLEN)=LRHDR(LRHDRLEN)_LRDUMMY
End DoDot:2
End DoDot:1
+11 QUIT
REPHDR ;
+1 WRITE !!!!!!,$EXTRACT(LRSTR,1,30)_$SELECT(LRANS="D":" D E T A I L E D *",1:" C-O-N-D-E-N-S-E-D ")_$EXTRACT(LRSTR,1,31)
+2 WRITE !,LRSITE_"("_LRSITNUM_")",?33,"Workload Report"
+3 WRITE ?53,LRDT,?80-(6+$LENGTH(LRPG)),"page ",LRPG
+4 WRITE !,"ACCN AREA: ",LRX,?79-$LENGTH(LRDTH),LRDTH
SET LRPG=LRPG+1
+5 DO HDR2
+6 WRITE !,LRDSH
+7 DO PAUSE
if LREND
QUIT
+8 WRITE @IOF
+9 QUIT
HDR ;
+1 WRITE !!!,$EXTRACT(LRSTR,1,31)_" D E T A I L E D "_$EXTRACT(LRSTR,1,32)
+2 WRITE !,LRSITE_"("_LRSITNUM_")",?29,"Archived Workload Report"
+3 WRITE ?53,LRDT,?80-(6+$LENGTH(LRPG)),"Page ",LRPG
+4 WRITE !,"ACCN AREA: ",LRX,?79-$LENGTH(LRDTH),LRDTH
SET LRPG=LRPG+1
+5 IF LRHDRFIT
DO HDR2
+6 WRITE !,LRDSH
+7 WRITE !,"Lab Test "_$SELECT(LRCONT:" **cont.**",1:"")
+8 WRITE ?33,"Instrument",?59,"Location",!
+9 QUIT
SUBH ;
+1 WRITE !,LRTST,?33,LRCODE,?59,LRLC," = ",LRCPT
+2 WRITE !,?3,"Accession # ",?36,"Date verified",?59,"WKLD CODE: ",LRCAP
+3 QUIT
UP ;
+1 SET LRCONT=$SELECT(J'=LRCPT:1,1:0)
+2 WRITE ?64,$SELECT(LRCONT:"***continued***",1:"")
+3 DO PAUSE
if LREND
QUIT
+4 QUIT
UP1 ;
+1 DO PAUSE
if LREND
QUIT
+2 WRITE @IOF
DO HDR1
WRITE !,"cont."
+3 WRITE !?((80-$LENGTH(LRSUBH1))\2),LRSUBH1
+4 WRITE !?((80-$LENGTH(LRSUBH1))\2),$EXTRACT(LRDSH,1,$LENGTH(LRSUBH1))
+5 QUIT
HDR1 ;
+1 WRITE !!!,$EXTRACT(LRSTR,1,30)_$SELECT(LRANS="D":" D E T A I L E D *",1:" C-O-N-D-E-N-S-E-D ")_$EXTRACT(LRSTR,1,31)
+2 WRITE !,LRSITE_"("_LRSITNUM_")",?29," Archived Workload Report"
+3 WRITE ?53,LRDT,?80-(6+$LENGTH(LRPG)),"page ",LRPG
+4 WRITE !,"ACCN AREA: ",LRX,?79-$LENGTH(LRDTH),LRDTH
SET LRPG=LRPG+1
+5 IF LRHDRFIT
DO HDR2
+6 WRITE !,LRDSH
+7 QUIT
HDR2 ;
+1 if 'LRHDRLEN
QUIT
NEW A
+2 FOR A=1:1:LRHDRLEN
WRITE !,LRHDR(A)
+3 QUIT
PAUSE ;
+1 if $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 KILL DIR
SET DIR(0)="E"
DO ^DIR
+3 if ($DATA(DTOUT)#2)!($DATA(DUOUT)#2)
SET LREND=1
+4 QUIT
CLEAN ;
+1 if 'LREND
DO PAUSE
+2 WRITE @IOF
if '$DATA(ZTQUEUED)
DO ^%ZISC
+3 KILL ^TMP("LRAR",$JOB)
+4 KILL %,%DT,%ZIS,DIC,DIR,DTOUT,DUOUT,DIRUT,DIROUT,I,J,K,X,Y,POP,DX,DY
+5 KILL ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,LRCODSTR,LRPTYP,LRPATOK,LRCONT,LRACCREC
+6 KILL LRAA,LRAANO,LRANS,LRCAP,LRCAPS,LRCNT,LRCODE,LRCOL,LREND,LRMACN,LRTITLE
+7 KILL LRCPSX,LRCPT,LRDA,LRDAT,LRDATD,LRDATX,LRDOT,LRDSH,LRDT,LRDTH,LRFL,LRTO
+8 KILL LRFLG,LRFR,LRFRD,LRFRV,LRINST,LRLC,LRLMAC,LRLOC,LRMAC,LRTOD,LRCP,LRFIL
+9 KILL LRNT,LRNX,LRNX5,LRNX5D,LRPG,LRSITE,LRSITNUM,LRSITSEL,LRSP,LRST,LRSTCS
+10 KILL LRSTR,LRSTY,LRSUM,LRTEST,LRTESTCP,LRTMTOT,LRNODE,LRMCT,LRSTAT,LRCNTL
+11 KILL LRTSTS,LRTYCSP,LRVD,LRVERD,LRX,LRSUBH,LRSUBH1,LRHDR,LRHDRFIT,LRHDRLEN
+12 KILL LRIOPAT,LRLTYP,LRTST,LRURG,LRURGCNT,LRURGNAM,LRTOV,LRCTL,LRCPN,LRRTYP
+13 DO WKLDCLN^LRARCU
+14 QUIT
