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

PXRMCEOC.m

Go to the documentation of this file. 
  1. PXRMCEOC ;SLC/AGP - Computed findings for WH project ;06/27/2018
  1.  ;;2.0;CLINICAL REMINDERS;**45**;Feb 4, 2005;Build 566
  1.  ;
  1. EPISODE(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
  1.  ;
  1.  N DIR,DTE,IEN,NAME,OPENONLY
  1.  S NFOUND=0
  1.  S NAME=$P(TEST,":"),OPENONLY=$S($P(TEST,":",2)="OPEN":1,1:0)
  1.  I NAME="" Q
  1.  I '$D(^PXRM(809,"C",DFN,NAME)) Q
  1.  I OPENONLY D  Q
  1.  .S IEN=+$O(^PXRM(809,"OPEN",DFN,NAME,"")) I IEN'>0 Q
  1.  .S NFOUND=1,TEST(NFOUND)=1 D GETDATA(DFN,IEN,1,.DATE,.DATA,.TEXT)
  1.  S DTE=0 F  S DTE=$O(^PXRM(809,"C",DFN,NAME,DTE)) Q:DTE'>0!(NFOUND=NGET)  D
  1.  .I BDT>0,DTE<BDT Q
  1.  .I EDT>0,DTE>EDT Q
  1.  .S IEN=0 F  S IEN=$O(^PXRM(809,"C",DFN,NAME,DTE,IEN)) Q:IEN'>0!(NFOUND=NGET)  D
  1.  ..S NFOUND=NFOUND+1,TEST(NFOUND)=1 D GETDATA(DFN,IEN,NFOUND,.DATE,.DATA,.TEXT)
  1.  Q
  1.  ;
  1. GETDATA(DFN,IEN,INC,DATE,DATA,TEXT) ;
  1.  N ARRAY,EDATE,LDATE,ITEM,NAME,NODE,STATUS,TCNT,X
  1.  S NODE=^PXRM(809,IEN,0)
  1.  S DATE(INC)=$P(NODE,U)
  1.  S NAME=$P(NODE,U,2)
  1.  S STATUS=$S($P(NODE,U,4)="O":"Open",$P(NODE,U,4)="C":"Closed",1:"Unknown")
  1.  S DATA(INC,"STATUS")=STATUS
  1.  S DATA(INC,"NAME")=NAME
  1.  S DATA(INC,"DIALOG")=1
  1.  S TCNT=0
  1.  S TCNT=TCNT+1,TEXT(INC,TCNT)="Cascade: "_NAME
  1.  S TCNT=TCNT+1,TEXT(INC,TCNT)="Started on: "_$$FMTE^XLFDT(DATE(INC))
  1.  S TCNT=TCNT+1,TEXT(INC,TCNT)="Status: "_STATUS
  1.  ;build array of items by dates
  1.  S X=0 F  S X=$O(^PXRM(809,IEN,1,X)) Q:X'>0  D
  1.  .S NODE=^PXRM(809,IEN,1,X,0)
  1.  .S ARRAY($P(NODE,U),$P(NODE,U,2))=NODE
  1.  ;re-loop
  1.  S X=0 F  S X=$O(^PXRM(809,IEN,1,X)) Q:X'>0  D
  1.  .S NODE=^PXRM(809,IEN,1,X,0)
  1.  .S ITEM=$P(NODE,U),EDATE=$P(NODE,U,2),LDATE=$P(NODE,U,5)
  1.  .I ITEM["OR(100" D GETOR(DFN,ITEM,EDATE,LDATE,INC,.TEXT,.TCNT)
  1.  .I ITEM["WV(790.1" D GETWVP(DFN,ITEM,EDATE,LDATE,INC,.TEXT,.TCNT)
  1.  .K ARRAY(ITEM,EDATE)
  1.  S TCNT=TCNT+1,TEXT(INC,TCNT)="----------------------------------------------------------"
  1.  Q
  1.  ;
  1. GETOR(DFN,ITEM,DATE,LDATE,INC,TEXT,TCNT) ;
  1.  N I,ORIGVIEW,PXRMTEMP,STATUS
  1.  S ORIGVIEW=3
  1.  S TCNT=TCNT+1,TEXT(INC,TCNT)=""
  1.  D TEXT^ORQ12(.PXRMTEMP,+ITEM,80)
  1.  S STATUS=$$GETSTAT^ORQ12(+ITEM)
  1.  S TCNT=TCNT+1,TEXT(INC,TCNT)=PXRMTEMP(1)_" ordered on "_$$FMTE^XLFDT(DATE)_" status: "_STATUS
  1.  S I=1 F  S I=$O(PXRMTEMP(I)) Q:I'>0  D
  1.  .S TCNT=TCNT+1,TEXT(INC,TCNT)=PXRMTEMP(I)
  1.  Q
  1.  ;
  1. GETWVP(DFN,ITEM,DATE,LDATE,INC,TEXT,TCNT) ;
  1.  N ACCESS,CNT,ID,NODE,TEMP,X
  1.  S TCNT=TCNT+1,TEXT(INC,TCNT)=""
  1.  I DATE>0 S TCNT=TCNT+1,TEXT(INC,TCNT)="Procedure added on "_$$FMTE^XLFDT(DATE)_" last updated: "_$$FMTE^XLFDT(LDATE)
  1.  D GETWVP^WVRPCGF1(DFN,ITEM,.TEMP)
  1.  S CNT=0 F  S CNT=$O(TEMP(CNT)) Q:CNT'>0  S TCNT=TCNT+1,TEXT(INC,TCNT)=TEMP(CNT)
  1.  S TCNT=TCNT+1,TEXT(INC,TCNT)="----------------------------------------------------------"
  1.  Q
  1.  ;
  1. OBJ(SUB,DFN,NAME) ;
  1.  K ^TMP(SUB,$J)
  1.  N DATA,DATE,IEN,I,TEXT
  1.  S IEN=+$O(^PXRM(809,"OPEN",DFN,NAME,""))
  1.  I IEN'>0 S DATE="A" F  S DATE=$O(^PXRM(809,"C",DFN,NAME,DATE),-1) D  Q:DATE=""!(IEN>0)
  1.  .I DATE="" Q
  1.  .S IEN=$O(^PXRM(809,"C",DFN,NAME,DATE,""))
  1.  I IEN'>0 S ^TMP(SUB,$J,1,0)="No Cascade found" G OBJX
  1.  D GETDATA(DFN,IEN,1,.DATE,.DATA,.TEXT)
  1.  I '$D(TEXT(1)) S ^TMP(SUB,$J,1,0)="No Open Cascade found" G OBJX
  1.  S I=0 F  S I=$O(TEXT(1,I)) Q:I'>0  S ^TMP(SUB,$J,I,0)=TEXT(1,I)
  1. OBJX ;
  1.  Q "~@"_$NA(^TMP(SUB,$J))
  1.  ;