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

LRJPON.m

Go to the documentation of this file.
  1. LRJPON ;ALB/JLC - OBSOLETE PENDING ORDERS;08/25/2010 12:32:47
  1. ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
  1. ;
  1. ;
  1. ; Reference to ^OR(100 supported by IA #3582
  1. ; Reference to STATUS^ORCSAVE2 supported by IA #5903
  1. ;
  1. EN ;search for pending orders older than the obsolete (lapse) timeframe
  1. N LRORD,LRDATE,LRSN,LRLAPSE,LRDATE,%,X1,X2,X,LRT,LRCANC,A1,A2,LRDUZ,X,DT,A,LRIFN,LRSTOP
  1. S A1=$$GET^XPAR("SYS","LRJ OBSOLETE PENDING ORDERS",1,"I")
  1. S A2=$P($G(^LAB(69.9,1,0)),"^",9)
  1. I A1="",A2="" D MSG(1) Q
  1. I A1="",A2]"" S X2=A2 D MSG(2,A2)
  1. I A2="",A1]"" S X2=A1 D MSG(3,A1)
  1. I A1]"",A2]"" I A1'<A2 D MSG(4,A1)
  1. I A1]"",A2]"" S X2=$S(A1<A2:A1,A2<A1:A2,1:A1)
  1. S X2="-"_X2,LRDUZ=$$PRXYUSR^LRUTIL3("HL",1)
  1. D NOW^%DTC S (DT,X1)=$P(%,".") D C^%DTC S LRLAPSE=X
  1. L +^LRJPON:$G(DILOCKTM,5) E Q
  1. S LRDATE=0
  1. F S LRDATE=$O(^LRO(69,LRDATE)) Q:'LRDATE Q:LRDATE>LRLAPSE D I $$REQ2STOP() S ZSTOP=1 Q
  1. . S LRSN=0
  1. . F S LRSN=$O(^LRO(69,LRDATE,1,LRSN)) Q:'LRSN D I $$REQ2STOP() Q
  1. .. S A=$G(^LRO(69,LRDATE,1,LRSN,0)) I A="" Q
  1. .. I $P(A,"^")="" Q
  1. .. I $P($G(^LRO(69,LRDATE,1,LRSN,1)),"^")]"" Q
  1. .. S (LRT,LRSTOP)=0
  1. .. F S LRT=$O(^LRO(69,LRDATE,1,LRSN,2,LRT)) Q:'LRT D
  1. ... S A=$G(^LRO(69,LRDATE,1,LRSN,2,LRT,0)) I $P(A,"^",9)="CA" Q
  1. ... I $P(A,"^",6)]""!($P(A,"^",14)]"") S LRSTOP=$$CHECK(A,LRDATE,LRSN)
  1. ... S $P(^LRO(69,LRDATE,1,LRSN,2,LRT,0),"^",3,6)="^^^",$P(^(0),"^",9,11)="CA^L^"_LRDUZ
  1. ... I '$D(^LRO(69,LRDATE,1,LRSN,2,LRT,1.1,0)) S ^(0)="^^^^"_DT
  1. ... S X=1+$O(^LRO(69,LRDATE,1,LRSN,2,LRT,1.1,9999),-1)
  1. ... S $P(^LRO(69,LRDATE,1,LRSN,2,LRT,1.1,0),"^",3,4)=X_"^"_X,^(X,0)="Obsolete Order"
  1. ... I 'LRSTOP S LRIFN=$P($G(^LRO(69,LRDATE,1,LRSN,2,LRT,0)),"^",7) I LRIFN]"" D STATUS^ORCSAVE2(LRIFN,14)
  1. .. D NEW^LR7OB1(LRDATE,LRSN,"Z@")
  1. S $P(^LAB(69.9,1,64.9104),"^")=$P($$NOW^XLFDT,".")
  1. L -^LRJPON
  1. Q
  1. ;
  1. CHECK(PREV,LDATE,LSN) ;
  1. N B,LRCOM,ORIFN
  1. S ORIFN=$P(PREV,"^",7) I ORIFN="" Q 1
  1. I $P($G(^OR(100,ORIFN,3)),"^",3)'=5 Q 1
  1. S B=$G(^OR(100,ORIFN,4)) I LDATE'=$P(B,";",2)!(LSN'=$P(B,";",3)) Q 1
  1. Q 0
  1. REQ2STOP() ;
  1. ; Check for task stop request
  1. ; Returns 1 if stop request made.
  1. N STATUS,X
  1. S STATUS=0
  1. I '$D(ZTQUEUED) Q 0
  1. S X=$$S^%ZTLOAD()
  1. I X D ;
  1. . S (STATUS,ZTSTOP)=1
  1. . S X=$$S^%ZTLOAD("Received shutdown request")
  1. ;
  1. I $Q Q STATUS
  1. Q
  1. ;
  1. MSG(ERR,DAYS) ;send mail message
  1. K XMY N XMDUZ,XMSUB,XMTEXT,A
  1. S XMDUZ="ORDERS, OBSOLETE",XMY("G.LMI")="",XMSUB="OBSOLETE ORDER PARAMETER(S) ISSUE"
  1. I ERR=1 D
  1. . S A(1)="Both the GRACE PERIOD FOR ORDERS field in file 69.9 and the LRJ OBSOLETE"
  1. . S A(2)="PENDING ORDERS parameter are blank."
  1. . S A(3)=" "
  1. . S A(4)="One of these fields must be populated in order for the process to obsolete"
  1. . S A(5)="pending orders to run."
  1. I ERR=2!(ERR=3) D
  1. . S A(1)="The "_$S(ERR=2:"LRJ OBSOLETE PENDING ORDERS parameter",1:"GRACE PERIOD FOR ORDERS field")_" is blank."
  1. . S A(2)=" "
  1. . S A(3)="The value: "_DAYS_" days was used for determining the 'obsolete' date."
  1. I ERR=4 D
  1. . S A(1)="The LRJ OBSOLETE PENDING ORDERS parameter is currently set to "_DAYS_"."
  1. . S A(2)=" "
  1. . S A(3)="This is either the same or greater than the GRACE PERIOD FOR ORDERS field in"
  1. . S A(4)="file 69.9. LRJ OBSOLETE PENDING ORDERS should always be less."
  1. . S A(5)=" "
  1. . S A(6)="Please correct these settings. You may have to contact IRM for help changing"
  1. . S A(7)="the parameter."
  1. S XMTEXT="A(" D ^XMD
  1. Q