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

ORY129.m

Go to the documentation of this file.
  1. ORY129 ;SLC/MKB - Postinit for patch OR*3*129 ;12/11/01 11:04
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**129**;Dec 17, 1997
  1. ;
  1. POST ; -- postinit
  1. N IFN,X S IFN=+$P($G(^OR(100,0)),U,3)
  1. F S IFN=$O(^OR(100,IFN)) Q:IFN?1"A".E I IFN[";" S X=$G(^(IFN,5)) S:$L(X) ^OR(100,+IFN,5)=X K ^OR(100,IFN,5)
  1. D TASK
  1. Q
  1. ;
  1. TASK ; -- task cleanup of AC xref
  1. N ORMSG,ZTDESC,ZTRTN,ZTIO,ZTDTH,ZTSK
  1. S ORMSG(1)="Please queue the background job to clean up changed orders in the",ORMSG(2)="Active Orders index on file #100."
  1. D MES^XPDUTL(.ORMSG) K ORMSG
  1. S ZTDESC="Cleanup AC xref on Orders file #100",ZTIO=""
  1. S ZTRTN="EN^ORY129" D ^%ZTLOAD
  1. S ORMSG="Task "_$S($G(ZTSK):"#"_ZTSK,1:"not")_" queued."
  1. D MES^XPDUTL(ORMSG) I '$G(ZTSK) D BMES^XPDUTL("Use TASK^ORY129 to run this job later, if needed.")
  1. Q
  1. ;
  1. EN ; -- main conversion loop
  1. N ORIDX,ORPSJ,ORIFN,ORDA,OR0,OR3,OR8
  1. S ORIDX="^OR(100,""AC"")",ORPSJ=+$O(^DIC(9.4,"C","PSJ",0))
  1. F S ORIDX=$Q(@ORIDX) Q:ORIDX'?1"^OR(100,""AC"",".E D
  1. . S ORIFN=+$P(ORIDX,",",5),ORDA=+$P(ORIDX,",",6)
  1. . S OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),OR8=$G(^(8,ORDA,0))
  1. . I $P(OR8,U,15)=12 D SETALL^ORDD100(ORIFN) Q ;reset AC xref
  1. . I $P(OR0,U,14)=ORPSJ,$P(OR8,U,2)="XX",$P(OR3,U,7)=ORDA D MSG^ORMBLD(ORIFN_";"_ORDA,"NA") ;update order number
  1. Q