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

ORY350B.m

Go to the documentation of this file. 
  1. ORY350B ;SLCOIFO - PRE- AND POST-INSTALL B FOR PATCH OR*3.0*350 ;04/16/15  07:44
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**350**;Dec 17, 1997;Build 77
  1.  ;
  1. PRE ;Pre-Init Entry Point
  1.  D PEOMRPT
  1.  D EDITEAD
  1.  D CONSULT
  1.  Q
  1. POST ;Post-Init Entry Point
  1.  D PAR
  1.  D CONSPAR
  1.  Q
  1. PEOMRPT ;Remove new & changed reports from OE/RR REPORTS file (101.24)
  1.  N ORI,DA,DIK
  1.  S ORI=999
  1.  F  S ORI=$O(^ORD(101.24,ORI)) Q:'ORI  I ORI<1110!(ORI>1116) S DA=ORI,DIK="^ORD(101.24," D ^DIK
  1.  Q
  1. PAR ; Parameter Value Transport
  1.  D DEL,PUT
  1.  K ^TMP($J,"XPARRSTR")
  1.  N ENT,IDX,ROOT,REF,VAL,I
  1.  S ROOT=$NAME(^TMP($J,"XPARRSTR")),ROOT=$E(ROOT,1,$L(ROOT)-1)_","
  1.  D LOAD
  1.  S IDX=0,ENT="PKG.ORDER ENTRY/RESULTS REPORTING"
  1.  F  S IDX=$O(^TMP($J,"XPARRSTR",IDX)) Q:'IDX  D
  1.  . N PAR,INST,ORVAL,ORERR
  1.  . S PAR=$P(^TMP($J,"XPARRSTR",IDX,"KEY"),U),INST=$P(^("KEY"),U,2)
  1.  . M ORVAL=^TMP($J,"XPARRSTR",IDX,"VAL")
  1.  . D EN^XPAR(ENT,PAR,INST,.ORVAL,.ORERR)
  1.  K ^TMP($J,"XPARRSTR")
  1.  Q
  1. LOAD ; load data into ^TMP (expects ROOT to be defined)
  1.  S I=1 F  S REF=$T(DATA+I) Q:REF=""  S VAL=$T(DATA+I+1) D
  1.  . S I=I+2,REF=$P(REF,";",3,999),VAL=$P(VAL,";",3,999)
  1.  . S @(ROOT_REF)=VAL
  1.  Q
  1. DEL ;Delete package level parameters
  1.  N P
  1.  S P="ORWRP REPORT LAB LIST"
  1.  D SET("@",P,5)
  1.  D SET("@",P,10)
  1.  D SET("@",P,15)
  1.  D SET("@",P,20)
  1.  D SET("@",P,25)
  1.  D SET("@",P,30)
  1.  D SET("@",P,35)
  1.  D SET("@",P,40)
  1.  D SET("@",P,45)
  1.  D SET("@",P,50)
  1.  D SET("@",P,55)
  1.  D SET("@",P,60)
  1.  D SET("@",P,65)
  1.  Q
  1. PUT ;Setup package level parameters
  1.  N P
  1.  S P="ORWRP REPORT LAB LIST"
  1.  D SET("ORRPL LAB OVERVIEW",P,10)
  1.  D SET("ORRPL LAB ORDERS PEND",P,15)
  1.  D SET("ORL MOST RECENT",P,20)
  1.  D SET("ORL WORKSHEET",P,25)
  1.  D SET("ORL GRAPH",P,30)
  1.  D SET("ORL ALL TESTS BY DATE",P,35)
  1.  D SET("ORL SELECTED TESTS BY DATE",P,40)
  1.  D SET("ORL MICROBIOLOGY",P,45)
  1.  D SET("ORL ANATOMIC PATHOLOGY",P,50)
  1.  D SET("ORL BLOOD BANK",P,55)
  1.  D SET("ORRPL LAB ORDERS ALL",P,60)
  1.  D SET("ORL CUMULATIVE",P,65)
  1.  Q
  1. SET(ONAME,P,S) ;Set the parameter
  1.  ;ONAME=Report name
  1.  ;P=Parameter name
  1.  ;S=Sequence (count)
  1.  N ORERR
  1.  D EN^XPAR("PKG.ORDER ENTRY/RESULTS REPORTING",P,S,ONAME,.ORERR)
  1.  Q
  1. EDITEAD ;edit OR GTX EARLIEST DATE to OR GTX CLINICALLY INDICATED DATE
  1.  D BMES^XPDUTL("Converting ORDER DIALOG OR GTX EARLIEST DATE to OR GTX CLINICALLY INDICATED DATE")
  1.  N DIE,DA,DR,ORNAME,ORDISTXT,ORID
  1.  S ORNAME="OR GTX CLINICALLY INDICATED DATE",ORDISTXT="Clinically indicated date:",ORID="CLINICALLY"
  1.  Q:+$O(^ORD(101.41,"B",ORNAME,""))'=0
  1.  S DIE="^ORD(101.41,"
  1.  S DA=$O(^ORD(101.41,"B","OR GTX EARLIEST DATE",""))
  1.  I +$G(DA)'>0  D  S XPDABORT=1 Q
  1.  .D BMES^XPDUTL("Cannot find OR GTX EARLIEST DATE in file 101.41")
  1.  .D MES^XPDUTL("No changes have been made.  Install will abort.")
  1.  .D MES^XPDUTL("Please submit a Remedy ticket for assistance.")
  1.  I $G(XPDABORT)=1 Q
  1.  S DR=".01///^S X=ORNAME;2///^S X=ORDISTXT;13///^S X=ORID"
  1.  D ^DIE
  1.  L +^FILE(101.41,DA):0 I $T D ^DIE L -^FILE(101.41,DA) D MES^XPDUTL("Conversion Complete") Q
  1.  D MES^XPDUTL("Unable to lock OR GTX EARLIEST DATE for edit. No changes made.")
  1.  S XPDABORT=1 D MES^XPDUTL("Install will abort. Please try again.")
  1.  Q
  1. LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ; call FileMan Finder to look up file entry
  1.  Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"MSGERR")
  1. CONSPAR ; set any value found for EAD at PKG level back into the CID at SYS level.
  1.  D BMES^XPDUTL("The System level value for ORCDGMRC CLIN IND DATE DEFAULT will now")
  1.  D MES^XPDUTL("be set to the Package level value for ORCDGMRC EARLIEST DATE DEFAULT.")
  1.  D MES^XPDUTL("When that is complete, the ORCDGMRC EARLIEST DATE DEFAULT parameter")
  1.  D MES^XPDUTL("will be removed from the system.")
  1.  N ORPARVAL,ORERR,ORPAREAD,ORPARCID,OREADIEN,ORCIDIEN,ORMSG
  1.  S ORPAREAD="ORCDGMRC EARLIEST DATE DEFAULT",ORPARCID="ORCDGMRC CLIN IND DATE DEFAULT"
  1.  S OREADIEN=$$LU(8989.51,ORPAREAD,"X")
  1.  S ORCIDIEN=$$LU(8989.51,ORPARCID,"X")
  1.  I +$G(OREADIEN)'>0 D BMES^XPDUTL("Unable to find "_ORPAREAD_". No value set.") Q
  1.  I +$G(ORCIDIEN)'>0 D BMES^XPDUTL("Unable to find "_ORPARCID_". No value set.") Q
  1.  S ORPARVAL=$$GET^XPAR("PKG",ORPAREAD,1,"I")
  1.  I $L($G(ORPARVAL))>0 D EN^XPAR("SYS",ORPARCID,1,ORPARVAL,.ORERR)
  1.  I +$G(ORERR)'=0 D  Q
  1.  .D BMES^XPDUTL("ERROR OCCURRED SETTING "_ORPARCID)
  1.  .D MES^XPDUTL("AT THE SYSTEM LEVEL. THE ERROR IS:")
  1.  .D BMES^XPDUTL("ERROR NUMBER: "_+$G(ORERR))
  1.  .D MES^XPDUTL("ERROR TEXT: "_$P($G(ORERR),U,2))
  1.  E  D
  1.  .S:ORPARVAL="" ORMSG="NULL"
  1.  .D BMES^XPDUTL(ORPARCID_" has been set to "_ORPARVAL)
  1.  .D DELPARM
  1.  Q
  1.  ;
  1. DELPARM ;remove ORCDGMRC EARLIEST DATE DEFAULT from the system
  1.  N ORLIST,ENT,PAR,OERR
  1.  ;get instances of parameter
  1.  S ENT="",PAR="ORCDGMRC EARLIEST DATE DEFAULT"
  1.  D ENVAL^XPAR(.ORLIST,PAR,1,.OERR)
  1.  ;delete instances
  1.  D BMES^XPDUTL("Attempting to remove values for parameter ORCDGMRC EARLIEST DATE DEFAULT...")
  1.  F  S ENT=$O(ORLIST(ENT)) Q:ENT=""  D DEL^XPAR(ENT,PAR,1,.OERR) I $G(OERR)>0 W !,OERR
  1.  D:+$G(OERR)=0 MES^XPDUTL("Values have been removed")
  1.  ;delete parameter
  1.  N DA,DIK
  1.  S DIK="^XTV(8989.51,"
  1.  S DA=$O(^XTV(8989.51,"B",PAR,"")) Q:+$G(DA)'>0  D BMES^XPDUTL("Attempting to delete parameter ORCDGMRC EARLIEST DATE DEFAULT from PARAMETER DEFINITION file")
  1.  D ^DIK D:+$G(DA)>0 MES^XPDUTL("Delete successful")
  1.  Q
  1. CONSULT ;
  1.  K ^TMP("OR350_EADID",$J)
  1.  N ZTIO,ZTRTN,ZTDESC,ZTSAVE,ZTSK,ORCONREC
  1.  S ORCONREC=$G(DUZ),ZTSAVE("ORCONREC")=""
  1.  S ZTIO="",ZTRTN="START^ORY350B",ZTDESC="Find Consult Orders and Edit ID Field"
  1.  D ^%ZTLOAD
  1.  I +$G(ZTSK)>0 D BMES^XPDUTL("TASK "_$G(ZTSK)_" HAS BEEN QUEUED.")
  1.  I +$G(ZTSK)=0 D BMES^XPDUTL("Unable to queue the """_ZTDESC_""" task; file a Remedy ticket for assistance.")
  1.  Q
  1.  ;
  1. START ;start search for consult orders
  1.  D FINDORD
  1.  D SENDMAIL
  1.  Q
  1.  ;
  1. FINDORD ;find cons/proc orders and change OR GTX EARLIEST DATE item ID value from EARLIEST to CLINICALLY
  1.  N ORCOUNT S ORCOUNT=1
  1.  S ^TMP("OR350_EADID",$J,ORCOUNT)="This message contains a list of ORDER file (#100) IENs where the ID field",ORCOUNT=ORCOUNT+1
  1.  S ^TMP("OR350_EADID",$J,ORCOUNT)="was edited from EARLIEST to CLINICALLY for the OR GTX EARLIEST DATE Item Entry.",ORCOUNT=ORCOUNT+1
  1.  S ^TMP("OR350_EADID",$J,ORCOUNT)="Any unsuccessful edits are also captured and noted as such.",ORCOUNT=ORCOUNT+1
  1.  S ^TMP("OR350_EADID",$J,ORCOUNT)="For those orders, you may manually edit the ID field for the ",ORCOUNT=ORCOUNT+1
  1.  S ^TMP("OR350_EADID",$J,ORCOUNT)="OR GTX CLINICALLY INDICATED DATE Item Entry",ORCOUNT=ORCOUNT+1
  1.  S ^TMP("OR350_EADID",$J,ORCOUNT)="Change the value from EARLIEST to CLINICALLY.",ORCOUNT=ORCOUNT+1
  1.  S ^TMP("OR350_EADID",$J,ORCOUNT)="Submit a Remedy ticket if you need/prefer assistance with these edits.",ORCOUNT=ORCOUNT+1
  1.  S ^TMP("OR350_EADID",$J,ORCOUNT)="",ORCOUNT=ORCOUNT+1
  1.  N ORCON,ORPROC,ORIFN,ORDISGRP
  1.  S ORCON=$O(^ORD(100.98,"B","CONSULTS","")) Q:+$G(ORCON)'>0
  1.  S ORPROC=$O(^ORD(100.98,"B","PROCEDURES","")) Q:+$G(ORPROC)'>0
  1.  N ORDATE S ORDATE=3080701 ;start search before EARLIEST DATE was live (8/4/2010 first prod install)
  1.  N ORIDX S ORIDX=$Q(^OR(100,"AF",ORDATE))
  1.  F  S ORIDX=$Q(@ORIDX) Q:ORIDX'?1"^OR(100,""AF"",".E  D
  1.  .S ORIFN=$P(ORIDX,",",4) Q:+$G(ORIFN)'>0
  1.  .Q:$D(^OR(100,ORIFN,0))=0
  1.  .S ORDISGRP=$P(^OR(100,ORIFN,0),U,11) Q:+$G(ORDISGRP)'>0
  1.  .Q:(+$G(ORDISGRP)'=ORCON)&(+$G(ORDISGRP)'=ORPROC)
  1.  .D UPDATEID(ORIFN)
  1.  I ORCOUNT'>9 D
  1.  .S ^TMP("OR350_EADID",$J,ORCOUNT)="No orders found to edit.  If this is the first time this report has been run,",ORCOUNT=ORCOUNT+1
  1.  .S ^TMP("OR350_EADID",$J,ORCOUNT)="please submit a Remedy ticket for assistance.",ORCOUNT=ORCOUNT+1
  1.  Q
  1.  ;
  1. UPDATEID(ORDA) ;update ID value for order.  Change "EARLIEST" to "CLINICALLY"
  1.  Q:+$G(ORDA)'>0
  1.  N DIE,DA,DR,ORITEM S ORITEM=0
  1.  S DR=".04///CLINICALLY"
  1.  F  S ORITEM=$O(^OR(100,ORDA,4.5,ORITEM)) Q:+$G(ORITEM)'>0  D
  1.  .Q:$P(^OR(100,ORDA,4.5,ORITEM,0),U,4)'="EARLIEST"
  1.  .S DIE="^OR(100,"_ORDA_",4.5,",DA(1)=ORDA,DA=ORITEM
  1.  .L +^FILE(100,ORDA):0 I $T D ^DIE L -^FILE(100,ORDA) S ^TMP("OR350_EADID",$J,ORCOUNT)=ORDA,ORCOUNT=ORCOUNT+1 Q
  1.  .S ^TMP("OR350_EADID",$J,ORCOUNT)=ORDA_"^Could not lock file entry for edit",ORCOUNT=ORCOUNT+1
  1.  Q
  1.  ;
  1. SENDMAIL ;send message with list of edited orders
  1.  N XMSUB,XMTEXT,XMY,XMZ,XMDUZ,XMMG,DIFROM
  1.  S XMSUB="CONSULT ORDERS: ID FIELD EDIT"
  1.  S:$G(DUZ) XMY(DUZ)=""
  1.  S XMDUZ="OR*3.0*350 INSTALL"
  1.  S XMTEXT="^TMP(""OR350_EADID"",$J,"
  1.  D ^XMD
  1.  Q
  1.  ;
  1. DATA ; parameter data
  1.  ;;9345,"KEY")
  1.  ;;OR LAB TAB DEFAULT REPORT^1
  1.  ;;9345,"VAL")
  1.  ;;ORL MOST RECENT