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

PXRMORXR.m

Go to the documentation of this file. 
  1. PXRMORXR ; SLC/AGP - Reminder Order Checks XREF;01/27/2012
  1.  ;;2.0;CLINICAL REMINDERS;**16,22**;Feb 04, 2005;Build 160
  1.  ;
  1.  Q
  1.  ;
  1.  ;for the rules X(1)=RULE NAME, X(2)=ACTIVE FLAG, X(3)=TESTING FLAG
  1.  ;
  1. DELDRCL(IENS,OLD) ;
  1.  ;This subroutine allows users to add delete orderable item that are
  1.  ;THIS IS NO LONGER NEEDED AFTER PATCH 22 IS INSTALLED
  1.  I IENS(1)="" Q
  1.  I $G(PXRMDALL)=1 Q
  1.  I $G(DIUTIL)="VERIFY FIELDS" Q
  1.  I $G(OLD)="" Q
  1.  Q
  1.  ;
  1.  ;FORMAT OF XREF ^PXD(801,"AOIR",OI,TEST,GIEN,RULEIEN)=""
  1. XREFCHK ;
  1.  N ACTIVE,CNT,GIEN,GNAME,OI,OINAME,OUTPUT,RIEN,RNAME,RULES,TEST,TEXTIN
  1.  ;start from AOIR xref
  1.  S CNT=0,OI=0
  1.  F  S OI=$O(^PXD(801,"AOIR",OI)) Q:OI'>0  D
  1.  .S OINAME=$P(^ORD(101.43,OI,0),U)
  1.  .I '$D(^PXD(801,"O",OI)) D  Q
  1.  ..K TEXTIN
  1.  ..S TEXTIN(1)="Orderable item : "_OINAME_" does not exist in the Reminder Orderable Item Group file."
  1.  ..D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
  1.  .S RIEN=0
  1.  .F  S RIEN=$O(^PXD(801,"AOIR",OI,RIEN)) Q:RIEN'>0  D
  1.  ..D CHKRULE(RIEN,.CNT,.OUTPUT)
  1.  ..S GIEN=0 F  S GIEN=$O(^PXD(801,"AOIR",OI,RIEN,GIEN)) Q:GIEN'>0  D
  1.  ...I '$D(^PXD(801,GIEN)) D  Q
  1.  ....K TEXTIN
  1.  ....S TEXTIN(1)="Reminder Orderable Item Group IEN "_GIEN_" does not exist in the file."  Q
  1.  ....D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
  1.  ;
  1.  ;from the ADRUGR cross-reference
  1.  N IEN,PHARMITM,TYPE
  1.  S TYPE="" F  S TYPE=$O(^PXD(801,"ADRUGR",TYPE)) Q:TYPE=""  D
  1.  .S IEN=0 F  S IEN=$O(^PXD(801,"ADRUGR",TYPE,IEN)) Q:IEN'>0  D
  1.  ..S PHARMITM(TYPE,IEN)=""
  1.  ..S RIEN=0 F  S RIEN=$O(^PXD(801,"ADRUGR",TYPE,IEN,RIEN)) Q:RIEN'>0  D
  1.  ...D CHKRULE(RIEN,.CNT,.OUTPUT)
  1.  ...S GIEN=0
  1.  ...F  S GIEN=$O(^PXD(801,"ADRUG",TYPE,IEN,RIEN,GIEN)) Q:GIEN'>0  D
  1.  ....I '$D(^PXD(801,GIEN)) D  Q
  1.  .....K TEXTIN
  1.  .....S TEXTIN(1)="Reminder Orderable Item Group IEN "_GIEN_" does not exist in the file."  Q
  1.  .....D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
  1.  ....D CHKGDR(GIEN,.PHARMITM,.CNT,.OUTPUT)
  1.  ;
  1.  ;check from file structure
  1.  S GIEN=0 F  S GIEN=$O(^PXD(801,GIEN)) Q:GIEN'>0  D
  1.  .;build list of rules
  1.  .S RIEN=0 F  S RIEN=$O(^PXD(801,GIEN,3,RIEN)) Q:RIEN'>0  S RULES(RIEN)=""
  1.  .;loop OI multiple for each OI
  1.  .S OI=0 F  S OI=$O(^PXD(801,GIEN,2,"B",OI)) Q:OI'>0  D
  1.  ..D CHKXFRF(GIEN,OI,"AOIR",.RULES)
  1.  ;
  1.  ;write out the output
  1.  I '$D(OUTPUT) W !,"No errors found" Q
  1.  S CNT=0 F  S CNT=$O(OUTPUT(CNT)) Q:CNT'>0  W !,OUTPUT(CNT)
  1.  Q
  1.  ;
  1. BUILDMSG(NIN,TEXTIN,CNT,MESS) ;
  1.  N LINE,NOUT,TEXTOUT
  1.  D FORMAT^PXRMTEXT(1,75,NIN,.TEXTIN,.NOUT,.TEXTOUT)
  1.  S CNT=CNT+1,MESS(CNT)=""
  1.  F LINE=1:1:NOUT S CNT=CNT+1,MESS(CNT)=TEXTOUT(LINE)
  1.  Q
  1.  ;
  1. CHKXFRF(GIEN,ITEM,NODE,RULES) ;
  1.  N IEN,NAME,PIEN,TYPE
  1.  I ITEM[";" D  I TYPE="" Q
  1.  .S TYPE=$S(ITEM["PSDRUG":"DR",ITEM["PSNDF(50.6":"DG",ITEM["PS(50.605":"DC",1:"")
  1.  .S PIEN=+ITEM
  1.  S IEN=0 F  S IEN=$O(RULES(IEN)) Q:IEN'>0  D
  1.  .I NODE="AOIR" D  Q
  1.  ..I $D(^PXD(801,"AOIR",ITEM,RIEN,GIEN)) D
  1.  ...K TEXTIN
  1.  ...S TEXTIN(1)="ERROR IN AOIR CROSS-REFERENCE"
  1.  ...S TEXTIN(2)="Rule ien: "_IEN_", OI ien: "_ITEM_", Group IEN: "_GIEN
  1.  ...S TEXTIN(3)=" does not exist in the AOIR xref"
  1.  ...D BUILDMSG(3,.TEXTIN,.CNT,.OUTPUT)
  1.  .I $D(^PXD(801,"ADRUGR",TYPE,PIEN,RIEN,GIEN)) Q
  1.  .K TEXTIN
  1.  .S TEXTIN(1)="ERROR IN ADRUGR CROSS-REFERENCE"
  1.  .S TEXTIN(2)="Rule ien: "_IEN_", Item ien: "_ITEM_", Group IEN: "_GIEN
  1.  .S TEXTIN(3)=" does not exist in the ADRUGR xref"
  1.  .D BUILDMSG(3,.TEXTIN,.CNT,.OUTPUT)
  1.  Q
  1.  ;
  1. CHKGDR(GIEN,PHARMITM,CNT,OUTPUT) ;
  1.  N GNAME,IEN,ITEM,TYPE
  1.  S GNAME=$P(^PXD(801,GIEN,0),U)
  1.  S TYPE="" F  S TYPE=$O(PHARMITM(TYPE)) Q:TYPE=""  D
  1.  .S IEN=0 F  S IEN=$O(PHARMITM(TYPE,IEN)) Q:IEN'>0  D
  1.  ..S ITEM=IEN_$S(TYPE="DR":";PSDRUG(",TYPE="DC":";PS(50.605",TYPE="DG":";PSNDF(50.6,",1:"")
  1.  ..I ITEM'[";" Q
  1.  ..I $D(^PXD(801,GIEN,1.5,"B",ITEM)) Q
  1.  ..S TEXTIN(1)="Item: "_ITEM_" does not exist in the Reminder Orderable Item Group File entry."
  1.  ..D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
  1.  Q
  1.  ;
  1. CHKRULE(RIEN,CNT,OUTPUT) ;
  1.  N NODE,RNAME,TEXTIN
  1.  I $D(^PXD(801.1,RIEN)) Q
  1.  S TEXTIN(1)="Rule Ien: "_RIEN_" does not exist in the Reminder Order Check Rule File entry."
  1.  D BUILDMSG(1,.TEXTIN,.CNT,.OUTPUT)
  1.  Q
  1.  ;
  1. DRUGKILL(DA,OLD) ;
  1.  N IEN,RIEN,TYPE
  1.  S TYPE=$S(OLD["PSDRUG":"DR",OLD["PSNDF(50.6":"DG",OLD["PS(50.605":"DC",1:"")
  1.  I TYPE="" Q
  1.  S IEN=0 F  S IEN=$O(^PXD(801,DA(1),3,IEN)) Q:IEN'>0  D
  1.  .S RIEN=$P($G(^PXD(801,DA(1),3,IEN,0)),U) I +RIEN'>0 Q
  1.  .I $D(^PXD(801,"ADRUGR",TYPE,+OLD,RIEN,DA(1))) K ^PXD(801,"ADRUGR",TYPE,+OLD,RIEN,DA(1))
  1.  Q
  1.  ;
  1. DRUGSET(DA,NEW) ;
  1.  N RIEN,TYPE
  1.  ;I '$D(^PXD(801,DA(1),3)) Q
  1.  S TYPE=$S(NEW["PSDRUG":"DR",NEW["PSNDF(50.6":"DG",NEW["PS(50.605":"DC",1:"")
  1.  I TYPE="" Q
  1.  S RIEN=0 F  S RIEN=$O(^PXD(801,DA(1),3,"B",RIEN)) Q:RIEN'>0  D
  1.  .S ^PXD(801,"ADRUGR",TYPE,+NEW,RIEN,DA(1))=""
  1.  Q
  1.  ;
  1. OIKAOI(DA,OLD) ;
  1.  N IEN,RIEN
  1.  ;I '$D(^PXD(801,DA(1),3)) Q
  1.  S IEN=0 F  S IEN=$O(^PXD(801,DA(1),3,IEN)) Q:IEN'>0  D
  1.  .S RIEN=$P($G(^PXD(801,DA(1),3,IEN,0)),U) I +RIEN'>0 Q
  1.  .I $D(^PXD(801,"AOIR",OLD,RIEN,DA(1))) K ^PXD(801,"AOIR",OLD,RIEN,DA(1))
  1.  Q
  1.  ;
  1. OISAOI(DA,NEW) ;
  1.  N RIEN
  1.  ;I '$D(^PXD(801,DA(1),3)) Q
  1.  S RIEN=0 F  S RIEN=$O(^PXD(801,DA(1),3,"B",RIEN)) Q:RIEN'>0  D
  1.  .S ^PXD(801,"AOIR",NEW,RIEN,DA(1))=""
  1.  Q
  1.  ;
  1. RULEKAOI(DA,OLD) ;
  1.  ;I OLD(1)=""!(OLD(2)="")!(OLD(3)="") Q
  1.  N DIEN,OI,TYPE
  1.  ;kill OI index off
  1.  S OI=0 F  S OI=$O(^PXD(801,DA(1),2,"B",OI)) Q:OI'>0  D
  1.  .I $D(^PXD(801,"AOIR",OI,OLD(1),DA(1))) K ^PXD(801,"AOIR",OI,OLD(1),DA(1))
  1.  ; kill Drug Item Index off
  1.  S DIEN="" F  S DIEN=$O(^PXD(801,DA(1),1.5,"B",DIEN)) Q:DIEN=""  D
  1.  .S TYPE=$S(DIEN["PSDRUG":"DR",DIEN["PSNDF(50.6":"DG",DIEN["PS(50.605":"DC",1:"")
  1.  .I TYPE="" Q
  1.  .I $D(^PXD(801,"ADRUGR",TYPE,+DIEN,OLD(1),DA(1))) K ^PXD(801,"ADRUGR",TYPE,+DIEN,OLD(1),DA(1))
  1.  Q
  1.  ;
  1. RULESAOI(DA,NEW) ;
  1.  N DIEN,OI,TYPE
  1.  ;set OI index
  1.  S OI=0 F  S OI=$O(^PXD(801,DA(1),2,"B",OI)) Q:OI'>0  D
  1.  .S ^PXD(801,"AOIR",OI,NEW(1),DA(1))=""
  1.  ;set Drug Item Index
  1.  S DIEN="" F  S DIEN=$O(^PXD(801,DA(1),1.5,"B",DIEN)) Q:DIEN=""  D
  1.  .S TYPE=$S(DIEN["PSDRUG":"DR",DIEN["PSNDF(50.6":"DG",DIEN["PS(50.605":"DC",1:"")
  1.  .I TYPE="" Q
  1.  .S ^PXD(801,"ADRUGR",TYPE,+DIEN,NEW(1),DA(1))=""
  1.  Q
  1.  ;
  1. TESTER ;
  1.  N CNT,DFN,DIC,DIROUT,DIRUT,DRUG,DTOUT,DUOUT,NAME,OI,ONAME,SEV,SUB,TEST
  1.  S DIC=2,DIC("A")="Select Patient: ",DIC(0)="AEQMZ" D ^DIC
  1.  I $D(DIROUT)!($D(DIRUT)) Q
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  S OI=0,DRUG=0
  1.  S DFN=+$P(Y,U)
  1.  W !,"Select an Orderable Item or press ENTER to select a Drug."
  1.  S DIC=101.43,DIC("A")="Select Orderable Item: ",DIC(0)="AEQMZ" D ^DIC
  1.  I $D(DIROUT)!($D(DIRUT)) Q
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  S OI=+$P(Y,U)
  1.  I +OI'>0 D
  1.  .S DIC=50,DIC("A")="Select Drug: ",DIC(0)="AEQMZ" D ^DIC
  1.  .I $D(DIROUT)!($D(DIRUT)) Q
  1.  .I $D(DTOUT)!($D(DUOUT)) Q
  1.  .S DRUG=+$P(Y,U)
  1.  I OI'>0,DRUG'>0 W !,"An Orderable Item or a Drug is required." Q
  1.  W !!
  1.  S SUB=$S(DRUG>0:DRUG,1:OI)
  1.  F TEST=0:1:1 D
  1.  .D ORDERCHK^PXRMORCH(DFN,OI,TEST,DRUG,1)
  1.  .I '$D(^TMP($J,SUB)) W !,"No "_$S(TEST=0:"Production Rules",1:"Testing Rules")_" found." Q
  1.  .W !,$S(TEST=0:"Production Rules:",1:"Testing Rules:")
  1.  .F SEV=3,2,1 D
  1.  ..I '$D(^TMP($J,SUB,SEV)) W !,"No rules with a severity of "_$S(SEV=1:"High",SEV=2:"Medium",1:"Low")_" found." Q
  1.  ..W !,$S(SEV=1:"High",SEV=2:"Medium",1:"Low")_" Severity Results:"
  1.  ..S ONAME="",NAME=""
  1.  ..F  S NAME=$O(^TMP($J,SUB,SEV,NAME)) Q:NAME=""  D
  1.  ...I NAME'=ONAME S ONAME=NAME W !!,NAME
  1.  ...S CNT=0 F  S CNT=$O(^TMP($J,SUB,SEV,NAME,CNT)) Q:CNT'>0  D
  1.  ....W !,^TMP($J,SUB,SEV,NAME,CNT)
  1.  Q
  1.  ;