Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXTF.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMXTF.m
r613 r623 1 PXRMXTF 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 4 5 6 7 8 START 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 EXIT 39 40 41 42 NAME 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 OK(NAME) 59 60 61 62 63 64 65 66 67 68 HEADER 69 70 71 72 73 74 75 76 77 78 79 80 REDISP 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 REFILE 96 97 98 99 100 101 102 103 104 105 106 107 108 109 ROLL 110 111 112 113 114 115 116 117 118 MESS(MODE,INP,INP1) 119 120 121 122 123 124 125 126 127 128 HELP(CALL) 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 1 PXRMXTF ; 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 ;----------------------------- 8 START 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 38 EXIT Q 39 ; 40 ;Rename edited template 41 ;---------------------- 42 NAME 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 ;------------------------------------ 58 OK(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 ;---------------------------------- 68 HEADER 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 ;--------------------------------------------- 80 REDISP 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 ;--------------------------------------------- 95 REFILE 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 ;---------------- 109 ROLL ; 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 ;--------------- 118 MESS(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 ;---------------------------------------------------------------- 128 HELP(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 TracChangeset
for help on using the changeset viewer.
