- 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 Jan 18, 2025@03:10:05 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