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
;----------------------------------
;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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXTF 4400 printed Apr 09, 2024@20:48:35 Page 2
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 ;----------------------------------
+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
