PXRMCFED.m

PXRMCFED ; SLC/PKR - Edit a reminder computed finding. ;06/19/2001

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

 ;

 ;======================================================

 N CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,Y

GETNAME ;Get the name of the computed finding to edit.

 ;Make sure the user has programmer access.

 I DUZ(0)'="@" D  Q

 . W !!,"Only those with programmer's access can perform this function."

 K DA,DIC,DLAYGO,DTOUT,DUOUT,Y

 S DIC="^PXRMD(811.4,"

 S DIC(0)="AEMQL"

 S DIC("A")="Select Reminder Computed Finding: "

 S DIC("S")="I $P(^(0),U,1)'[""VA-"""

 S DLAYGO=811.4

 ;Set the starting place for additions.

 D SETSTART^PXRMCOPY(DIC)

 W !

 D ^DIC

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

 I Y=-1 G END

 S DA=$P(Y,U,1)

 S CS1=$$FILE^PXRMEXCS(811.4,DA)

 D EDIT(DIC,DA)

 S CS2=$$FILE^PXRMEXCS(811.4,DA)

 I CS2=0 Q

 I CS2'=CS1 D SEHIST^PXRMUTIL(811.4,DIC,DA)

 G GETNAME

END ;

 Q

 ;

 ;======================================================

EDIT(ROOT,DA) ;

 N DIE,DR,DIDEL

 S DIE=ROOT,DIDEL=811.4

 S DR="[PXRM EDIT REMINDER CF]"

 D ^DIE

 Q

 ;

PXRMCFED  ; SLC/PKR - Edit a reminder computed finding. ;06/19/2001

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

 +2       ;

 +3       ;======================================================

 +4        NEW CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,Y

GETNAME   ;Get the name of the computed finding to edit.

 +1       ;Make sure the user has programmer access.

 +2        IF DUZ(0)'="@"

               Begin DoDot:1

 +3                WRITE !!,"Only those with programmer's access can perform this function."

               End DoDot:1

               QUIT 

 +4        KILL DA,DIC,DLAYGO,DTOUT,DUOUT,Y

 +5        SET DIC="^PXRMD(811.4,"

 +6        SET DIC(0)="AEMQL"

 +7        SET DIC("A")="Select Reminder Computed Finding: "

 +8        SET DIC("S")="I $P(^(0),U,1)'[""VA-"""

 +9        SET DLAYGO=811.4

 +10      ;Set the starting place for additions.

 +11       DO SETSTART^PXRMCOPY(DIC)

 +12       WRITE !

 +13       DO ^DIC

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

               QUIT 

 +15       IF Y=-1

               GOTO END

 +16       SET DA=$PIECE(Y,U,1)

 +17       SET CS1=$$FILE^PXRMEXCS(811.4,DA)

 +18       DO EDIT(DIC,DA)

 +19       SET CS2=$$FILE^PXRMEXCS(811.4,DA)

 +20       IF CS2=0

               QUIT 

 +21       IF CS2'=CS1

               DO SEHIST^PXRMUTIL(811.4,DIC,DA)

 +22       GOTO GETNAME

END       ;

 +1        QUIT 

 +2       ;

 +3       ;======================================================

EDIT(ROOT,DA) ;

 +1        NEW DIE,DR,DIDEL

 +2        SET DIE=ROOT

           SET DIDEL=811.4

 +3        SET DR="[PXRM EDIT REMINDER CF]"

 +4        DO ^DIE

 +5        QUIT 

 +6       ;