1 | PXRMHIST ; SLC/PKR - Routines for dealing with edit histories. ;12/23/2004
|
---|
2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
---|
3 | ;
|
---|
4 | ;=====================================================
|
---|
5 | DISP(RIEN,MAX) ;Display edit history in reverse date order, newest to oldest.
|
---|
6 | N CNT,EDATA,EIEN,ETIME,IC,NIN,NOUT,RNAME
|
---|
7 | N TEXTIN,TEXTOUT,UIEN,USER
|
---|
8 | ;Last N lines
|
---|
9 | S CNT=0,EIEN=":"
|
---|
10 | S RNAME=$P(^PXD(811.9,RIEN,0),U,1)
|
---|
11 | W !!,"Edit History for reminder "_RNAME_":"
|
---|
12 | F S EIEN=$O(^PXD(811.9,RIEN,110,EIEN),-1) Q:'EIEN Q:CNT=MAX D
|
---|
13 | .;Edit date and edit by fields
|
---|
14 | . S EDATA=$G(^PXD(811.9,RIEN,110,EIEN,0)) Q:EDATA=""
|
---|
15 | . S ETIME=$P(EDATA,U),UIEN=$P(EDATA,U,2) Q:'UIEN
|
---|
16 | . S USER=$$GET1^DIQ(200,UIEN,.01),CNT=CNT+1
|
---|
17 | . W !!,?2,"Edit date: ",$$FMTE^XLFDT(ETIME,"1")
|
---|
18 | . W ?38,"Edit by: ",USER
|
---|
19 | . S (IC,NIN)=0
|
---|
20 | . F S IC=$O(^PXD(811.9,RIEN,110,EIEN,1,IC)) Q:'IC D
|
---|
21 | .. S NIN=NIN+1
|
---|
22 | .. S TEXTIN(NIN)=$G(^PXD(811.9,RIEN,110,EIEN,1,IC,0))
|
---|
23 | . D FORMAT^PXRMTEXT(18,75,NIN,.TEXTIN,.NOUT,.TEXTOUT)
|
---|
24 | . I NOUT>0 D
|
---|
25 | .. W !,?2,"Edit Comments:",?1,$P(TEXTOUT(1)," ",17,99)
|
---|
26 | .. F IC=2:1:NOUT W !,TEXTOUT(IC)
|
---|
27 | Q
|
---|
28 | ;
|
---|
29 | ;=====================================================
|
---|
30 | MAX() ;Return the maximum number of occurrences to display.
|
---|
31 | N DIR,DIROUT,DIRUT,DTOUT,DUOUT,MAX,X,Y
|
---|
32 | S DIR(0)="N^2:99"
|
---|
33 | S DIR("A")="Maximum number of occurrences to display "
|
---|
34 | ;Get the edit history count to use as a default value.
|
---|
35 | S MAX=$G(^PXRM(800,1,"EDIT HISTORY COUNT")) I MAX="" S MAX=2
|
---|
36 | S DIR("B")=MAX
|
---|
37 | D ^DIR
|
---|
38 | I $D(DIROUT)!$D(DIRUT) Q 0
|
---|
39 | I $D(DTOUT)!$D(DUOUT) Q 0
|
---|
40 | Q +Y
|
---|
41 | ;
|
---|
42 | ;=====================================================
|
---|
43 | REM ;Select reminder definition for displaying the history.
|
---|
44 | N IEN,IENN,MAX,PXRMROOT
|
---|
45 | S IENN=0
|
---|
46 | S PXRMROOT="^PXD(811.9,"
|
---|
47 | S MAX=$$MAX
|
---|
48 | I MAX=0 Q
|
---|
49 | F Q:IENN=-1 D
|
---|
50 | . W !
|
---|
51 | . S IENN=$$SELECT^PXRMINQ(PXRMROOT,"Select Reminder Definition: ","")
|
---|
52 | . I IENN=-1 Q
|
---|
53 | . S IEN=$P(IENN,U,1)
|
---|
54 | . D DISP(IEN,MAX)
|
---|
55 | Q
|
---|
56 | ;=====================================================
|
---|
57 | RMEH ;Remove edit history. This is for items sent directly via KIDS that
|
---|
58 | ;do not go through Exchange. Reminder computed findings are a good
|
---|
59 | ;example.
|
---|
60 | I DUZ(0)'="@" Q
|
---|
61 | N CLASS,DIR,DIROUT,DIRUT,DTOUT,DUOUT,EH,ENTRY,IEN
|
---|
62 | N FIELD,FILENUM,GLOBAL,NAME,X,Y
|
---|
63 | W !,"Remove edit history from national reminder files.",!
|
---|
64 | S DIR(0)="NAOU^0::15"
|
---|
65 | S DIR("A")="Enter the file number: "
|
---|
66 | D ^DIR
|
---|
67 | I $D(DIROUT)!$D(DIRUT) Q
|
---|
68 | I (Y="")!($D(DTOUT))!($D(DUOUT)) Q
|
---|
69 | S FILENUM=+Y
|
---|
70 | S FIELD=$$GET1^DID(FILENUM,110,"","LABEL")
|
---|
71 | I FIELD'="EDIT HISTORY" D Q
|
---|
72 | . W !,"This is no Edit History in this file!"
|
---|
73 | S NAME=$$GET1^DID(FILENUM,"","","NAME")
|
---|
74 | W !,"Looking for edit histories in file ",NAME
|
---|
75 | S GLOBAL=$$GET1^DID(FILENUM,"","","GLOBAL NAME")
|
---|
76 | S ENTRY=GLOBAL_"IEN)"
|
---|
77 | S IEN=0
|
---|
78 | F S IEN=+$O(@ENTRY) Q:(IEN=0)!($G(DUOUT)) D
|
---|
79 | . S CLASS=GLOBAL_"IEN,100)"
|
---|
80 | . S CLASS=$P(@CLASS,U,1)
|
---|
81 | . I CLASS'="N" Q
|
---|
82 | . S NAME=GLOBAL_"IEN,0)"
|
---|
83 | . S NAME=$P(@NAME,U,1)
|
---|
84 | . K DIR
|
---|
85 | . S DIR(0)="YA"
|
---|
86 | . S DIR("A")="Delete Edit History from entry "_NAME_"? "
|
---|
87 | . S DIR("B")="N"
|
---|
88 | . D ^DIR
|
---|
89 | . I $D(DIROUT)!$D(DIRUT) Q
|
---|
90 | . I (Y="")!($D(DTOUT))!($D(DUOUT)) Q
|
---|
91 | . I 'Y Q
|
---|
92 | . S EH=GLOBAL_"IEN,110)"
|
---|
93 | . K @EH
|
---|
94 | . S EH=GLOBAL_"IEN,110,0)"
|
---|
95 | . S @EH="^811.9001D^^0"
|
---|
96 | Q
|
---|
97 | ;
|
---|