| 1 | LRCAPAM3 ;SLC/FHS - LAB PHASE 3 LMIP DATA COLLECTION PRINT REPORT ;8/23/91 1039;
|
---|
| 2 | ;;5.2;LAB SERVICE;**42,119,201**;Sep 27, 1994
|
---|
| 3 | EN ;
|
---|
| 4 | S LINE="This is Phase 3 of LMIP Data Collection" W !?(IOM-$L(LINE))\2,LINE,!
|
---|
| 5 | S LINE="This option will provide a print out" W !?(IOM-$L(LINE))\2,LINE,!
|
---|
| 6 | S LINE="of CONDENSED data that will be loaded into the actual" W !?(IOM-$L(LINE))\2,LINE,!
|
---|
| 7 | S LINE="LMIP Mail message. Review these figures for completeness" W !?(IOM-$L(LINE))\2,LINE,!
|
---|
| 8 | S LINE="and accuracy." W !?(IOM-$L(LINE))\2,LINE,!
|
---|
| 9 | K ^TMP($J),ZTSK,%DT
|
---|
| 10 | ASK1 ;
|
---|
| 11 | K CNT S CNT=0 S I=0 F S I=$O(^LAH("LABWL",I)) Q:I<1 S LN=^(I) I $E(LN)="$" D
|
---|
| 12 | .S LRDATE=$P(LN,"$$$",2) W !?5,"Division ",$P($P(LN,U,3),"$$$")," has data for ",$$FMTE^XLFDT(LRDATE,"1D") S CNT=CNT+1,CNT(LRDATE)=""
|
---|
| 13 | I 'CNT W !!?10,"I do not have any data in the file ",!! G EXIT
|
---|
| 14 | DT W ! K DIR S DIR(0)="D^::AEP",DIR("A")="Enter Month and Year for start of report: "
|
---|
| 15 | S DIR("?")="You must enter a Valid Month and Year [ .ie 10-93 ]"
|
---|
| 16 | S DIR("?",1)="Select from the list displayed above."
|
---|
| 17 | D ^DIR
|
---|
| 18 | G:$D(DUOUT)!($D(DTOUT))!(Y<0) EXIT
|
---|
| 19 | S LRDT1=$E(Y,1,5)_"00" I '$D(CNT(LRDT1)) W !!?10,"I do not have data for this ",$$FMTE^XLFDT(LRDT1,"1D"),!!,$C(7) G ASK1
|
---|
| 20 | ASK2 ;
|
---|
| 21 | W ! K DIR("?") S DIR("?")="Month and Year you wish to end with "
|
---|
| 22 | S DIR("A")="Ending Report Date: ",DIR("B")=$$FMTE^XLFDT(LRDT1,"1D")
|
---|
| 23 | D ^DIR G:$D(DUOUT)!($D(DTOUT))!(Y<0) EXIT
|
---|
| 24 | S LRDT2=$E(Y,1,5)_"00"
|
---|
| 25 | W !! S %ZIS="Q" D ^%ZIS G:POP!($D(DUOUT))!($D(DTOUT)) EXIT
|
---|
| 26 | I $D(IO("Q")) G QUEUE
|
---|
| 27 | U IO
|
---|
| 28 | DQ ;
|
---|
| 29 | W:$E(IOST)="C" @IOF,!
|
---|
| 30 | S LRPRDT=$TR($$FMTE^XLFDT($$NOW^XLFDT,"1M"),"@"," "),LRPAGE=0
|
---|
| 31 | S LRHDT=$$FMTE^XLFDT(LRDT1,"1D")_" TO "_$$FMTE^XLFDT(LRDT2,"1D") D LOOP
|
---|
| 32 | W ! W:$E(IOST,1,2)="P-" @IOF
|
---|
| 33 | EXIT ;
|
---|
| 34 | D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 35 | K DIR,%DT,%ZIS,CNT,I,LINE,LRCCD,LRCCDN,LRCCDN0,LRCCDNX,LRDT,LRDT1,LRDT2
|
---|
| 36 | K LRDV1,LRDV2,LRHDT,LRLN,LRPAGE,LRPRDT,LRQUIT,LRTXT,NUM,TCNT,Y,ZTSK
|
---|
| 37 | K IFN,LN,LRCHK,LRDATE,LRX,LRDV1X,LRDV2X
|
---|
| 38 | K ^TMP($J)
|
---|
| 39 | Q
|
---|
| 40 | QUEUE ;
|
---|
| 41 | S ZTRTN="DQ^LRCAPAM3",ZTSAVE("LR*")="",ZTDESC="Lab Austin Workload Report",ZTIO=ION
|
---|
| 42 | D ^%ZTLOAD
|
---|
| 43 | W !! G EXIT
|
---|
| 44 | Q
|
---|
| 45 | LOOP ;
|
---|
| 46 | S (LRLN,LRDV1,LRCHK,LRDV2,LRDV1X,LRDV2X)=0
|
---|
| 47 | F S LRLN=$O(^LAH("LABWL",LRLN)) Q:'LRLN S LRTXT=^(LRLN) D
|
---|
| 48 | .I $E(LRTXT)="$" S LRDV1=$P($P(LRTXT,"$",2),U),LRDV2=$P($P(LRTXT,"$$",2),U),LRDT=+$P(LRTXT,"$$$",2)
|
---|
| 49 | .I 'LRDV1!'LRDV2 Q
|
---|
| 50 | .S LRDV1X=$O(^DIC(4,"D",LRDV1,0)),LRDV2X=$O(^DIC(4,"D",LRDV2,0))
|
---|
| 51 | .Q:'LRDV1X!('LRDV2X)
|
---|
| 52 | .I '(LRDT<(LRDT1-.00001)),'(LRDT>(LRDT2+99))
|
---|
| 53 | .E Q
|
---|
| 54 | .I $E(LRTXT)="$" D Q
|
---|
| 55 | ..S IFN=+$O(^LRO(67.9,LRDV1X,1,LRDV2X,1,"B",LRDT,0)) I $D(^LRO(67.9,LRDV1X,1,LRDV2X,1,IFN,0)) S $P(^(0),U,2)=DUZ,LRCHK=1 Q
|
---|
| 56 | ..I '$G(LRCHK) W !?5,"Unable to enter User into 'CERTIFIED BY' field in file #67.9",!?10,"Div: [ ",LRDV2," ]for the month of ",$$FMTE^XLFDT(LRDT),! Q
|
---|
| 57 | .I $E(LRTXT)="\" S ^TMP($J,LRDV1,LRDV2,LRCCD,0)=$P(LRTXT,"\",2) Q
|
---|
| 58 | .I $E(LRTXT)="*" S LRCCDN=$P(LRTXT,"*",2),LRCCD=$P(LRCCDN,U) D
|
---|
| 59 | ..S LRCCD=$E(LRCCD,13,15)_$E(LRCCD,1,12)
|
---|
| 60 | ..I '$D(^TMP($J,LRDV1,LRDV2,LRCCD))#2 S ^(LRCCD)="",^(LRCCD,"TOT WRK")=0
|
---|
| 61 | ..S CNT=0,LRCCDNX=$G(^TMP($J,LRDV1,LRDV2,LRCCD)) F I=2:1:11 D
|
---|
| 62 | ...S NUM=$P(LRCCDN,U,I) I NUM S $P(LRCCDNX,U,I)=$P(LRCCDNX,U,I)+NUM I I'=6,I'=7,I'=9 S CNT=CNT+NUM
|
---|
| 63 | ..S ^TMP($J,LRDV1,LRDV2,LRCCD)=LRCCDNX I $D(^(LRCCD,"TOT WRK")),$G(CNT) S ^("TOT WRK")=^("TOT WRK")+CNT
|
---|
| 64 | S LRDV1=$O(^TMP($J,0)) I 'LRDV1 W !!?5,"Nothing to Report",!! Q
|
---|
| 65 | S LRDV1="" F Q:$G(LRQUIT) S LRDV1=$O(^TMP($J,LRDV1)) Q:'LRDV1 D
|
---|
| 66 | . S LRDV1X=$O(^DIC(4,"D",LRDV1,0)) Q:'LRDV1X
|
---|
| 67 | . D LOOP2
|
---|
| 68 | W !!
|
---|
| 69 | Q
|
---|
| 70 | LOOP2 ;
|
---|
| 71 | S (TCNT,LRDV2)="" F Q:$G(LRQUIT) S LRDV2=$O(^TMP($J,LRDV1,LRDV2)) Q:'LRDV2 D
|
---|
| 72 | .S LRDV2X=$O(^DIC(4,"D",LRDV2,0))
|
---|
| 73 | .I 'LRDV1X!('LRDV2X) S LRQUIT=1 Q
|
---|
| 74 | .D HEADER Q:$G(LRQUIT)
|
---|
| 75 | .W !?10,"************** Division: ",$P($G(^DIC(4,LRDV2X,0)),U)," **************"
|
---|
| 76 | .S LRCCD=0 F Q:$G(LRQUIT) S LRCCD=$O(^TMP($J,LRDV1,LRDV2,LRCCD)) Q:LRCCD="" S LRCCDN=^(LRCCD),LRCCDN0=$G(^(LRCCD,0)) D
|
---|
| 77 | ..Q:$G(LRQUIT) I ($Y>(IOSL-5)) D HEADER Q:$G(LRQUIT)
|
---|
| 78 | ..W !!,?5,LRCCDN0,!?10,$E(LRCCD,1,3)," WKLD Code: ",$S($E(LRCCD,4):$E(LRCCD,4,14),1:$E(LRCCD,5,14)) W:$E(LRCCD,15) $E(LRCCD,15) W !
|
---|
| 79 | ..F I=2:1:11 I $P(LRCCDN,U,I) D
|
---|
| 80 | ...W $S(I=2:"[IN PAT]",I=3:"[OUT PAT]",I=4:"[OTH PAT]",I=5:"[QC]",I=6:"[IN ST*]",I=7:"[T ST*]",I=9:"[SO*]",I=10:"[REP]",I=11:"[OTH]",1:"[MAN]"),"=",$P(LRCCDN,U,I)," " W:$X>(IOM-10) !
|
---|
| 81 | ..W !,?60,"Total: ",$J(^TMP($J,LRDV1,LRDV2,LRCCD,"TOT WRK"),7,0) S TCNT=TCNT+^("TOT WRK")
|
---|
| 82 | .W:'$G(LRQUIT) !!,"Total On-Site Tests for "_$$FMTE^XLFDT(LRDT1,"1D")_" TO "_$$FMTE^XLFDT(LRDT2,"1D")_" = [",TCNT,"]",!
|
---|
| 83 | .W:'$G(LRQUIT) !?20,"[ XX *] NOT included in Total",!!
|
---|
| 84 | .W !! W:$E(IOST,1,2)="P-" @IOF
|
---|
| 85 | Q
|
---|
| 86 | HEADER ;
|
---|
| 87 | I LRPAGE,'$D(ZTQUEUED),$E(IOST,1,2)="C-" W !!,"Press <Enter> to continue or '^' to stop. " R LRX:DTIME S:'$T!($E(LRX)="^") LRQUIT=1 Q:$G(LRQUIT)
|
---|
| 88 | W:$G(LRPAGE) @IOF S LRPAGE=LRPAGE+1 W !,"Lab WORKLOAD data Report for Div/Institution: ",$P($G(^DIC(4,LRDV2X,0)),U)_" / "_$P($G(^DIC(4,LRDV1X,0)),U),?(IOM-10)," Page: ",LRPAGE
|
---|
| 89 | W !?(IOM-$L(LRHDT))/2,LRHDT
|
---|
| 90 | W !," Printed: ",LRPRDT,!
|
---|
| 91 | W ?5,"[ XX* data ] NOT included in total ",!
|
---|
| 92 | Q
|
---|