PXRMXTF.m

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

 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123

 ; 

 ; 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

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

 +1       ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123

 +2       ; 

 +3       ; Called from PXRMXTA

 +4       ;

 +5       ;Select template name and file

 +6       ;-----------------------------

START      NEW NEWIEN,NEWTEMP,OLDTEMP

 +1       ;Save original name

 +2        SET OLDTEMP=$PIECE(PXRMTMP,U,2)

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

 +4        SET $PIECE(PXRMTMP,U,2)=$PIECE($GET(^PXRMPT(810.1,$PIECE(PXRMTMP,U,1),0)),U)

 +5       ;Redisplay changes made

 +6        DO REDISP

 +7       ;Prompt template name

 +8        DO NAME

 +9       ;Rollback ^DIE changes if edit is abandoned

 +10       IF $DATA(DTOUT)!$DATA(DUOUT)

               DO ROLL

               QUIT 

 +11      ;

 +12       IF NEWTEMP=$PIECE(PXRMTMP,U,2)

               IF NEWTEMP=OLDTEMP

                   DO MESS(1,NEWTEMP)

 +13       IF NEWTEMP=$PIECE(PXRMTMP,U,2)

               IF NEWTEMP'=OLDTEMP

                   DO MESS(3,OLDTEMP,NEWTEMP)

 +14      ;

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

 +16       IF NEWTEMP'=$PIECE(PXRMTMP,U,2)

               Begin DoDot:1

 +17      ;Create template header

 +18               DO HEADER

 +19      ;Save edited template detail to new template name

 +20               DO REFILE

                   IF $DATA(MSG)

                       QUIT 

 +21      ;Save Message

 +22               DO MESS(2,NEWTEMP)

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

 +24               DO FILE^PXRMXTU(PXRMTMP,1,1)

 +25      ;Set selected template ID

 +26               SET PXRMTMP=NEWIEN

               End DoDot:1

               IF $DATA(MSG)

                   SET DTOUT=1

                   QUIT 

 +27      ;

 +28      ;Reload arrays

 +29       DO LOAD^PXRMXT

           IF $DATA(MSG)

               SET DTOUT=1

               QUIT 

EXIT       QUIT 

 +1       ;

 +2       ;Rename edited template

 +3       ;----------------------

NAME       NEW X,Y,TEXT,DIR

 +1        KILL DIROUT,DIRUT,DTOUT,DUOUT

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

 +3        SET DIR("A")="STORE REPORT LOGIC IN TEMPLATE NAME: "

 +4        SET DIR("B")=$PIECE(PXRMTMP,U,2)

 +5        SET DIR("?")="Enter template name. For detailed help type ??"

 +6        SET DIR("??")=U_"D HELP^PXRMXTF(1)"

 +7        WRITE !

 +8        DO ^DIR

           KILL DIR

 +9        IF $DATA(DIROUT)

               SET DTOUT=1

 +10       IF $DATA(DTOUT)!($DATA(DUOUT))

               QUIT 

 +11       SET NEWTEMP=Y

 +12       QUIT 

 +13      ;

 +14      ;Check if the template name is in use

 +15      ;------------------------------------

OK(NAME)  ;

 +1       ;Original template name may be used

 +2        IF X=DIR("B")

               QUIT 1

 +3        IF $EXTRACT(DIR("B"),1,$LENGTH(X))=X

               QUIT 0

 +4       ;Else check if template name defined

 +5        IF '$DATA(^PXRMPT(810.1,"B",NAME))

               QUIT 1

 +6        QUIT 0

 +7       ;

 +8       ;Create Template header and get IEN

 +9       ;----------------------------------

