- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCFED 1069 printed Feb 18, 2025@23:09:34 Page 2
- 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 ;