source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMHIST.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 3.0 KB
Line 
1PXRMHIST ; SLC/PKR - Routines for dealing with edit histories. ;12/23/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;=====================================================
5DISP(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 ;=====================================================
30MAX() ;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 ;=====================================================
43REM ;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 ;=====================================================
57RMEH ;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 ;
Note: See TracBrowser for help on using the repository browser.