HEADER     NEW DATA,IEN,NUM

 +1       ;Otherwise create a new entry

 +2        SET DATA=$GET(^PXRMPT(810.1,0))

           SET IEN=$PIECE(DATA,U,3)

           SET NUM=$PIECE(DATA,U,4)

 +3        FOR 

               SET IEN=IEN+1

               IF '$DATA(^PXRMPT(IEN,0))

                   QUIT 

 +4        SET ^PXRMPT(810.1,IEN,0)=NEWTEMP

 +5        SET ^PXRMPT(810.1,"B",NEWTEMP,IEN)=""

 +6        SET $PIECE(^PXRMPT(810.1,0),U,3)=IEN

           SET $PIECE(^PXRMPT(810.1,0),U,4)=NUM+1

 +7        SET NEWIEN=IEN_U_NEWTEMP

 +8        QUIT 

 +9       ;

 +10      ;Redisplay edited template details

 +11      ;---------------------------------------------

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

 +1        NEW PXRMREM,PXRMFAC,PXRMPRV,PXRMPAT,PXRMOTM,PXRMSCAT,PXRMLCHL,PXRMCS

 +2        NEW PXRMLIST,TITLE

 +3       ;

 +4       ;Load temporary arrays from edited template PXRMTMP

 +5        DO LOAD^PXRMXT

           IF $DATA(MSG)

               QUIT 

 +6       ;Clear last run date

 +7        SET RUN=""

 +8       ;Display

 +9        DO ^PXRMXTD

 +10      ;

 +11       QUIT 

 +12      ;

 +13      ;Copy edited template details to new template

 +14      ;---------------------------------------------

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

 +1        NEW PXRMREM,PXRMFAC,PXRMPRV,PXRMPAT,PXRMOTM,PXRMSCAT,PXRMLCHL,PXRMCS

 +2        NEW PXRMLIST,TITLE

 +3       ;

 +4       ;Load temporary arrays from edited template PXRMTMP

 +5        DO LOAD^PXRMXT

           IF $DATA(MSG)

               QUIT 

 +6       ;Clear last run date

 +7        SET RUN=""

 +8       ;Save arrays to new ID

 +9        DO FILE^PXRMXTU(NEWIEN,1,0)

           IF $DATA(MSG)

               QUIT 

 +10       QUIT 

 +11      ;

 +12      ;Rollback changes (also called from PXRMXTA)

 +13      ;----------------

ROLL      ;

 +1        DO FILE^PXRMXTU(PXRMTMP,1,1)

 +2        IF $DATA(MSG)

               SET DTOUT=1

               QUIT 

 +3       ;Changes not saved message

 +4        DO MESS(0,$PIECE(PXRMTMP,U,2))

 +5        QUIT 

 +6       ;

 +7       ;Filing messages

 +8       ;---------------

MESS(MODE,INP,INP1) ;

 +1        IF MODE=0

               WRITE !,"Changes to template '"_INP_"' have not been saved"

               QUIT 

 +2        IF MODE=1

               WRITE !,"Changes to template '"_INP_"' have been saved"

 +3        IF MODE=2

               WRITE !,"A new template '"_INP_"' has been created"

 +4        IF MODE=3

               WRITE !,"Template '"_INP_"' renamed as '"_INP1_"'"

 +5        IF MODE=4

               WRITE !,"Template '"_INP_"' not saved"

 +6        QUIT 

 +7       ;

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

 +9       ;----------------------------------------------------------------

HELP(CALL) ;

 +1        NEW HTEXT

 +2        NEW DIWF,DIWL,DIWR,IC

 +3        SET DIWF="C70"

           SET DIWL=0

           SET DIWR=70

 +4       ;

 +5        IF CALL=1

               Begin DoDot:1

 +6                SET HTEXT(1)="To save or rename the existing template use the default"

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

 +8                SET HTEXT(3)="unchanged enter a different template name "

 +9                SET HTEXT(4)="that is not in use."

               End DoDot:1

 +10      ;

 +11       KILL ^UTILITY($JOB,"W")

 +12       SET IC=""

 +13       FOR 

               SET IC=$ORDER(HTEXT(IC))

               IF IC=""

                   QUIT 

               Begin DoDot:1

 +14               SET X=HTEXT(IC)

 +15               DO ^DIWP

               End DoDot:1

 +16       WRITE !

 +17       SET IC=0

 +18       FOR 

               SET IC=$ORDER(^UTILITY($JOB,"W",0,IC))

               IF IC=""

                   QUIT 

               Begin DoDot:1

 +19               WRITE !,^UTILITY($JOB,"W",0,IC,0)

               End DoDot:1

 +20       KILL ^UTILITY($JOB,"W")

 +21       WRITE !

 +22       QUIT