[613] | 1 | LRCAPD2 ;DALISC/FHS - WORKLOAD CODE LIST REPORT ; 12/3/1997
|
---|
| 2 | ;;5.2;LAB SERVICE;**153,201,351**;Sep 27, 1994
|
---|
| 3 | EN ;
|
---|
| 4 | W !!?5,"Produce a list of WKLD Code by Lab Section"
|
---|
| 5 | K DIR,ZTSAVE,DX
|
---|
| 6 | S DIR(0)="S^0:All;1:Billable Only",DIR("A")="Select WKLD CODE type to Print ",DIR("B")="Billable" D RDIR G:$G(LREND) CLEAN
|
---|
| 7 | S LRBIL=Y,ZTSAVE("LRBIL")=""
|
---|
| 8 | S DIR(0)="S^1:WORKLOAD LAB SECTION;2:LOCAL ACC AREA"
|
---|
| 9 | S DIR("A")="Sort WKLD CODES By " D RDIR G:$G(LREND) CLEAN
|
---|
| 10 | S LRSEC=Y,ZTSAVE("LRSEC")="" D
|
---|
| 11 | . I Y=2 D Q:$G(LREND) S LRAA=Y,ZTSAVE("LRAA")="" Q
|
---|
| 12 | . . S DIR(0)="P^68:QEZM",DIR("A")="Select Local Accession Area"
|
---|
| 13 | . . D RDIR
|
---|
| 14 | . I Y=1 D Q:$G(LREND) S LRSECT=Y,ZTSAVE("LRSECT")=""
|
---|
| 15 | . . S DIR(0)="P^64.21:QEZM",DIR("A")="Select WKLD CODE LAB SECTION "
|
---|
| 16 | . . D RDIR
|
---|
| 17 | G:$G(LREND) CLEAN
|
---|
| 18 | S DIR(0)="S^1:Actived Codes Only;0:All WKLD Codes"
|
---|
| 19 | S DIR("A")="Print Activated(reported) or All Codes" D RDIR
|
---|
| 20 | G:$G(LREND) CLEAN
|
---|
| 21 | S LRACT=Y,ZTSAVE("LRACT")=""
|
---|
| 22 | S DIR(0)="S^1:WKLD Name;2:NLT Code Number"
|
---|
| 23 | S DIR("A")="Print report sorted by "
|
---|
| 24 | D RDIR G:$G(LREND) CLEAN
|
---|
| 25 | S LRSORT=Y,ZTSAVE("LRSORT")=""
|
---|
| 26 | ;Q
|
---|
| 27 | K %ZIS S %ZIS="QN",%ZIS("A")="Printer Name " D ^%ZIS G:POP CLEAN
|
---|
| 28 | I IO'=IO(0)!($D(IO("Q"))) D D ^%ZTLOAD,^%ZISC G CLEAN
|
---|
| 29 | .
|
---|
| 30 | . S ZTRTN="DQ^LRCAPD2",ZTIO=ION,ZTDESC="PRINT WKLD CODES FROM ^LAB(60 " W !!?10,"Report Queued to "_ION,!
|
---|
| 31 | G DQ
|
---|
| 32 | RDIR ;
|
---|
| 33 | S LREND=0 D ^DIR
|
---|
| 34 | S LREND=$S($D(DIRUT):1,$D(DUOUT):1,$D(DIRUT):1,$E(Y)="^":1,1:0)
|
---|
| 35 | K DIR
|
---|
| 36 | Q
|
---|
| 37 | DQ ;
|
---|
| 38 | I $D(ZTQUEUED) S ZTREQ="@" K LRDBUG
|
---|
| 39 | K ^TMP("LR",$J)
|
---|
| 40 | S (LRTS,LREND,LRPAG)=0,$P(LRLINE,"_",(IOM+1))=""
|
---|
| 41 | S LRPDT=$TR($$FMTE^XLFDT($$NOW^XLFDT,"1M"),"@"," ")
|
---|
| 42 | ;test list
|
---|
| 43 | W:$E(IOST,1,2)="C-" @IOF
|
---|
| 44 | S LRTSN=0
|
---|
| 45 | SCR F S LRTSN=$O(^LAM(LRTSN)) Q:LRTSN<1 I $D(^(LRTSN,0))#2 S LRX=^(0) D
|
---|
| 46 | . I $G(LRBIL),'$P(LRX,U,5) Q
|
---|
| 47 | . I $G(LRSECT),$P(LRX,U,15)'=+LRSECT Q
|
---|
| 48 | . I $G(LRACT),'$P(LRX,U,17) Q
|
---|
| 49 | . I $G(LRAA),+$G(^(6))'=LRAA Q
|
---|
| 50 | . I LRSORT=1 S ^TMP("LR",$J,$P(LRX,U),$P(LRX,U,2))=LRTSN
|
---|
| 51 | . I LRSORT=2 S ^TMP("LR",$J,$P(LRX,U,2),$P(LRX,U))=LRTSN
|
---|
| 52 | PRT K DIR,DR,DA,DX,LREND,ZTSAVE
|
---|
| 53 | S LRGLB="",LRGLB=$O(^TMP("LR",$J,LRGLB)) I LRGLB="" D G CLEAN
|
---|
| 54 | . W !?10,"No WKLD CODES matched your Screening Criteria",!!
|
---|
| 55 | S LRHEAD0=LRPDT_" NLT Codes Listed by "_$S(LRSORT=1:"Name ",1:"Code Numbers ")_" Page "
|
---|
| 56 | S LRHEAD=" Sorted by " D
|
---|
| 57 | . I $G(LRBIL) S LRHEAD=LRHEAD_"Billable Codes "
|
---|
| 58 | . I $G(LRSECT) S LRHEAD=LRHEAD_"By { "_$P(^LAB(64.21,+LRSECT,0),U)_" } WKLD SECTION "
|
---|
| 59 | . I $G(LRACT) S LRHEAD2="Active NLT Codes Only "
|
---|
| 60 | . I '$G(LRACT) S LRHEAD2="Not sorted by Active Codes"
|
---|
| 61 | . I $G(LRAA) S LRHEAD3=$G(LRHEAD2)_"Accession Area "_$P(^LRO(68,+$G(LRAA),0),U)_" "
|
---|
| 62 | D HEAD S LRGLB="^TMP(""LR"","_$J_")",DIC="^LAM(",DR="0:99",S=1
|
---|
| 63 | F S LRGLB=$Q(@LRGLB) Q:$QS(LRGLB,1)'="LR"!($QS(LRGLB,2)'=$J)!($G(LREND)) D
|
---|
| 64 | . K DA S DA=@LRGLB
|
---|
| 65 | . I $Y>(IOSL-7) D PAUSE Q:$G(LREND)
|
---|
| 66 | . S S=$Y D EN^LRDIQ S:$D(DIRUT) LREND=1
|
---|
| 67 | G CLEAN
|
---|
| 68 | Q
|
---|
| 69 | HEAD ;
|
---|
| 70 | S LRPAG=$G(LRPAG)+1
|
---|
| 71 | W $$CJ^XLFSTR(LRHEAD0_LRPAG,IOM)
|
---|
| 72 | W $$CJ^XLFSTR(LRHEAD,IOM)
|
---|
| 73 | I $D(LRHEAD2) W $$CJ^XLFSTR(LRHEAD2,IOM)
|
---|
| 74 | I $D(LRHEAD3) W $$CJ^XLFSTR(LRHEAD3,IOM)
|
---|
| 75 | Q
|
---|
| 76 | PAUSE ;
|
---|
| 77 | I $E(IOST)="P" W @IOF D HEAD Q
|
---|
| 78 | Q:$E(IOST,1,2)'="C-"
|
---|
| 79 | K DIR,X,Y S DIR(0)="E" D RDIR Q:$G(LREND)
|
---|
| 80 | W @IOF D HEAD
|
---|
| 81 | Q
|
---|
| 82 | CLEAN I $D(ZTQUEUED) S ZTREQ="@"
|
---|
| 83 | Q:$G(LRDBUG)
|
---|
| 84 | W !! W:$E(IOST,1,2)="P-" @IOF
|
---|
| 85 | D ^%ZISC
|
---|
| 86 | K LRHEAD,LRHEAD2,LRHEAD3,LRPDT,LRSEC,LRSECT,LRSORT,LRAA,LRACT,LRBIL
|
---|
| 87 | K %ZIS,DA,DIC,DR,LRI,LRLINE,LRHED,LRI,LRJ,LRK,LRTS,LRTSN,LRX,NAME,NAME1
|
---|
| 88 | K %,LRCC,LREND,X,Y,ZTSK,DTOUT,DUOUT,DIRUT,LRPAG,DIR
|
---|
| 89 | K ^TMP("LR",$J),ZTSAVE,LRGLB,S,DX
|
---|
| 90 | Q
|
---|