Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRFAC

LRFAC.m

Go to the documentation of this file. 
  1. LRFAC ; IHS/DIR/FJE - CUM PRINT FOR FILEROOM PATIENTS TO SEPARATE PRINTER ;
  1.  ;;5.2;LR;**1013**;JUL 15, 2002
  1.  ;
  1.  ;;5.2;LAB SERVICE;;Sep 27, 1994
  1. EN ; Entry point from menu option to manually task file room cumulative.
  1.  W @IOF,!!?20,"Checking File #64.5, LAB REPORTS FILE"
  1.  D CHECK I LRERR W !!,$C(7),$P(LRERR,U,2),!! G END
  1.  W !,"File Setup ...OK",!!,"Will schedule report(s):"
  1.  S LRRPTN=0
  1.  F  S LRRPTN=$O(LRRP(LRRPTN)) Q:'LRRPTN  W ?25,$P(LRRP(LRRPTN),U),!
  1.  K DIR
  1.  S DIR(0)="YO",DIR("A")="Print Cumulative for FILE ROOM",DIR("B")="NO"
  1.  S DIR("?")="Answer 'YES' if you want to task the FILE ROOM Cumulative to start."
  1.  D ^DIR K DIR
  1.  I Y D
  1.  . S ZTRTN="CLOCK^LRFAC",ZTIO="",ZTDESC="Start FILE ROOM Cumulative"
  1.  . D ^%ZTLOAD W !,"Request ",$S($D(ZTSK):"",1:"NOT "),"Queued" W:$D(ZTSK) !,"Task #",ZTSK
  1.  G END
  1.  ;
  1. CLOCK ; Task fileroom patients cumulative to appropiate devices.
  1.  D CHECK I LRERR D  G END
  1.  . S XQAMSG="File setup problem observed when attempting to run Lab File Room Cumulative"
  1.  . D ALERT
  1.  K ^LAC($J),XQAMSG
  1.  Q:'$D(^LAB(64.5,1,3))!($D(^LAC("LRAC","A")))
  1.  S CNT=0 F  L +^LAB(64.5):1 Q:$T  H 60 S CNT=1 I CNT>5 D  Q  ; Lock LAB REPORTS file.
  1.  . S XQAMSG="Unable to lock Lab Reports file (#64.5) check Lock Table"
  1.  . D ALERT
  1.  G END:$D(XQAMSG)
  1.  S LRDT=$P(^LAB(64.5,1,0),U,3) ; Get last cumulative report date.
  1.  S LRLDT=$P($G(^LAB(64.5,1,6)),U,1) I 'LRLDT S LRLDT=LRDT ;Find last fileroom report date ( if none, set to last report date).
  1.  S LRRE=0,LRXLR="LRAC",LRPERM=0,LRBOT=$P(^LAB(64.5,1,0),U,2)
  1.  S %DT="",X="T" D ^%DT S LRYDT=Y
  1.  ; For each day since last fileroom run, move fileroom patients to current fileroom list.
  1.  ; Start with last file room run date in case last run was incomplete.
  1.  ; If patient has been printed subsequently - date stored in second piece of ^LAC("LRAC",LRDFN,0) is more recent, then skip.
  1.  S LRLDT=LRLDT-.1
  1.  F  S LRLDT=$O(^LRO(69,LRLDT)) Q:'LRLDT!(LRLDT'<LRDT)  D
  1.  . S LRLLOC="FILE ROOM" ; Start with locations containing "FILE ROOM", end when doesn't contain "FILE ROOM".
  1.  . F  S LRLLOC=$O(^LRO(69,LRLDT,1,"AR",LRLLOC)) Q:LRLLOC=""!(LRLLOC'["FILE ROOM")  D
  1.  . . S PNM=""
  1.  . . F  S PNM=$O(^LRO(69,LRLDT,1,"AR",LRLLOC,PNM)) Q:PNM=""  D
  1.  . . . S LRDFN=0
  1.  . . . 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)
  1.  S LRLDT=LRDT,$P(^LAB(64.5,1,6),U,1)=LRLDT ; Update last Fileroom run date.
  1.  L -^LAB(64.5) ; Release locks.
  1.  ; Will task those reports that are flagged as separate fileroom.
  1.  N ZTIO ; Tasked jobs have ZTIO defined, want ZTLOAD to build from IO* variables.
  1.  S LRRPTN=0
  1.  F  S LRRPTN=$O(^LAB(64.5,1,3,LRRPTN)) Q:'LRRPTN  D
  1.  . S LRX(0)=$G(^LAB(64.5,1,3,LRRPTN,0)),LRX(.1)=$G(^LAB(64.5,1,3,LRRPTN,.1))
  1.  . I $P(LRX(0),U,2)["FILE ROOM",$P(LRX(0),U,3)["FILE ROOM",$P(LRX(.1),U,3) D
  1.  . . ; Starting/Ending locations contain "FILE ROOM", flag set to YES for FILEROOM REPORT.
  1.  . . S IOP=$P(LRX(.1),U,1) Q:IOP=""  S %ZIS="N" D ^%ZIS Q:POP  ; Get device characteristics.
  1.  . . F I="LRPERM","LRXLR","LRDT","LRLDT","LRYDT","LRBOT","LRRE","LRRPTN" S ZTSAVE(I)=""
  1.  . . S ZTRTN="DQ^LRFAC",ZTDTH=$H,ZTDESC="Laboratory Fileroom Cumulative"
  1.  . . D ^%ZTLOAD K ZTSK ; Task the job.
  1.  . K IOP D ^%ZISC ; Restore device parameters.
  1.  G END
  1.  ;
  1. DQ ; Queued entry point to actually print fileroom reports
  1.  S $P(^LAB(64.5,1,3,LRRPTN,0),U,4,8)="" ; Clear previous status for this report.
  1.  D ENT^LRAC1
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  Q
  1.  ;
  1. CHECK ; Check File 64.5 for proper setup.
  1.  N LRRPTN,LRX
  1.  S LRERR=0,LRX(0)=$G(^LAB(64.5,1,0)),LRX(6)=$G(^LAB(64.5,1,6))
  1.  I '$P(LRX(0),U,4) S LRERR=1_U_"Field #4, FILE ROOM, not set to 'YES'!" Q
  1.  I '$P(LRX(6),U,2) S LRERR=2_U_"Field #17, SEPARATE FILE ROOM, not set to 'YES'!" Q
  1.  S LRRPTN=0 K LRX
  1.  F  S LRRPTN=$O(^LAB(64.5,1,3,LRRPTN)) Q:LRRPTN<1!(LRERR)  D
  1.  . S LRX(0)=$G(^LAB(64.5,1,3,LRRPTN,0)),LRX(.1)=$G(^LAB(64.5,1,3,LRRPTN,.1))
  1.  . I '$P(LRX(.1),U,3) Q
  1.  . I $P(LRX(0),U,2)'["FILE ROOM" S LRERR=3 Q
  1.  . I $P(LRX(0),U,3)'["FILE ROOM" S LRERR=4 Q
  1.  . S LRRP(LRRPTN)=LRX(0)
  1.  I LRERR S LRERR=LRERR_U_"Report: "_$P(LRX(0),U)_" - "_$S(LRERR=3:"Starting",1:"Ending")_" Location does NOT contain 'FILE ROOM'!" Q
  1.  I '$D(LRRP) S LRERR=5_U_"No reports for FILE ROOM found!"
  1.  Q
  1.  ;
  1. END ; Clean up time.
  1.  S:$D(ZTQUEUED) ZTREQ="@" D ^%ZISC
  1.  K %DT,%H,%ZIS,DA,DIR,DIRUT,I,PNM,X,X1,X2,Y,Z
  1.  K LRBOT,LRCVT,LRDFN,LRDT,LREND,LRERR,LRLDT,LRLLOC,LRNM,LRPERM,LRRP,LRRPTN,LRRE,LRX,LRXLR,LRYDT,CNT
  1.  K XQ1,XQAMSG,XQXFLG
  1.  Q
  1. ALERT ;Send Alert Messages to LRLIASON mail group
  1.  Q:'$L($G(XQAMSG))  N Y S Y=0 F  S Y=$O(^XUSEC("LRLIASON",Y)) S XQA(Y)=""
  1.  I $D(XQA) D SETUP^XQALERT
  1.  Q