PXRMCEOC ;SLC/AGP - Computed findings for WH project ;06/27/2018
;;2.0;CLINICAL REMINDERS;**45**;Feb 4, 2005;Build 566
;
EPISODE(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
;
N DIR,DTE,IEN,NAME,OPENONLY
S NFOUND=0
S NAME=$P(TEST,":"),OPENONLY=$S($P(TEST,":",2)="OPEN":1,1:0)
I NAME="" Q
I '$D(^PXRM(809,"C",DFN,NAME)) Q
I OPENONLY D Q
.S IEN=+$O(^PXRM(809,"OPEN",DFN,NAME,"")) I IEN'>0 Q
.S NFOUND=1,TEST(NFOUND)=1 D GETDATA(DFN,IEN,1,.DATE,.DATA,.TEXT)
S DTE=0 F S DTE=$O(^PXRM(809,"C",DFN,NAME,DTE)) Q:DTE'>0!(NFOUND=NGET) D
.I BDT>0,DTE<BDT Q
.I EDT>0,DTE>EDT Q
.S IEN=0 F S IEN=$O(^PXRM(809,"C",DFN,NAME,DTE,IEN)) Q:IEN'>0!(NFOUND=NGET) D
..S NFOUND=NFOUND+1,TEST(NFOUND)=1 D GETDATA(DFN,IEN,NFOUND,.DATE,.DATA,.TEXT)
Q
;
GETDATA(DFN,IEN,INC,DATE,DATA,TEXT) ;
N ARRAY,EDATE,LDATE,ITEM,NAME,NODE,STATUS,TCNT,X
S NODE=^PXRM(809,IEN,0)
S DATE(INC)=$P(NODE,U)
S NAME=$P(NODE,U,2)
S STATUS=$S($P(NODE,U,4)="O":"Open",$P(NODE,U,4)="C":"Closed",1:"Unknown")
S DATA(INC,"STATUS")=STATUS
S DATA(INC,"NAME")=NAME
S DATA(INC,"DIALOG")=1
S TCNT=0
S TCNT=TCNT+1,TEXT(INC,TCNT)="Cascade: "_NAME
S TCNT=TCNT+1,TEXT(INC,TCNT)="Started on: "_$$FMTE^XLFDT(DATE(INC))
S TCNT=TCNT+1,TEXT(INC,TCNT)="Status: "_STATUS
;build array of items by dates
S X=0 F S X=$O(^PXRM(809,IEN,1,X)) Q:X'>0 D
.S NODE=^PXRM(809,IEN,1,X,0)
.S ARRAY($P(NODE,U),$P(NODE,U,2))=NODE
;re-loop
S X=0 F S X=$O(^PXRM(809,IEN,1,X)) Q:X'>0 D
.S NODE=^PXRM(809,IEN,1,X,0)
.S ITEM=$P(NODE,U),EDATE=$P(NODE,U,2),LDATE=$P(NODE,U,5)
.I ITEM["OR(100" D GETOR(DFN,ITEM,EDATE,LDATE,INC,.TEXT,.TCNT)
.I ITEM["WV(790.1" D GETWVP(DFN,ITEM,EDATE,LDATE,INC,.TEXT,.TCNT)
.K ARRAY(ITEM,EDATE)
S TCNT=TCNT+1,TEXT(INC,TCNT)="----------------------------------------------------------"
Q
;
GETOR(DFN,ITEM,DATE,LDATE,INC,TEXT,TCNT) ;
N I,ORIGVIEW,PXRMTEMP,STATUS
S ORIGVIEW=3
S TCNT=TCNT+1,TEXT(INC,TCNT)=""
D TEXT^ORQ12(.PXRMTEMP,+ITEM,80)
S STATUS=$$GETSTAT^ORQ12(+ITEM)
S TCNT=TCNT+1,TEXT(INC,TCNT)=PXRMTEMP(1)_" ordered on "_$$FMTE^XLFDT(DATE)_" status: "_STATUS
S I=1 F S I=$O(PXRMTEMP(I)) Q:I'>0 D
.S TCNT=TCNT+1,TEXT(INC,TCNT)=PXRMTEMP(I)
Q
;
GETWVP(DFN,ITEM,DATE,LDATE,INC,TEXT,TCNT) ;
N ACCESS,CNT,ID,NODE,TEMP,X
S TCNT=TCNT+1,TEXT(INC,TCNT)=""
I DATE>0 S TCNT=TCNT+1,TEXT(INC,TCNT)="Procedure added on "_$$FMTE^XLFDT(DATE)_" last updated: "_$$FMTE^XLFDT(LDATE)
D GETWVP^WVRPCGF1(DFN,ITEM,.TEMP)
S CNT=0 F S CNT=$O(TEMP(CNT)) Q:CNT'>0 S TCNT=TCNT+1,TEXT(INC,TCNT)=TEMP(CNT)
S TCNT=TCNT+1,TEXT(INC,TCNT)="----------------------------------------------------------"
Q
;
OBJ(SUB,DFN,NAME) ;
K ^TMP(SUB,$J)
N DATA,DATE,IEN,I,TEXT
S IEN=+$O(^PXRM(809,"OPEN",DFN,NAME,""))
I IEN'>0 S DATE="A" F S DATE=$O(^PXRM(809,"C",DFN,NAME,DATE),-1) D Q:DATE=""!(IEN>0)
.I DATE="" Q
.S IEN=$O(^PXRM(809,"C",DFN,NAME,DATE,""))
I IEN'>0 S ^TMP(SUB,$J,1,0)="No Cascade found" G OBJX
D GETDATA(DFN,IEN,1,.DATE,.DATA,.TEXT)
I '$D(TEXT(1)) S ^TMP(SUB,$J,1,0)="No Open Cascade found" G OBJX
S I=0 F S I=$O(TEXT(1,I)) Q:I'>0 S ^TMP(SUB,$J,I,0)=TEXT(1,I)
OBJX ;
Q "~@"_$NA(^TMP(SUB,$J))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCEOC 3181 printed Apr 09, 2024@20:54:29 Page 2
PXRMCEOC ;SLC/AGP - Computed findings for WH project ;06/27/2018
+1 ;;2.0;CLINICAL REMINDERS;**45**;Feb 4, 2005;Build 566
+2 ;
EPISODE(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;
+1 ;
+2 NEW DIR,DTE,IEN,NAME,OPENONLY
+3 SET NFOUND=0
+4 SET NAME=$PIECE(TEST,":")
SET OPENONLY=$SELECT($PIECE(TEST,":",2)="OPEN":1,1:0)
+5 IF NAME=""
QUIT
+6 IF '$DATA(^PXRM(809,"C",DFN,NAME))
QUIT
+7 IF OPENONLY
Begin DoDot:1
+8 SET IEN=+$ORDER(^PXRM(809,"OPEN",DFN,NAME,""))
IF IEN'>0
QUIT
+9 SET NFOUND=1
SET TEST(NFOUND)=1
DO GETDATA(DFN,IEN,1,.DATE,.DATA,.TEXT)
End DoDot:1
QUIT
+10 SET DTE=0
FOR
SET DTE=$ORDER(^PXRM(809,"C",DFN,NAME,DTE))
if DTE'>0!(NFOUND=NGET)
QUIT
Begin DoDot:1
+11 IF BDT>0
IF DTE<BDT
QUIT
+12 IF EDT>0
IF DTE>EDT
QUIT
+13 SET IEN=0
FOR
SET IEN=$ORDER(^PXRM(809,"C",DFN,NAME,DTE,IEN))
if IEN'>0!(NFOUND=NGET)
QUIT
Begin DoDot:2
+14 SET NFOUND=NFOUND+1
SET TEST(NFOUND)=1
DO GETDATA(DFN,IEN,NFOUND,.DATE,.DATA,.TEXT)
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
GETDATA(DFN,IEN,INC,DATE,DATA,TEXT) ;
+1 NEW ARRAY,EDATE,LDATE,ITEM,NAME,NODE,STATUS,TCNT,X
+2 SET NODE=^PXRM(809,IEN,0)
+3 SET DATE(INC)=$PIECE(NODE,U)
+4 SET NAME=$PIECE(NODE,U,2)
+5 SET STATUS=$SELECT($PIECE(NODE,U,4)="O":"Open",$PIECE(NODE,U,4)="C":"Closed",1:"Unknown")
+6 SET DATA(INC,"STATUS")=STATUS
+7 SET DATA(INC,"NAME")=NAME
+8 SET DATA(INC,"DIALOG")=1
+9 SET TCNT=0
+10 SET TCNT=TCNT+1
SET TEXT(INC,TCNT)="Cascade: "_NAME
+11 SET TCNT=TCNT+1
SET TEXT(INC,TCNT)="Started on: "_$$FMTE^XLFDT(DATE(INC))
+12 SET TCNT=TCNT+1
SET TEXT(INC,TCNT)="Status: "_STATUS
+13 ;build array of items by dates
+14 SET X=0
FOR
SET X=$ORDER(^PXRM(809,IEN,1,X))
if X'>0
QUIT
Begin DoDot:1
+15 SET NODE=^PXRM(809,IEN,1,X,0)
+16 SET ARRAY($PIECE(NODE,U),$PIECE(NODE,U,2))=NODE
End DoDot:1
+17 ;re-loop
+18 SET X=0
FOR
SET X=$ORDER(^PXRM(809,IEN,1,X))
if X'>0
QUIT
Begin DoDot:1
+19 SET NODE=^PXRM(809,IEN,1,X,0)
+20 SET ITEM=$PIECE(NODE,U)
SET EDATE=$PIECE(NODE,U,2)
SET LDATE=$PIECE(NODE,U,5)
+21 IF ITEM["OR(100"
DO GETOR(DFN,ITEM,EDATE,LDATE,INC,.TEXT,.TCNT)
+22 IF ITEM["WV(790.1"
DO GETWVP(DFN,ITEM,EDATE,LDATE,INC,.TEXT,.TCNT)
+23 KILL ARRAY(ITEM,EDATE)
End DoDot:1
+24 SET TCNT=TCNT+1
SET TEXT(INC,TCNT)="----------------------------------------------------------"
+25 QUIT
+26 ;
GETOR(DFN,ITEM,DATE,LDATE,INC,TEXT,TCNT) ;
+1 NEW I,ORIGVIEW,PXRMTEMP,STATUS
+2 SET ORIGVIEW=3
+3 SET TCNT=TCNT+1
SET TEXT(INC,TCNT)=""
+4 DO TEXT^ORQ12(.PXRMTEMP,+ITEM,80)
+5 SET STATUS=$$GETSTAT^ORQ12(+ITEM)
+6 SET TCNT=TCNT+1
SET TEXT(INC,TCNT)=PXRMTEMP(1)_" ordered on "_$$FMTE^XLFDT(DATE)_" status: "_STATUS
+7 SET I=1
FOR
SET I=$ORDER(PXRMTEMP(I))
if I'>0
QUIT
Begin DoDot:1
+8 SET TCNT=TCNT+1
SET TEXT(INC,TCNT)=PXRMTEMP(I)
End DoDot:1
+9 QUIT
+10 ;
GETWVP(DFN,ITEM,DATE,LDATE,INC,TEXT,TCNT) ;
+1 NEW ACCESS,CNT,ID,NODE,TEMP,X
+2 SET TCNT=TCNT+1
SET TEXT(INC,TCNT)=""
+3 IF DATE>0
SET TCNT=TCNT+1
SET TEXT(INC,TCNT)="Procedure added on "_$$FMTE^XLFDT(DATE)_" last updated: "_$$FMTE^XLFDT(LDATE)
+4 DO GETWVP^WVRPCGF1(DFN,ITEM,.TEMP)
+5 SET CNT=0
FOR
SET CNT=$ORDER(TEMP(CNT))
if CNT'>0
QUIT
SET TCNT=TCNT+1
SET TEXT(INC,TCNT)=TEMP(CNT)
+6 SET TCNT=TCNT+1
SET TEXT(INC,TCNT)="----------------------------------------------------------"
+7 QUIT
+8 ;
OBJ(SUB,DFN,NAME) ;
+1 KILL ^TMP(SUB,$JOB)
+2 NEW DATA,DATE,IEN,I,TEXT
+3 SET IEN=+$ORDER(^PXRM(809,"OPEN",DFN,NAME,""))
+4 IF IEN'>0
SET DATE="A"
FOR
SET DATE=$ORDER(^PXRM(809,"C",DFN,NAME,DATE),-1)
Begin DoDot:1
+5 IF DATE=""
QUIT
+6 SET IEN=$ORDER(^PXRM(809,"C",DFN,NAME,DATE,""))
End DoDot:1
if DATE=""!(IEN>0)
QUIT
+7 IF IEN'>0
SET ^TMP(SUB,$JOB,1,0)="No Cascade found"
GOTO OBJX
+8 DO GETDATA(DFN,IEN,1,.DATE,.DATA,.TEXT)
+9 IF '$DATA(TEXT(1))
SET ^TMP(SUB,$JOB,1,0)="No Open Cascade found"
GOTO OBJX
+10 SET I=0
FOR
SET I=$ORDER(TEXT(1,I))
if I'>0
QUIT
SET ^TMP(SUB,$JOB,I,0)=TEXT(1,I)
OBJX ;
+1 QUIT "~@"_$NAME(^TMP(SUB,$JOB))
+2 ;
