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

PXRMXTF ; SLC/PJH - Reminder Reports Template Filing ;05/02/2002

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 ; 

 ; Called from PXRMXTA

 ;

 ;Select template name and file

 ;-----------------------------

START N NEWIEN,NEWTEMP,OLDTEMP

 ;Save original name

 S OLDTEMP=$P(PXRMTMP,U,2)

 ;Reset PXRMTMP in case the template name field has been edited

 S $P(PXRMTMP,U,2)=$P($G(^PXRMPT(810.1,$P(PXRMTMP,U,1),0)),U)

 ;Redisplay changes made

 D REDISP

 ;Prompt template name

 D NAME

 ;Rollback ^DIE changes if edit is abandoned

 I $D(DTOUT)!$D(DUOUT) D ROLL Q

 ;

 I NEWTEMP=$P(PXRMTMP,U,2),NEWTEMP=OLDTEMP D MESS(1,NEWTEMP)

 I NEWTEMP=$P(PXRMTMP,U,2),NEWTEMP'=OLDTEMP D MESS(3,OLDTEMP,NEWTEMP)

 ;

 ;If a new template ID is selected then create a new template

 I NEWTEMP'=$P(PXRMTMP,U,2) D  I $D(MSG) S DTOUT=1 Q

 .;Create template header

 .D HEADER

 .;Save edited template detail to new template name

 .D REFILE Q:$D(MSG)

 .;Save Message

 .D MESS(2,NEWTEMP)

 .;File original arrays to old template (rollback ^DIE changes)

 .D FILE^PXRMXTU(PXRMTMP,1,1)

 .;Set selected template ID

 .S PXRMTMP=NEWIEN

 ;

 ;Reload arrays

 D LOAD^PXRMXT I $D(MSG) S DTOUT=1 Q

EXIT Q

 ;

 ;Rename edited template

 ;----------------------

NAME N X,Y,TEXT,DIR

 K DIROUT,DIRUT,DTOUT,DUOUT

 S DIR(0)="FAU"_U_"3:30"_U_"K:'$$OK^PXRMXTF(X) X"

 S DIR("A")="STORE REPORT LOGIC IN TEMPLATE NAME: "

 S DIR("B")=$P(PXRMTMP,U,2)

 S DIR("?")="Enter template name. For detailed help type ??"

 S DIR("??")=U_"D HELP^PXRMXTF(1)"

 W !

 D ^DIR K DIR

 I $D(DIROUT) S DTOUT=1

 I $D(DTOUT)!($D(DUOUT)) Q

 S NEWTEMP=Y

 Q

 ;

 ;Check if the template name is in use

 ;------------------------------------

OK(NAME) ;

 ;Original template name may be used

 I X=DIR("B") Q 1

 I $E(DIR("B"),1,$L(X))=X Q 0

 ;Else check if template name defined

 I '$D(^PXRMPT(810.1,"B",NAME)) Q 1

 Q 0

 ;

 ;Create Template header and get IEN

 ;----------------------------------

HEADER N DATA,IEN,NUM

 ;Otherwise create a new entry

 S DATA=$G(^PXRMPT(810.1,0)),IEN=$P(DATA,U,3),NUM=$P(DATA,U,4)

 F  S IEN=IEN+1 Q:'$D(^PXRMPT(IEN,0))

 S ^PXRMPT(810.1,IEN,0)=NEWTEMP

 S ^PXRMPT(810.1,"B",NEWTEMP,IEN)=""

 S $P(^PXRMPT(810.1,0),U,3)=IEN,$P(^PXRMPT(810.1,0),U,4)=NUM+1

 S NEWIEN=IEN_U_NEWTEMP

 Q

 ;

 ;Redisplay edited template details

 ;---------------------------------------------

REDISP N PXRMLCSC,PXRMPRIM,PXRMREP,PXRMSEL,PXRMTYP,PXRMFD,RUN,PXRMCS

 N PXRMREM,PXRMFAC,PXRMPRV,PXRMPAT,PXRMOTM,PXRMSCAT,PXRMLCHL,PXRMCS

 N PXRMLIST,TITLE

 ;

 ;Load temporary arrays from edited template PXRMTMP

 D LOAD^PXRMXT I $D(MSG) Q

 ;Clear last run date

 S RUN=""

 ;Display

 D ^PXRMXTD

 ;

 Q

 ;

 ;Copy edited template details to new template

 ;---------------------------------------------

REFILE N PXRMLCSC,PXRMPRIM,PXRMREP,PXRMSEL,PXRMTYP,PXRMFD,RUN,PXRMCS

 N PXRMREM,PXRMFAC,PXRMPRV,PXRMPAT,PXRMOTM,PXRMSCAT,PXRMLCHL,PXRMCS

 N PXRMLIST,TITLE

 ;

 ;Load temporary arrays from edited template PXRMTMP

 D LOAD^PXRMXT I $D(MSG) Q

 ;Clear last run date

 S RUN=""

 ;Save arrays to new ID

 D FILE^PXRMXTU(NEWIEN,1,0) Q:$D(MSG)

 Q

 ;

 ;Rollback changes (also called from PXRMXTA)

 ;----------------

ROLL ;

 D FILE^PXRMXTU(PXRMTMP,1,1)

 I $D(MSG) S DTOUT=1 Q

 ;Changes not saved message

 D MESS(0,$P(PXRMTMP,U,2))

 Q

 ;

 ;Filing messages

 ;---------------

MESS(MODE,INP,INP1) ;

 I MODE=0 W !,"Changes to template '"_INP_"' have not been saved" Q

 I MODE=1 W !,"Changes to template '"_INP_"' have been saved"

 I MODE=2 W !,"A new template '"_INP_"' has been created"

 I MODE=3 W !,"Template '"_INP_"' renamed as '"_INP1_"'"

 I MODE=4 W !,"Template '"_INP_"' not saved"

 Q

 ;

 ;General help text routine. Write out the text in the HTEXT array

 ;----------------------------------------------------------------

HELP(CALL) ;

 N HTEXT

 N DIWF,DIWL,DIWR,IC

 S DIWF="C70",DIWL=0,DIWR=70

 ;

 I CALL=1 D

 .S HTEXT(1)="To save or rename the existing template use the default"

 .S HTEXT(2)="name. To create a new template and leave the original "

 .S HTEXT(3)="unchanged enter a different template name "

 .S HTEXT(4)="that is not in use."

 ;

 K ^UTILITY($J,"W")

 S IC=""

 F  S IC=$O(HTEXT(IC)) Q:IC=""  D

 . S X=HTEXT(IC)

 . D ^DIWP

 W !

 S IC=0

 F  S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC=""  D

 . W !,^UTILITY($J,"W",0,IC,0)

 K ^UTILITY($J,"W")

 W !

 Q