PXRMDLR1 ;SLC/AGP - DIALOG ORPHAN REPORT. ;10/02/2015 12:40
;;2.0;CLINICAL REMINDERS;**6,12,45**;Feb 04, 2005;Build 566
;
;=======================================================================
START(NUM) ;
N DIR,POP,ZTDESC,ZTRTN,ZTSAVE
S %ZIS="M"
I NUM=1 S ZTDESC="Dialog Orphan Report" S ZTRTN="ORPHAN^PXRMDLR1"
I NUM=2 S ZTDESC="Empty Reminder Dialogs Report" S ZTRTN="EMPTY^PXRMDLR1"
S ZTSAVE("*")=""
D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,.%ZIS)
Q
;
ORPHAN ;
N NAME,IEN,TYPE
K ^TMP("PXRMDLR1",$J)
S IEN=0
S NAME="" F S NAME=$O(^PXRMD(801.41,"B",NAME)) Q:NAME="" D
. S IEN=$O(^PXRMD(801.41,"B",NAME,"")) Q:IEN'>0
. S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
. I $G(TYPE)=""!($G(TYPE)="R") Q
. I $D(^PXRMD(801.41,"BLR",IEN)) Q
. I $D(^PXRMD(801.41,"AD",IEN)) Q
. I $D(^PXRMD(801.41,"RG",IEN)) Q
. S TYPE=$S(TYPE="P":"VPROMPT",TYPE="E":"ELEMENT",TYPE="F":"VVALUE",TYPE="G":"GROUP",TYPE="S":"RGROUP",TYPE="T":"RELEMENT")
. S ^TMP("PXRMDLR1",$J,TYPE,NAME)=IEN
I $D(^TMP("PXRMDLR1",$J))>0 D OUTPUT
Q
;
EMPTY ;
N DONE,FOUND,NAME,IEN,TITLE,TYPE
W @IOF
S PCNT=0,PAGE=1,DONE=0,FOUND=0
S TITLE="Empty Reminder Dialogs Report"
D HEADER(.PCNT,PAGE,TITLE)
S IEN=0
S NAME="" F S NAME=$O(^PXRMD(801.41,"B",NAME)) Q:NAME=""!(DONE=1) D
. S IEN=$O(^PXRMD(801.41,"B",NAME,"")) Q:IEN'>0
. S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
. I ($G(TYPE)'="R") Q
. I $D(^PXRMD(801.41,IEN,10))'=0 Q
. S FOUND=1
. I (PCNT+1)'<IOSL D PAGE(.PCNT,.PAGE) I $G(DONE)=1 Q
. W !," "_$G(NAME) S PCNT=PCNT+1 I (PCNT+1)'<IOSL D PAGE(.PCNT,.PAGE) I $G(DONE)=1 Q
I FOUND=0 W !,"No empty dialog found"
I ($E(IOST,1,2)="C-")&(IO=IO(0)) D
. W !
. S DIR(0)="E" D ^DIR K DIR
Q
;
OUTPUT ;
N CAT,DONE,LENGTH,NAME,OCAT,PAGE,PCNT,TITLE,TYPE,X
W @IOF
S PCNT=0,PAGE=1,DONE=0
S TITLE="Reminder Dialog Elements Orphan Report"
D HEADER(.PCNT,PAGE,TITLE)
W !
F CAT="ELEMENT","GROUP","RELEMENT","RGROUP","VPROMPT","VVALUE" D
. I DONE=1 Q
. I $D(^TMP("PXRMDLR1",$J,CAT))'>0 Q
. S TYPE=$S(CAT="VPROMPT":"Additional Prompts",CAT="ELEMENT":"Dialog Elements",CAT="VVALUE":"Force Values",CAT="GROUP":"Dialog Groups",CAT="RGROUP":"Result Groups",CAT="RELEMENT":"Result Elements")
. I (PCNT+4)'<IOSL D PAGE(.PCNT,.PAGE) I $G(DONE)=1 Q
. S LENGTH=$L(TYPE) W !!,TYPE,! F X=1:1:LENGTH W "="
. S PCNT=PCNT+4
. I (PCNT+1)'<IOSL D PAGE(.PCNT,.PAGE) I $G(DONE)=1 Q
. S NAME="" F S NAME=$O(^TMP("PXRMDLR1",$J,CAT,NAME)) Q:NAME=""!(DONE=1) D
. .W !,$$LJ^XLFSTR("",4)_NAME S PCNT=PCNT+1
. .I (PCNT+1)'<IOSL D PAGE(.PCNT,.PAGE) I $G(DONE)=1 Q
K ^TMP("PXRMDLR1",$J)
I ($E(IOST,1,2)="C-")&(IO=IO(0)) D
. W !
. S DIR(0)="E" D ^DIR K DIR
Q
;
W $$LJ^XLFSTR(TITLE,70)_"Page: "_PAGE,!
F X=1:1:80 W "="
S PCNT=PCNT+3
Q
;
PAGE(PCNT,PAGE) ;
N DUOUT,DTOUT,DIROUT,DIR
I ($E(IOST,1,2)="C-")&(IO=IO(0)) D
.S DIR(0)="E"
.W !
.D ^DIR K DIR
I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)) S DONE=1 Q
W:$D(IOF) @IOF
S PAGE=PAGE+1,PCNT=0
I ($E(IOST,1,2)="C-")&(IO=IO(0)) W @IOF D HEADER(.PCNT,PAGE,TITLE)
Q
STAND ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLR1 3116 printed Oct 16, 2024@17:44:59 Page 2
PXRMDLR1 ;SLC/AGP - DIALOG ORPHAN REPORT. ;10/02/2015 12:40
+1 ;;2.0;CLINICAL REMINDERS;**6,12,45**;Feb 04, 2005;Build 566
+2 ;
+3 ;=======================================================================
START(NUM) ;
+1 NEW DIR,POP,ZTDESC,ZTRTN,ZTSAVE
+2 SET %ZIS="M"
+3 IF NUM=1
SET ZTDESC="Dialog Orphan Report"
SET ZTRTN="ORPHAN^PXRMDLR1"
+4 IF NUM=2
SET ZTDESC="Empty Reminder Dialogs Report"
SET ZTRTN="EMPTY^PXRMDLR1"
+5 SET ZTSAVE("*")=""
+6 DO EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,.%ZIS)
+7 QUIT
+8 ;
ORPHAN ;
+1 NEW NAME,IEN,TYPE
+2 KILL ^TMP("PXRMDLR1",$JOB)
+3 SET IEN=0
+4 SET NAME=""
FOR
SET NAME=$ORDER(^PXRMD(801.41,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+5 SET IEN=$ORDER(^PXRMD(801.41,"B",NAME,""))
if IEN'>0
QUIT
+6 SET TYPE=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)
+7 IF $GET(TYPE)=""!($GET(TYPE)="R")
QUIT
+8 IF $DATA(^PXRMD(801.41,"BLR",IEN))
QUIT
+9 IF $DATA(^PXRMD(801.41,"AD",IEN))
QUIT
+10 IF $DATA(^PXRMD(801.41,"RG",IEN))
QUIT
+11 SET TYPE=$SELECT(TYPE="P":"VPROMPT",TYPE="E":"ELEMENT",TYPE="F":"VVALUE",TYPE="G":"GROUP",TYPE="S":"RGROUP",TYPE="T":"RELEMENT")
+12 SET ^TMP("PXRMDLR1",$JOB,TYPE,NAME)=IEN
End DoDot:1
+13 IF $DATA(^TMP("PXRMDLR1",$JOB))>0
DO OUTPUT
+14 QUIT
+15 ;
EMPTY ;
+1 NEW DONE,FOUND,NAME,IEN,TITLE,TYPE
+2 WRITE @IOF
+3 SET PCNT=0
SET PAGE=1
SET DONE=0
SET FOUND=0
+4 SET TITLE="Empty Reminder Dialogs Report"
+5 DO HEADER(.PCNT,PAGE,TITLE)
+6 SET IEN=0
+7 SET NAME=""
FOR
SET NAME=$ORDER(^PXRMD(801.41,"B",NAME))
if NAME=""!(DONE=1)
QUIT
Begin DoDot:1
+8 SET IEN=$ORDER(^PXRMD(801.41,"B",NAME,""))
if IEN'>0
QUIT
+9 SET TYPE=$PIECE($GET(^PXRMD(801.41,IEN,0)),U,4)
+10 IF ($GET(TYPE)'="R")
QUIT
+11 IF $DATA(^PXRMD(801.41,IEN,10))'=0
QUIT
+12 SET FOUND=1
+13 IF (PCNT+1)'<IOSL
DO PAGE(.PCNT,.PAGE)
IF $GET(DONE)=1
QUIT
+14 WRITE !," "_$GET(NAME)
SET PCNT=PCNT+1
IF (PCNT+1)'<IOSL
DO PAGE(.PCNT,.PAGE)
IF $GET(DONE)=1
QUIT
End DoDot:1
+15 IF FOUND=0
WRITE !,"No empty dialog found"
+16 IF ($EXTRACT(IOST,1,2)="C-")&(IO=IO(0))
Begin DoDot:1
+17 WRITE !
+18 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+19 QUIT
+20 ;
OUTPUT ;
+1 NEW CAT,DONE,LENGTH,NAME,OCAT,PAGE,PCNT,TITLE,TYPE,X
+2 WRITE @IOF
+3 SET PCNT=0
SET PAGE=1
SET DONE=0
+4 SET TITLE="Reminder Dialog Elements Orphan Report"
+5 DO HEADER(.PCNT,PAGE,TITLE)
+6 WRITE !
+7 FOR CAT="ELEMENT","GROUP","RELEMENT","RGROUP","VPROMPT","VVALUE"
Begin DoDot:1
+8 IF DONE=1
QUIT
+9 IF $DATA(^TMP("PXRMDLR1",$JOB,CAT))'>0
QUIT
+10 SET TYPE=$SELECT(CAT="VPROMPT":"Additional Prompts",CAT="ELEMENT":"Dialog Elements",CAT="VVALUE":"Force Values",CAT="GROUP":"Dialog Groups",CAT="RGROUP":"Result Groups",CAT="RELEMENT":"Result Elements")
+11 IF (PCNT+4)'<IOSL
DO PAGE(.PCNT,.PAGE)
IF $GET(DONE)=1
QUIT
+12 SET LENGTH=$LENGTH(TYPE)
WRITE !!,TYPE,!
FOR X=1:1:LENGTH
WRITE "="
+13 SET PCNT=PCNT+4
+14 IF (PCNT+1)'<IOSL
DO PAGE(.PCNT,.PAGE)
IF $GET(DONE)=1
QUIT
+15 SET NAME=""
FOR
SET NAME=$ORDER(^TMP("PXRMDLR1",$JOB,CAT,NAME))
if NAME=""!(DONE=1)
QUIT
Begin DoDot:2
+16 WRITE !,$$LJ^XLFSTR("",4)_NAME
SET PCNT=PCNT+1
+17 IF (PCNT+1)'<IOSL
DO PAGE(.PCNT,.PAGE)
IF $GET(DONE)=1
QUIT
End DoDot:2
End DoDot:1
+18 KILL ^TMP("PXRMDLR1",$JOB)
+19 IF ($EXTRACT(IOST,1,2)="C-")&(IO=IO(0))
Begin DoDot:1
+20 WRITE !
+21 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+22 QUIT
+23 ;
+1 WRITE $$LJ^XLFSTR(TITLE,70)_"Page: "_PAGE,!
+2 FOR X=1:1:80
WRITE "="
+3 SET PCNT=PCNT+3
+4 QUIT
+5 ;
PAGE(PCNT,PAGE) ;
+1 NEW DUOUT,DTOUT,DIROUT,DIR
+2 IF ($EXTRACT(IOST,1,2)="C-")&(IO=IO(0))
Begin DoDot:1
+3 SET DIR(0)="E"
+4 WRITE !
+5 DO ^DIR
KILL DIR
End DoDot:1
+6 IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DIROUT))
SET DONE=1
QUIT
+7 if $DATA(IOF)
WRITE @IOF
+8 SET PAGE=PAGE+1
SET PCNT=0
+9 IF ($EXTRACT(IOST,1,2)="C-")&(IO=IO(0))
WRITE @IOF
DO HEADER(.PCNT,PAGE,TITLE)
+10 QUIT
STAND ;
+1 QUIT
