source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLR1.m@ 1450

Last change on this file since 1450 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 2.8 KB
Line 
1PXRMDLR1 ; SLC/AGP - DIALOG ORPHAN REPORT. ; 02/04/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;=======================================================================
5START(NUM) ;
6 N DIR,POP,ZTDESC,ZTRTN,ZTSAVE
7 S %ZIS="M"
8 I NUM=1 S ZTDESC="Dialog Orphan Report" S ZTRTN="EN^PXRMDLR1"
9 I NUM=2 S ZTDESC="Empty Reminder Dialogs Report" S ZTRTN="EN1^PXRMDLR1"
10 S ZTSAVE("*")=""
11 D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE,.%ZIS)
12 Q
13 ;
14EN ;
15 N NAME,IEN,TYPE
16 K ^TMP("PXRMDLR1",$J)
17 S IEN=0
18 S NAME="" F S NAME=$O(^PXRMD(801.41,"B",NAME)) Q:NAME="" D
19 . S IEN=$O(^PXRMD(801.41,"B",NAME,"")) Q:IEN'>0
20 . S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
21 . I $G(TYPE)=""!($G(TYPE)="R") Q
22 . I $D(^PXRMD(801.41,"AD",IEN)) Q
23 . S TYPE=$S(TYPE="P":"VPROMPT",TYPE="E":"ELEMENT",TYPE="F":"VVALUE",TYPE="G":"GROUP",TYPE="S":"RGROUP",TYPE="T":"RELEMENT")
24 . S ^TMP("PXRMDLR1",$J,TYPE,NAME)=IEN
25 I $D(^TMP("PXRMDLR1",$J))>0 D OUTPUT
26 Q
27 ;
28EN1 ;
29 N DONE,FOUND,NAME,IEN,TITLE,TYPE
30 W @IOF
31 S PCNT=0,PAGE=1,DONE=0,FOUND=0
32 S TITLE="Empty Reminder Dialogs Report"
33 D HEADER(.PCNT,PAGE,TITLE)
34 S IEN=0
35 S NAME="" F S NAME=$O(^PXRMD(801.41,"B",NAME)) Q:NAME=""!(DONE=1) D
36 . S IEN=$O(^PXRMD(801.41,"B",NAME,"")) Q:IEN'>0
37 . S TYPE=$P($G(^PXRMD(801.41,IEN,0)),U,4)
38 . I ($G(TYPE)'="R") Q
39 . I $D(^PXRMD(801.41,IEN,10))'=0 Q
40 . S FOUND=1
41 . I (PCNT+1)'<IOSL D PAGE(.PCNT,.PAGE) I $G(DONE)=1 Q
42 . W !," "_$G(NAME) S PCNT=PCNT+1 I (PCNT+1)'<IOSL D PAGE(.PCNT,.PAGE) I $G(DONE)=1 Q
43 I FOUND=0 W !,"No empty dialog found"
44 I ($E(IOST)="C")&(IO=IO(0)) D
45 . W !
46 . S DIR(0)="E" D ^DIR K DIR
47 Q
48 ;
49OUTPUT ;
50 N CAT,DONE,LENGTH,NAME,OCAT,PAGE,PCNT,TITLE,TYPE,X
51 W @IOF
52 S PCNT=0,PAGE=1,DONE=0
53 S TITLE="Reminder Dialog Elements Orphan Report"
54 D HEADER(.PCNT,PAGE,TITLE)
55 W !
56 F CAT="ELEMENT","GROUP","RELEMENT","RGROUP","VPROMPT","VVALUE" D
57 . I DONE=1 Q
58 . I $D(^TMP("PXRMDLR1",$J,CAT))'>0 Q
59 . 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")
60 . I (PCNT+4)'<IOSL D PAGE(.PCNT,.PAGE) I $G(DONE)=1 Q
61 . S LENGTH=$L(TYPE) W !!,TYPE,! F X=1:1:LENGTH W "="
62 . S PCNT=PCNT+4
63 . I (PCNT+1)'<IOSL D PAGE(.PCNT,.PAGE) I $G(DONE)=1 Q
64 . S NAME="" F S NAME=$O(^TMP("PXRMDLR1",$J,CAT,NAME)) Q:NAME=""!(DONE=1) D
65 . .W !,$$LJ^XLFSTR("",4)_NAME S PCNT=PCNT+1
66 . .I (PCNT+1)'<IOSL D PAGE(.PCNT,.PAGE) I $G(DONE)=1 Q
67 K ^TMP("PXRMDLR1",$J)
68 I ($E(IOST)="C")&(IO=IO(0)) D
69 . W !
70 . S DIR(0)="E" D ^DIR K DIR
71 Q
72 ;
73HEADER(PCNT,PAGE,TITLE) ;
74 W $$LJ^XLFSTR(TITLE,70)_"Page: "_PAGE,!
75 F X=1:1:80 W "="
76 S PCNT=PCNT+3
77 Q
78 ;
79PAGE(PCNT,PAGE) ;
80 N DUOUT,DTOUT,DIROUT,DIR
81 I ($E(IOST)="C")&(IO=IO(0)) D
82 .S DIR(0)="E"
83 .W !
84 .D ^DIR K DIR
85 I $D(DUOUT)!($D(DTOUT))!($D(DIROUT)) S DONE=1 Q
86 W:$D(IOF) @IOF
87 S PAGE=PAGE+1,PCNT=0
88 I $E(IOST)="C",IO=IO(0) W @IOF D HEADER(.PCNT,PAGE,TITLE)
89 Q
Note: See TracBrowser for help on using the repository browser.