- 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 Jan 18, 2025@02:45:22 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