| [613] | 1 | LRACFR ;MILW/JMC- Lab cumulative print fileroom patients ;2/20/91 08:33 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | EN ; Entry point from menu option to manually task file room cumulative.
|
|---|
| 4 | W @IOF,"Checking File #64.5, LAB REPORTS FILE"
|
|---|
| 5 | D CHECK I LRERR W !!,$C(7),$P(LRERR,U,2),!! G END
|
|---|
| 6 | W " ...OK",!!,"Will schedule report(s):"
|
|---|
| 7 | S LRRPTN=0
|
|---|
| 8 | F S LRRPTN=$O(LRRP(LRRPTN)) Q:'LRRPTN W ?25,$P(LRRP(LRRPTN),U),!
|
|---|
| 9 | K DIR
|
|---|
| 10 | S DIR(0)="YO",DIR("A")="Print Cumulative for FILE ROOM",DIR("B")="NO"
|
|---|
| 11 | S DIR("?")="Answer 'YES' if you want to task the FILE ROOM Cumulative to start."
|
|---|
| 12 | D ^DIR K DIR
|
|---|
| 13 | I Y D
|
|---|
| 14 | . S ZTRTN="CLOCK^LRACFR",ZTIO="",ZTDESC="Start FILE ROOM Cumulative"
|
|---|
| 15 | . D ^%ZTLOAD W !,"Request ",$S($D(ZTSK):"",1:"NOT "),"Queued" W:$D(ZTSK) !,"Task #",ZTSK
|
|---|
| 16 | G END
|
|---|
| 17 | ;
|
|---|
| 18 | CLOCK ; Task fileroom patients cumulative to appropiate devices.
|
|---|
| 19 | D CHECK I LRERR D G END
|
|---|
| 20 | . S XQAMSG="File setup problem observed when attempting to run Lab File Room Cumulative"
|
|---|
| 21 | . K XQA S Y=0 F S Y=$O(^XUSEC("LRLIASON",Y)) Q:Y="" S XQA(Y)=""
|
|---|
| 22 | . I $D(XQA) D SETUP^XQALERT
|
|---|
| 23 | K ^LAC($J)
|
|---|
| 24 | Q:'$D(^LAB(64.5,1,3))!($D(^LAC("LRAC","A")))
|
|---|
| 25 | L +^LAB(64.5) ; Lock LAB REPORTS file.
|
|---|
| 26 | S LRLDT=$P($G(^LAB(64.5,1,6)),U,1),LRDT=$P(^LAB(64.5,1,0),U,3) I 'LRLDT S LRLDT=LRDT ;Find last fileroom report date ( if none, set to last report date).
|
|---|
| 27 | L -^LAB(64.5) ; Release locks.
|
|---|
| 28 | S LRRE=0,LRXLR="LRAC",LRPERM=0,LRBOT=$P(^LAB(64.5,1,0),U,2)
|
|---|
| 29 | S %DT="",X="T" D ^%DT S LRYDT=Y
|
|---|
| 30 | ; For each day since last fileroom run, move fileroom patients to current fileroom list.
|
|---|
| 31 | ; If patient has been printed subsequently - date stored in second piece of ^LAC("LRAC",LRDFN,0) is more recent, then skip.
|
|---|
| 32 | S X1=LRDT,X2=LRLDT D ^%DTC
|
|---|
| 33 | I X>1 D
|
|---|
| 34 | . S LRCVT=X-1
|
|---|
| 35 | . F I=1:1:LRCVT S X=LRLDT D H^%DTC S %H=%H+1 D YMD^%DTC S LRLDT=X D
|
|---|
| 36 | . . S LRLLOC="FILE ROOM"
|
|---|
| 37 | . . F S LRLLOC=$O(^LRO(69,LRLDT,1,"AR",LRLLOC)) Q:LRLLOC=""!(LRLLOC'["FILE ROOM") D
|
|---|
| 38 | . . . S PNM=""
|
|---|
| 39 | . . . F S PNM=$O(^LRO(69,LRLDT,1,"AR",LRLLOC,PNM)) Q:PNM="" D
|
|---|
| 40 | . . . . S LRDFN=0
|
|---|
| 41 | . . . . F S LRDFN=$O(^LRO(69,LRLDT,1,"AR",LRLLOC,PNM,LRDFN)) Q:'LRDFN I LRLDT>$P($G(^LAC("LRAC",LRDFN,0)),U,2) S $P(^LRO(69,LRDT,1,"AR",LRLLOC,PNM,LRDFN),U,2)=$P(^LRO(69,LRLDT,1,"AR",LRLLOC,PNM,LRDFN),U,2)
|
|---|
| 42 | ; Will task those reports that are flagged as separate fileroom.
|
|---|
| 43 | N ZTIO ; Tasked jobs have ZTIO defined, want ZTLOAD to build from IO* variables.
|
|---|
| 44 | S LRRPTN=0
|
|---|
| 45 | F S LRRPTN=$O(^LAB(64.5,1,3,LRRPTN)) Q:LRRPTN<1 D
|
|---|
| 46 | . S LRX(0)=$G(^LAB(64.5,1,3,LRRPTN,0)),LRX(.1)=$G(^LAB(64.5,1,3,LRRPTN,.1))
|
|---|
| 47 | . I $P(LRX(0),U,2)["FILE ROOM",$P(LRX(0),U,3)["FILE ROOM",$P(LRX(.1),U,3) D
|
|---|
| 48 | . . ; Starting/Ending locations contain "FILE ROOM", flag set to YES for SEPARATE FILEROOM (field #17 in file #64.5).
|
|---|
| 49 | . . S IOP=$P(LRX(.1),U,1) Q:IOP="" S %ZIS="N" D ^%ZIS Q:POP ; Get device characteristics.
|
|---|
| 50 | . . F I="LRPERM","LRXLR","LRDT","LRLDT","LRYDT","LRBOT","LRRE","LRRPTN" S ZTSAVE(I)=""
|
|---|
| 51 | . . S ZTRTN="DQ^LRACFR",ZTDTH=$H,ZTDESC="Laboratory Fileroom Cumulative"
|
|---|
| 52 | . . D ^%ZTLOAD K ZTSK ; Task the job.
|
|---|
| 53 | . K IOP D ^%ZISC ; Restore device parameters.
|
|---|
| 54 | G END
|
|---|
| 55 | ;
|
|---|
| 56 | DQ ; Queued entry point to actually print fileroom reports
|
|---|
| 57 | S LRFRDT=LRDT,$P(^LAB(64.5,1,3,LRRPTN,0),U,4,8)="" ; Clear previous status for this report.
|
|---|
| 58 | D ENT^LRAC1
|
|---|
| 59 | S $P(^LAB(64.5,1,6),U,1)=LRFRDT ; Update last Fileroom run date.
|
|---|
| 60 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 61 | K LRFRDT
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | CHECK ; Check File 64.5 for proper setup.
|
|---|
| 65 | N LRRPTN,LRX
|
|---|
| 66 | S LRERR=0,LRX(0)=$G(^LAB(64.5,1,0)),LRX(6)=$G(^LAB(64.5,1,6))
|
|---|
| 67 | I '$P(LRX(0),U,4) S LRERR=1_U_"Field #4, FILE ROOM, not set to 'YES'!" Q
|
|---|
| 68 | I '$P(LRX(6),U,2) S LRERR=2_U_"Field #17, SEPARATE FILE ROOM, not set to 'YES'!" Q
|
|---|
| 69 | S LRRPTN=0 K LRX
|
|---|
| 70 | F S LRRPTN=$O(^LAB(64.5,1,3,LRRPTN)) Q:LRRPTN<1!(LRERR) D
|
|---|
| 71 | . S LRX(0)=$G(^LAB(64.5,1,3,LRRPTN,0)),LRX(.1)=$G(^LAB(64.5,1,3,LRRPTN,.1))
|
|---|
| 72 | . I '$P(LRX(.1),U,3) Q
|
|---|
| 73 | . I $P(LRX(0),U,2)'["FILE ROOM" S LRERR=3 Q
|
|---|
| 74 | . I $P(LRX(0),U,3)'["FILE ROOM" S LRERR=4 Q
|
|---|
| 75 | . S LRRP(LRRPTN)=LRX(0)
|
|---|
| 76 | I LRERR S LRERR=LRERR_U_"Report: "_$P(LRX(0),U)_" - "_$S(LREND=1:"Starting",1:"Ending")_" Location does NOT contain 'FILE ROOM'!" Q
|
|---|
| 77 | I '$D(LRRP) S LRERR=5_U_"No reports for FILE ROOM found!"
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
| 80 | END ; Clean up time.
|
|---|
| 81 | S:$D(ZTQUEUED) ZTREQ="@"
|
|---|
| 82 | K %DT,%H,%ZIS,DA,DIR,DIRUT,I,PNM,X,X1,X2,Y,Z
|
|---|
| 83 | K LRBOT,LRCVT,LRDFN,LRDT,LREND,LRERR,LRLDT,LRLLOC,LRNM,LRPERM,LRRP,LRRPTN,LRRE,LRX,LRXLR,LRYDT
|
|---|
| 84 | Q
|
|---|
