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

PXRMORCH.m

Go to the documentation of this file. 
  1. PXRMORCH ;SLC/AGP - Reminder Order Checks API;05/14/2014
  1.  ;;2.0;CLINICAL REMINDERS;**16,22,26**;Feb 04, 2005;Build 404
  1.  ;
  1.  Q
  1.  ;
  1. GETOCTXT(DFN,IEN,OI,SEV,PNAME,SUB,CNT) ;Get the Order Check text from
  1.  ;rule IEN.
  1.  N LC,NFL,NIN,NOUT,PXRMRM,TEXTIN,TEXTOUT
  1.  ;If formatted text is stored just copy it.
  1.  S NFL=$P(^PXD(801.1,IEN,5),U,2)
  1.  I NFL>0 D  Q
  1.  . F LC=1:1:NFL S CNT=CNT+1,^TMP($J,SUB,SEV,PNAME,CNT)=^PXD(801.1,IEN,6,LC,0)
  1.  ;
  1.  ;If there is no formatted text then the Order Check Text contains a
  1.  ;TIU Object so call the Found/Not Found Text expansion.
  1.  S NIN=$P(^PXD(801.1,IEN,5),U,1)
  1.  F LC=1:1:NIN S TEXTIN(LC)=^PXD(801.1,IEN,4,LC,0)
  1.  S PXRMRM=80,NOUT=0
  1.  D FNFTXTO^PXRMFNFT(1,NIN,.TEXTIN,DFN,"",.NOUT,.TEXTOUT)
  1.  F LC=1:1:NOUT S CNT=CNT+1,^TMP($J,SUB,SEV,PNAME,CNT)=TEXTOUT(LC)
  1.  Q
  1.  ;
  1. ADDRULES(TYPE,ITEM,LIST) ;
  1.  I ITEM'>0 Q
  1.  N IEN S IEN=0
  1.  F  S IEN=$O(^PXD(801,"ADRUGR",TYPE,ITEM,IEN)) Q:IEN'>0  S LIST(IEN)=""
  1.  Q
  1.  ;
  1. GETDRUG(DRGIEN,OI,LIST) ;
  1.  ;add rules assigned to the drug
  1.  D ADDRULES("DR",DRGIEN,.LIST)
  1.  ;get drug information DBIA 4533
  1.  D DATA^PSS50(DRGIEN,,DT,,,"PXRM DRUG")
  1.  I $G(^TMP($J,"PXRM DRUG",0))'>0 Q
  1.  ;add rules assigned to VA Generic
  1.  D ADDRULES("DG",$P($G(^TMP($J,"PXRM DRUG",DRGIEN,20)),U),.LIST)
  1.  ;add rules assigned to VA Drug Class
  1.  D ADDRULES("DC",$P($G(^TMP($J,"PXRM DRUG",DRGIEN,25)),U),.LIST)
  1.  I OI>0 Q
  1.  ;get OI from DRUG
  1.  N IEN,PSOI
  1.  S PSOI=+$G(^TMP($J,"PXRM DRUG",DRGIEN,2.1)) I PSOI'>0 Q
  1.  S OI=$$OITM^ORX8(PSOI,"99PSP") I OI'>0 Q
  1.  S IEN=0 F  S IEN=$O(^PXD(801,"AOIR",OI,IEN)) Q:IEN'>0  S LIST(IEN)=""
  1.  Q
  1.  ;
  1. GETRULES(OI,DRUG,LIST) ;
  1.  ;get rules for OI
  1.  N DRGIEN,IEN,OIID
  1.  I OI>0 S IEN=0 F  S IEN=$O(^PXD(801,"AOIR",OI,IEN)) Q:IEN'>0  S LIST(IEN)=""
  1.  ;detemine if pharmacy OI
  1.  I OI>0 S OIID=$P($G(^ORD(101.43,OI,0)),U,2) I OIID'["PSP" Q
  1.  K ^TMP($J,"PXRM DRUG LIST"),^TMP($J,"PXRM DRUG")
  1.  I DRUG>0 D GETDRUG(DRUG,OI,.LIST) G GETRULEX
  1.  ;get drug(s) assocaited with the OI DBIA 4662
  1.  D DRGIEN^PSS50P7(+OIID,DT,"PXRM DRUG LIST")
  1.  I $G(^TMP($J,"PXRM DRUG LIST",0))'>0 Q
  1.  S DRGIEN=0
  1.  F  S DRGIEN=$O(^TMP($J,"PXRM DRUG LIST",DRGIEN)) Q:DRGIEN'>0  D GETDRUG(DRGIEN,OI,.LIST)
  1. GETRULEX ;
  1.  K ^TMP($J,"PXRM DRUG LIST"),^TMP($J,"PXRM DRUG")
  1.  Q
  1.  ;
  1. ORDERCHK(DFN,OI,TEST,DRUG,TESTER) ;
  1.  ;main order check API
  1.  ;Input
  1.  ;  OI=IEN of Orderable Item from file 101.43
  1.  ;  DFN=Patient DFN
  1.  ;  TEST=Value that matches the Testing Flag either 1 or 0
  1.  ;
  1.  ;Output
  1.  ;  ^TMP($J,OI,SEV,DISPLAY NAME,n)=TEXT
  1.  ;  SEV=is the value assigned to the severity field
  1.  ;  DISPLAY NAME=is the value assigned to the Display Field Name
  1.  ;
  1.  ;K ^TMP($J,OI)
  1.  N CNT,FLAG,IEN,IENOI,IENR,NODE,NUM,OIREM,PNAME,RIEN,RNAME
  1.  N RULES,REMEVLST,RSTAT,SEV,SUB,TEXTTYPE,TIEN,TNAME,TSTAT
  1.  ;
  1.  ;loop through AOIR xref to find the group IEN and the corresponding
  1.  ;Rules assigned to the orderable item
  1.  ;
  1.  S SUB=$S(DRUG>0:DRUG,1:OI)
  1.  K ^TMP($J,SUB)
  1.  D GETRULES(OI,DRUG,.RULES)
  1.  S IEN=0 F  S IEN=$O(RULES(IEN)) Q:IEN'>0  D
  1.  .S NODE=$G(^PXD(801.1,IEN,0))
  1.  .S FLAG=$P(NODE,U,3)
  1.  .I FLAG="I" Q
  1.  .I TEST=1,FLAG="P" Q
  1.  .I TEST=0,FLAG="T" Q
  1.  .;S PNAME=IEN_U_$P(NODE,U,2)
  1.  .S PNAME=$P(NODE,U,2)
  1.  .S SEV=$P(NODE,U,5)
  1.  .S TIEN=$P($G(^PXD(801.1,IEN,2)),U)
  1.  .;
  1.  .;Reminder Term defined used branching logic code
  1.  .I TIEN>0 D  Q
  1.  ..S TSTAT=$$TERM^PXRMDLLB(TIEN,DFN,IEN,"O")
  1.  ..S CNT=0
  1.  ..I $D(^XTMP("PXRM_DISEV",0)) D  Q
  1.  ...S CNT=CNT+1,^TMP($J,SUB,SEV,PNAME,CNT)="Clinical Reminder evaluation is currently disabled; this order check cannot"
  1.  ...S CNT=CNT+1,^TMP($J,SUB,SEV,PNAME,CNT)="be processed." Q
  1.  ..I TESTER=1 D
  1.  ...S TNAME=$P(^PXRMD(811.5,TIEN,0),U)
  1.  ...S CNT=CNT+1,^TMP($J,SUB,3,PNAME,CNT)="INTERNAL: Reminder Term: "_TNAME_" Status: "_$S(TSTAT=1:"True",1:"False")
  1.  ...;S CNT=CNT+1,^TMP($J,SUB,SEV,PNAME,CNT)=" "
  1.  ..I TSTAT'=$P(^PXD(801.1,IEN,2),U,2) D  Q
  1.  ...I TESTER=1 D
  1.  ....S CNT=CNT+1,^TMP($J,SUB,SEV,PNAME,CNT)="RULE FAILED"
  1.  ....S CNT=CNT+1,^TMP($J,SUB,SEV,PNAME,CNT)=" "
  1.  ..;load order check text needs to be converted
  1.  ..D GETOCTXT(DFN,IEN,OI,SEV,PNAME,SUB,.CNT)
  1.  .;if not TERM do reminder evaluation
  1.  .S NODE=$G(^PXD(801.1,IEN,3))
  1.  .S RIEN=$P(NODE,U),RSTAT=$P(NODE,U,2),TEXTTYPE=$P(NODE,U,3)
  1.  .S NODE=$G(^PXD(811.9,RIEN,0))
  1.  .;
  1.  .S RNAME=$S($P(NODE,U,3)'="":$P(NODE,U,3),1:$P(NODE,U))
  1.  .D REMEVAL(DFN,OI,RIEN,PNAME,IEN,RNAME,TEXTTYPE,RSTAT,SEV,SUB,TESTER)
  1.  Q
  1.  ;
  1.  ;
  1. REMEVAL(DFN,OI,RIEN,PNAME,IEN,RNAME,TEXTTYE,RSTAT,SEV,SUB,TESTER) ;
  1.  ;used by ORDECHK this does the reminder evaluation and put the
  1.  ;reminder text in the temp global
  1.  K ^TMP("PXRHM",$J),^TMP("PXRMORTMP",$J)
  1.  N CNT,NUM,STATUS
  1.  S CNT=0
  1.  ;
  1.  ;standard reminder evaluation results, final output like the
  1.  ;HS COMPONENT REMINDER FINDINGS
  1.  ;
  1.  D MAIN^PXRM(DFN,RIEN,55,1)
  1.  S STATUS=$P($G(^TMP("PXRHM",$J,RIEN,RNAME)),U)
  1.  I TESTER=1 D
  1.  .S CNT=CNT+1,^TMP($J,SUB,SEV,PNAME,CNT)="INTERNAL: Reminder Definition: "_RNAME_" Status: "_STATUS
  1.  .;S CNT=CNT+1,^TMP($J,SUB,SEV,PNAME,CNT)=" "
  1.  ;if not valid status return error message
  1.  I (STATUS="CNBD")!(STATUS="ERROR") D  Q
  1.  .S CNT=CNT+1,^TMP($J,SUB,3,PNAME,CNT)="Clinical Reminder evaluation is currently disabled; this order check cannot"
  1.  .S CNT=CNT+1,^TMP($J,SUB,3,PNAME,CNT)="be processed."
  1.  ;if Reminder Status does not match status field quit.
  1.  I $$STATMTCH(STATUS,RSTAT)=0 D  Q
  1.  .I TESTER=1 D
  1.  ..S CNT=CNT+1,^TMP($J,SUB,SEV,PNAME,CNT)="RULE FAILED"
  1.  ..S CNT=CNT+1,^TMP($J,SUB,SEV,PNAME,CNT)=" "
  1.  ;save off the evaluation temp global into another global. This
  1.  ;prevent a problem with TIU Objects for reminder evaluation
  1.  M ^TMP("PXRMORTMP",$J)=^TMP("PXRHM",$J)
  1.  ;
  1.  S NUM=0
  1.  ;load order check text if requested
  1.  I TEXTTYPE="O"!(TEXTTYPE="B") D GETOCTXT(DFN,IEN,OI,SEV,PNAME,SUB,.CNT)
  1.  I TEXTTYPE="O" Q
  1.  ;
  1.  I TEXTTYPE="B" S CNT=CNT+1,^TMP($J,SUB,SEV,PNAME,CNT)=""
  1.  ;build reminder text if requested
  1.  F  S NUM=$O(^TMP("PXRMORTMP",$J,RIEN,RNAME,"TXT",NUM)) Q:NUM'>0  D
  1.  .S CNT=CNT+1
  1.  .S ^TMP($J,SUB,SEV,PNAME,CNT)=$G(^TMP("PXRMORTMP",$J,RIEN,RNAME,"TXT",NUM))
  1.  K ^TMP("PXRHM",$J),^TMP("PXRMORTMP",$J)
  1.  Q
  1.  ;
  1. STATMTCH(REMSTAT,RULESTAT) ;
  1.  I RULESTAT="D",REMSTAT["DUE" Q 1
  1.  I RULESTAT="A",REMSTAT'="N/A",REMSTAT'="NEVER" Q 1
  1.  I RULESTAT="N",$E(REMSTAT,1)="N" Q 1
  1.  Q 0
  1.  ;