| 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
|
|---|
