source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXTF.m@ 1777

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

revised back to 6/30/08 version

File size: 4.1 KB
Line 
1PXRMXTF ; SLC/PJH - Reminder Reports Template Filing ;05/02/2002
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ; Called from PXRMXTA
5 ;
6 ;Select template name and file
7 ;-----------------------------
8START N NEWIEN,NEWTEMP,OLDTEMP
9 ;Save original name
10 S OLDTEMP=$P(PXRMTMP,U,2)
11 ;Reset PXRMTMP in case the template name field has been edited
12 S $P(PXRMTMP,U,2)=$P($G(^PXRMPT(810.1,$P(PXRMTMP,U,1),0)),U)
13 ;Redisplay changes made
14 D REDISP
15 ;Prompt template name
16 D NAME
17 ;Rollback ^DIE changes if edit is abandoned
18 I $D(DTOUT)!$D(DUOUT) D ROLL Q
19 ;
20 I NEWTEMP=$P(PXRMTMP,U,2),NEWTEMP=OLDTEMP D MESS(1,NEWTEMP)
21 I NEWTEMP=$P(PXRMTMP,U,2),NEWTEMP'=OLDTEMP D MESS(3,OLDTEMP,NEWTEMP)
22 ;
23 ;If a new template ID is selected then create a new template
24 I NEWTEMP'=$P(PXRMTMP,U,2) D I $D(MSG) S DTOUT=1 Q
25 .;Create template header
26 .D HEADER
27 .;Save edited template detail to new template name
28 .D REFILE Q:$D(MSG)
29 .;Save Message
30 .D MESS(2,NEWTEMP)
31 .;File original arrays to old template (rollback ^DIE changes)
32 .D FILE^PXRMXTU(PXRMTMP,1,1)
33 .;Set selected template ID
34 .S PXRMTMP=NEWIEN
35 ;
36 ;Reload arrays
37 D LOAD^PXRMXT I $D(MSG) S DTOUT=1 Q
38EXIT Q
39 ;
40 ;Rename edited template
41 ;----------------------
42NAME N X,Y,TEXT,DIR
43 K DIROUT,DIRUT,DTOUT,DUOUT
44 S DIR(0)="FAU"_U_"3:30"_U_"K:'$$OK^PXRMXTF(X) X"
45 S DIR("A")="STORE REPORT LOGIC IN TEMPLATE NAME: "
46 S DIR("B")=$P(PXRMTMP,U,2)
47 S DIR("?")="Enter template name. For detailed help type ??"
48 S DIR("??")=U_"D HELP^PXRMXTF(1)"
49 W !
50 D ^DIR K DIR
51 I $D(DIROUT) S DTOUT=1
52 I $D(DTOUT)!($D(DUOUT)) Q
53 S NEWTEMP=Y
54 Q
55 ;
56 ;Check if the template name is in use
57 ;------------------------------------
58OK(NAME) ;
59 ;Original template name may be used
60 I X=DIR("B") Q 1
61 I $E(DIR("B"),1,$L(X))=X Q 0
62 ;Else check if template name defined
63 I '$D(^PXRMPT(810.1,"B",NAME)) Q 1
64 Q 0
65 ;
66 ;Create Template header and get IEN
67 ;----------------------------------
68HEADER N DATA,IEN,NUM
69 ;Otherwise create a new entry
70 S DATA=$G(^PXRMPT(810.1,0)),IEN=$P(DATA,U,3),NUM=$P(DATA,U,4)
71 F S IEN=IEN+1 Q:'$D(^PXRMPT(IEN,0))
72 S ^PXRMPT(810.1,IEN,0)=NEWTEMP
73 S ^PXRMPT(810.1,"B",NEWTEMP,IEN)=""
74 S $P(^PXRMPT(810.1,0),U,3)=IEN,$P(^PXRMPT(810.1,0),U,4)=NUM+1
75 S NEWIEN=IEN_U_NEWTEMP
76 Q
77 ;
78 ;Redisplay edited template details
79 ;---------------------------------------------
80REDISP N PXRMLCSC,PXRMPRIM,PXRMREP,PXRMSEL,PXRMTYP,PXRMFD,RUN,PXRMCS
81 N PXRMREM,PXRMFAC,PXRMPRV,PXRMPAT,PXRMOTM,PXRMSCAT,PXRMLCHL,PXRMCS
82 N PXRMLIST,TITLE
83 ;
84 ;Load temporary arrays from edited template PXRMTMP
85 D LOAD^PXRMXT I $D(MSG) Q
86 ;Clear last run date
87 S RUN=""
88 ;Display
89 D ^PXRMXTD
90 ;
91 Q
92 ;
93 ;Copy edited template details to new template
94 ;---------------------------------------------
95REFILE N PXRMLCSC,PXRMPRIM,PXRMREP,PXRMSEL,PXRMTYP,PXRMFD,RUN,PXRMCS
96 N PXRMREM,PXRMFAC,PXRMPRV,PXRMPAT,PXRMOTM,PXRMSCAT,PXRMLCHL,PXRMCS
97 N PXRMLIST,TITLE
98 ;
99 ;Load temporary arrays from edited template PXRMTMP
100 D LOAD^PXRMXT I $D(MSG) Q
101 ;Clear last run date
102 S RUN=""
103 ;Save arrays to new ID
104 D FILE^PXRMXTU(NEWIEN,1,0) Q:$D(MSG)
105 Q
106 ;
107 ;Rollback changes (also called from PXRMXTA)
108 ;----------------
109ROLL ;
110 D FILE^PXRMXTU(PXRMTMP,1,1)
111 I $D(MSG) S DTOUT=1 Q
112 ;Changes not saved message
113 D MESS(0,$P(PXRMTMP,U,2))
114 Q
115 ;
116 ;Filing messages
117 ;---------------
118MESS(MODE,INP,INP1) ;
119 I MODE=0 W !,"Changes to template '"_INP_"' have not been saved" Q
120 I MODE=1 W !,"Changes to template '"_INP_"' have been saved"
121 I MODE=2 W !,"A new template '"_INP_"' has been created"
122 I MODE=3 W !,"Template '"_INP_"' renamed as '"_INP1_"'"
123 I MODE=4 W !,"Template '"_INP_"' not saved"
124 Q
125 ;
126 ;General help text routine. Write out the text in the HTEXT array
127 ;----------------------------------------------------------------
128HELP(CALL) ;
129 N HTEXT
130 N DIWF,DIWL,DIWR,IC
131 S DIWF="C70",DIWL=0,DIWR=70
132 ;
133 I CALL=1 D
134 .S HTEXT(1)="To save or rename the existing template use the default"
135 .S HTEXT(2)="name. To create a new template and leave the original "
136 .S HTEXT(3)="unchanged enter a different template name "
137 .S HTEXT(4)="that is not in use."
138 ;
139 K ^UTILITY($J,"W")
140 S IC=""
141 F S IC=$O(HTEXT(IC)) Q:IC="" D
142 . S X=HTEXT(IC)
143 . D ^DIWP
144 W !
145 S IC=0
146 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
147 . W !,^UTILITY($J,"W",0,IC,0)
148 K ^UTILITY($J,"W")
149 W !
150 Q
Note: See TracBrowser for help on using the repository browser.