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

LRSPRPTM.m

Go to the documentation of this file.
  1. LRSPRPTM ;AVAMC/REG/WTY - MODIFIED PATH REPORT ;9/22/00
  1. ;;5.2;LAB SERVICE;**1,248,416**;Sep 27, 1994;Build 4
  1. ;
  1. ;Reference to ^VA(200 supported by IA #10060
  1. ;Reference to ^DIWP suppported by IA #10011
  1. ;Reference to ^DIWW suppported by IA #10029
  1. ;
  1. W !?28,"*+* MODIFIED REPORT *+*"
  1. W !,"(Last modified: "
  1. S B=0
  1. F A=0:0 S A=$O(^LR(LRDFN,LRSS,LRI,LR(0),A)) Q:'A!(LR("Q")) S B=A
  1. Q:LR("Q") Q:'$D(^LR(LRDFN,LRSS,LRI,LR(0),B,0))
  1. S A=^LR(LRDFN,LRSS,LRI,LR(0),B,0),Y=+A,A=$P(A,"^",2)
  1. S A=$S($D(^VA(200,A,0)):$P(^(0),"^"),1:A)
  1. D D^LRU W Y," typed by ",A,")"
  1. D:$D(LRQ(9)) M
  1. Q
  1. ;
  1. M F A=0:0 S A=$O(^LR(LRDFN,LRSS,LRI,LR(0),A)) Q:'A!(LR("Q")) D
  1. .S LRT=^LR(LRDFN,LRSS,LRI,LR(0),A,0)
  1. .D:$Y>(IOSL-14) F^LRAPF,^LRAPF Q:LR("Q")
  1. .S Y=+LRT,X=$P(LRT,"^",2),X=$S($D(^VA(200,X,0)):$P(^(0),"^"),1:X)
  1. .D D^LRU W !,"Date modified:",Y," typed by ",X D F
  1. Q:LR("Q")
  1. W !?13,"==========Text below appears on final report=========="
  1. Q
  1. E K ^UTILITY($J) S DIWR=IOM-5,DIWL=5,DIWF="W"
  1. Q
  1. ;
  1. F D E S B=0
  1. F LRZ=0:1 S B=$O(^LR(LRDFN,LRSS,LRI,LR(0),A,1,B)) Q:'B!(LR("Q")) D
  1. .S LRT=^LR(LRDFN,LRSS,LRI,LR(0),A,1,B,0)
  1. .D:$Y>(IOSL-14) F^LRAPF,^LRAPF Q:LR("Q")
  1. .S X=LRT D ^DIWP
  1. Q:LR("Q") D:LRZ ^DIWW
  1. Q