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

ORY145.m

Go to the documentation of this file. 
  1. ORY145 ;SLC/DAN ;4/5/02  07:10
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**145**;Dec 17, 1997
  1.  ;DBIA 2058 allows read of B xref in DIC(9.4
  1.  ;DBIA 2197 allows reading of install file
  1.  ;
  1.  ;Set missing AE xref, fix incorrect package pointer, and fix incorrect display group (TO field).
  1.  ;
  1.  N ORMSG,ZTSK
  1.  S ORMSG(1)=""
  1.  S ORMSG(2)="Database clean up routine ORY145.  This routine will"
  1.  S ORMSG(3)="run in the background and will fix any known database errors."
  1.  S ORMSG(4)="It will then send a mail message to the initiator indicating what was changed."
  1.  S ORMSG(5)=""
  1.  D MES^XPDUTL(.ORMSG)
  1.  S ZTRTN="DQ^ORY145",ZTDESC="Patch OR*3*145 database clean up",ZTSAVE("DUZ")="",ZTIO=""
  1.  D ^%ZTLOAD
  1.  I $G(ZTSK) D MES^XPDUTL("ORY145 queued to background as task number "_ZTSK_".")
  1.  Q
  1.  ;
  1. DQ ;Enter here for queued task
  1.  N ERR
  1.  K ^TMP("ORFIX",$J)
  1.  D FIXES,FIXPPDG,MAIL
  1.  K ^TMP("ORFIX",$J),^TMP("ORTXT",$J)
  1.  Q
  1.  ;
  1. FIXES ;This section will add missing AE Xrefs from active orders
  1.  N CNT,PAT,DATE,IEN,PTNAME,STOPDT,DA,CURDT,LASTRUN
  1.  S CNT=0
  1.  S PAT=""
  1.  S LASTRUN=$$GET^XPAR("SYS","ORM ORMTIME LAST RUN",1,"I") ;last date/time ORMTIME ran
  1.  S CURDT=$S(LASTRUN'="":LASTRUN,1:$$NOW^XLFDT) ;Set CURDT to last run date/time or current date/time as appropriate
  1.  F  S PAT=$O(^OR(100,"AC",PAT)) Q:PAT=""  D
  1.  .S DATE=0 F  S DATE=$O(^OR(100,"AC",PAT,DATE)) Q:'+DATE  D
  1.  ..S IEN=0 F  S IEN=$O(^OR(100,"AC",PAT,DATE,IEN)) Q:'+IEN  D
  1.  ...Q:$$NMSP^ORCD($P($G(^OR(100,IEN,0)),U,14))'="PS"  ;quit if not pharmacy
  1.  ...I $O(^OR(100,IEN,8,1)) D CHKACT ;If more than one action check to make sure current action is correct
  1.  ...Q:$O(^OR(100,IEN,2,0))  ;No AE for parent orders
  1.  ...S PTNAME=$$PTNM(PAT) Q:PTNAME=-1  ;get patient name quit if referral or couldn't determine name
  1.  ...S STOPDT=+$P($G(^OR(100,IEN,0)),U,9) Q:'+STOPDT!(STOPDT'>CURDT)
  1.  ...Q:$D(^OR(100,"AE",STOPDT,IEN))  ;already has an AE xref
  1.  ...S DA=IEN
  1.  ...D ES^ORDD100A ;Sets AE xref if appropriate
  1.  ...I $D(^OR(100,"AE",STOPDT,IEN)) S ^TMP("ORFIX",$J,PTNAME,IEN,"ES")="",CNT=CNT+1
  1.  S ^TMP("ORFIX",$J,0)=CNT
  1.  Q
  1.  ;
  1. FIXPPDG ;This section will fix incorrect package pointer and display group problems.
  1.  N DATE,IEN,CNT,IPKG,OPKG,IDG,ODG,BADPKG,BADDG,OR0,PTNAME,PCLASS,PKG,TYPE,DG,DIK,DA,EDG,ADMITTED,ENTERED,DIC,DR,ORARRAY
  1.  S DATE=$$INSTDT("OR*3.0*94")
  1.  S DATE=$S(DATE:$$FMADD^XLFDT(DATE,-1,23,59),1:3000815.24) ;If install date not found revert back to 1st possible install date
  1.  S IEN=$$GETIEN(DATE)-1 ;Get first order number for date, subtract one so the first order is reviewed
  1.  I IEN=-1 S ERR="No orders in date range" Q  ;No orders to review
  1.  S CNT=0
  1.  S IPKG=$O(^DIC(9.4,"B","INPATIENT MEDICATIONS",0)) ;Inpatient meds package IEN
  1.  S OPKG=$O(^DIC(9.4,"B","OUTPATIENT PHARMACY",0)) ;Outpatient meds package IEN
  1.  S IDG=$O(^ORD(100.98,"B","UD RX",0)) ;Inpatient meds display group IEN
  1.  S ODG=$O(^ORD(100.98,"B","O RX",0)) ;Outpatient meds display group IEN
  1.  S BADPKG=$O(^DIC(9.4,"B","PHARMACY DATA MANAGEMENT",0)) ;Bad package IEN
  1.  S BADDG=$O(^ORD(100.98,"B","PHARMACY",0)) ;Bad display group IEN
  1.  I IPKG=""!(OPKG="")!(IDG="")!(ODG="")!(BADPKG="")!(BADDG="") S ERR="Package or display group file entries are missing from the local system." Q  ;missing values
  1.  F  S IEN=$O(^OR(100,IEN)) Q:'+IEN  D
  1.  .S OR0=$G(^OR(100,IEN,0)) Q:OR0=""  ;Missing 0 node
  1.  .S PKG=$P(OR0,U,14) ;Current package
  1.  .I $$NMSP^ORCD(PKG)'="PS" Q  ;Originating package should be a pharmacy type
  1.  .S DG=$P(OR0,U,11) ;Current display group (TO field)
  1.  .I PKG=BADPKG!(DG=BADDG) D  S CNT=CNT+1
  1.  ..S DIC=9.4,DR=".01",DA=PKG,DIQ="ORARRAY" D EN^DIQ1 S PKGN=ORARRAY(9.4,DA,.01) K DIC,DR,DA,DIQ,ORARRAY
  1.  ..S DIC=100.98,DR=".01",DA=DG,DIQ="ORARRAY" D EN^DIQ1 S DGN=ORARRAY(100.98,DA,.01) K DIC,DR,DA,DIQ,ORARRAY
  1.  ..S PTNAME=$$PTNM($P(OR0,U,2))
  1.  ..I PTNAME=-1 Q  ;either patient is referral or is missing
  1.  ..S PCLASS=$P(OR0,U,12)
  1.  ..S TYPE=$S($$VALUE^ORX8(IEN,"REFILLS")'="":"OUT",1:"IN") ;Sets type of order to outpatient if there are refills, else inpatient
  1.  ..I TYPE="OUT" D
  1.  ...I PCLASS'="O" S ^TMP("ORFIX",$J,PTNAME,IEN,"PC")="INPATIENT to OUTPATIENT" S $P(^OR(100,IEN,0),U,12)="O"
  1.  ...I PKG'=OPKG S ^TMP("ORFIX",$J,PTNAME,IEN,"PKG")="from "_PKGN_" to OUTPATIENT PHARMACY" S $P(^OR(100,IEN,0),U,14)=OPKG
  1.  ...I DG'=ODG S ^TMP("ORFIX",$J,PTNAME,IEN,"DG")="from "_DGN_" to O RX" D XREF(IEN,DG,ODG) ;Re-index display group field
  1.  ..;
  1.  ..I TYPE="IN" D
  1.  ...S ENTERED=$P(OR0,U,7) ;Date order entered
  1.  ...S ADMITTED=$$ADM(IEN,ENTERED)
  1.  ...I ADMITTED=-1 Q  ;unable to detemine patient status
  1.  ...I PCLASS'="I" S ^TMP("ORFIX",$J,PTNAME,IEN,"PC")="OUTPATIENT to INPATIENT" S $P(^OR(100,IEN,0),U,12)="I"
  1.  ...I PKG'=IPKG S ^TMP("ORFIX",$J,PTNAME,IEN,"PKG")="from "_PKGN_" to INPATIENT MEDICATIONS" S $P(^OR(100,IEN,0),U,14)=IPKG
  1.  ...S EDG=$S(ADMITTED:IDG,1:ODG) ;Expected display group
  1.  ...I DG'=EDG S ^TMP("ORFIX",$J,PTNAME,IEN,"DG")="from "_DGN_" to "_$S(ADMITTED:"UD RX",1:"O RX") D XREF(IEN,DG,EDG) ;Re-index display group
  1.  S $P(^TMP("ORFIX",$J,0),U,2)=CNT
  1.  Q
  1.  ;
  1. GETIEN(STDT) ;Find first IEN associated with given start date
  1.  N DONE,IEN
  1.  S (DONE,IEN)=0
  1.  F  S STDT=$O(^OR(100,"AF",STDT)) Q:'+STDT!(DONE)  D
  1.  .S IEN=0 F  S IEN=$O(^OR(100,"AF",STDT,IEN)) Q:'+IEN  I $O(^(IEN,0))=1 S DONE=1 Q  ;Find first ORDER that is a new order
  1.  Q IEN
  1.  ;
  1. MAIL ;Send results of cleanup in a mail message to initiator
  1.  N I,XMSUB,XMTEXT,XMDUZ,XMY
  1.  S XMSUB="Patch OR*3*145 Clean up completed"
  1.  S XMDUZ="Patch OR*3*145 Background job"
  1.  S XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
  1.  S XMTEXT="^TMP(""ORTXT"",$J,"
  1.  K ^TMP("ORTXT",$J)
  1.  S I=1
  1.  S ^TMP("ORTXT",$J,I)="The database clean-up for patch OR*3*145 has completed.",I=I+1
  1.  S ^TMP("ORTXT",$J,I)="Below is a listing of what was changed and any possible error messages.",I=I+1
  1.  S ^TMP("ORTXT",$J,I)="",I=I+1
  1.  S ^TMP("ORTXT",$J,I)=+$P($G(^TMP("ORFIX",$J,0)),U)_" orders had AE cross references added.",I=I+1
  1.  S ^TMP("ORTXT",$J,I)=+$P($G(^TMP("ORFIX",$J,0)),U,2)_" orders had their package, display group, or patient class changed.",I=I+1
  1.  S ^TMP("ORTXT",$J,I)="",I=I+1
  1.  I $D(ERR) D
  1.  .S ^TMP("ORTXT",$J,I)="An error occurred that stopped the package and display group check.",I=I+1
  1.  .S ^TMP("ORTXT",$J,I)="Please log a NOIS and indicate that you received the following error:",I=I+1
  1.  .S ^TMP("ORTXT",$J,I)=ERR,I=I+1
  1.  .S ^TMP("ORTXT",$J,I)="",I=I+1
  1.  .S ^TMP("ORTXT",$J,I)="If any AE cross references were added you will still see the results below.",I=I+1
  1.  I '$D(ERR) I $G(^TMP("ORFIX",$J,0))="0^0" S ^TMP("ORTXT",$J,I)="No changes were made to your database.",I=I+1
  1.  S ^TMP("ORTXT",$J,I)="",I=I+1
  1.  S PAT=0 F  S PAT=$O(^TMP("ORFIX",$J,PAT)) Q:PAT=""  D
  1.  .S ^TMP("ORTXT",$J,I)=PAT,I=I+1
  1.  .S ORD=0 F  S ORD=$O(^TMP("ORFIX",$J,PAT,ORD)) Q:ORD=""  D
  1.  ..S ^TMP("ORTXT",$J,I)="   ORDER #: "_ORD,I=I+1
  1.  ..F J="ES","DG","PKG","PC" I $D(^TMP("ORFIX",$J,PAT,ORD,J)) D
  1.  ...S ^TMP("ORTXT",$J,I)="      "_$S(J="ES":"Added AE cross reference ",J="PKG":"Changed package ",J="DG":"Changed display group ",1:"Changed patient class from ")
  1.  ...S ^TMP("ORTXT",$J,I)=$G(^TMP("ORTXT",$J,I))_$G(^TMP("ORFIX",$J,PAT,ORD,J))
  1.  ...S I=I+1
  1.  .S ^TMP("ORTXT",$J,I)="",I=I+1
  1.  D ^XMD ;send results
  1.  Q
  1.  ;
  1. INSTDT(PATCH) ;Returns installation date patch first installed at site
  1.  N IEN
  1.  S IEN=$O(^XPD(9.7,"B",PATCH,0)) Q:'+IEN 0 ;Get IEN of first installation
  1.  Q $P($P($G(^XPD(9.7,IEN,1)),U),".")  ;Get date of first install
  1.  ;
  1. ADM(IEN,ENTERED) ;Determine if patient was inpatient when order was entered
  1.  ;returns 1 if inpat, 0 if not inpat, -1 if no DFN or object of order is from referral patient file
  1.  N DFN,VAIN,VAINDT
  1.  S DFN=$P($G(^OR(100,IEN,0)),U,2) ;get object of order
  1.  I +DFN=0!(DFN'["DPT") Q -1  ;No DFN found or not from patient file
  1.  S DFN=+DFN
  1.  S VAINDT=ENTERED
  1.  D INP^VADPT
  1.  Q $S($G(VAIN(1)):1,1:0)  ;If VAIN(1) has a value then patient was an inpatient
  1.  ;
  1. PTNM(IEN) ;Return pt name or -1 if unable to determine
  1.  N DFN,VADM
  1.  I +IEN=0!(IEN'["DPT") Q -1
  1.  S DFN=+IEN
  1.  D ^VADPT
  1.  I $G(VADM(1))="" Q -1
  1.  Q $G(VADM(1))
  1.  ;
  1. XREF(IEN,DG,NDG) ;Update xrefs for TO field
  1.  N DA,DIE,DR
  1.  K ^OR(100,"AW",$P(OR0,U,2),DG,$S($P(OR0,U,8):$P(OR0,U,8),1:9999999),IEN)
  1.  S DIE=100,DA=IEN,DR="23///"_NDG D ^DIE
  1.  Q
  1.  ;
  1. CHKACT ;Compares current action field with actual current action and updates if necessary
  1.  N CURACT,I,ACT
  1.  S CURACT=$P(^OR(100,IEN,3),U,7) Q:'CURACT
  1.  S I="?" F  S I=$O(^OR(100,IEN,8,I),-1) Q:'+I  I $P(^(I,0),U,15)="" S ACT=I Q
  1.  Q:'$D(ACT)  ;Active action not found
  1.  I CURACT'=ACT S $P(^OR(100,IEN,3),U,7)=ACT D SETALL^ORDD100(IEN)
  1.  Q