PXRMHTED.m

PXRMHTED ;;BP/WAT - Edit VA-HT PERIODIC EVALUATION ;08/13/13  07:26

 ;;2.0;CLINICAL REMINDERS;**19**;Feb 04, 2005;Build 187

 ; 10026 ^DIR | 10018 ^DIE

 ;This routine runs the option PXRM DEFINITION FREQUENCY EDIT.  It permits a limited edit to the reminder frequency

 ;for the VA-HT PERIODIC EVALUATION reminder definition.  The function findings are also automatically updated with

 ;the new frequency value.

READ() ;reader call

 ;

 N DIR,X,Y

 K DIRUT

 S DIR(0)="F^^I X'=""90D""&(X'=""120D"")&(X'=""180D"")&(X'=""3M"")&(X'=""4M"")&(X'=""6M"") K X"

 S DIR("B")="180D"

 S DIR("A")="Enter a new REMINDER FREQUENCY"

 S DIR("A",1)=""

 S DIR("A",2)="The current frequency for this reminder definition is: "_$G(CURFREQ)

 S DIR("A",3)=""

 ;;

 S DIR("?")="90D (or 3M), 120D (or 4M), 180D (or 6M)"

 S DIR("?",1)="Choose one of the following frequencies for this reminder definition:"

 S DIR("?",2)=""

 D ^DIR K DIR

 I (Y="")!(Y="^") S DUOUT=1

 Q Y

EDIT ;edit call

 ;

 N DA,DIE,DR,CURFREQ,NEWFREQ,DTOUT,DUOUT,FNSTR

 S DA(1)=$O(^PXD(811.9,"B","VA-HT PERIODIC EVALUATION",""))

 S DA=$O(^PXD(811.9,DA(1),7,0))

 S CURFREQ=^PXD(811.9,DA(1),7,DA,0) ;force numeric to remove unit letter

 S NEWFREQ=$$READ^PXRMHTED

 S:CURFREQ="3M" CURFREQ=90 ;ensure frequency in Days & numeric for use in function string

 S:CURFREQ="4M" CURFREQ=120

 S:CURFREQ="6M" CURFREQ=180

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

 S DIE="^PXD(811.9,"_DA(1)_",7,"

 S DR=".01///^S X=NEWFREQ"

 D ^DIE

 S DA=0

 S:NEWFREQ="3M" NEWFREQ=90

 S:NEWFREQ="4M" NEWFREQ=120

 S:NEWFREQ="6M" NEWFREQ=180

 F  S DA=$O(^PXD(811.9,DA(1),25,DA)) Q:+DA=0  D

 .S FNSTR=^PXD(811.9,DA(1),25,DA,3) Q:$G(FNSTR)=""

 .S FNSTR=$$STRREP^PXRMUTIL(FNSTR,+CURFREQ,+NEWFREQ)

 .S DIE="^PXD(811.9,"_DA(1)_",25,"

 .S DR="3///^S X=FNSTR"

 .D ^DIE

 .S FNSTR=""

 W !!,"Done",!

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXRMHTED   1830     printed  Apr 09, 2024@20:51:37                                                                                                                                                                                                    Page 2

PXRMHTED  ;;BP/WAT - Edit VA-HT PERIODIC EVALUATION ;08/13/13  07:26

 +1       ;;2.0;CLINICAL REMINDERS;**19**;Feb 04, 2005;Build 187

 +2       ; 10026 ^DIR | 10018 ^DIE

 +3       ;This routine runs the option PXRM DEFINITION FREQUENCY EDIT.  It permits a limited edit to the reminder frequency

 +4       ;for the VA-HT PERIODIC EVALUATION reminder definition.  The function findings are also automatically updated with

 +5       ;the new frequency value.

READ()    ;reader call

 +1       ;

 +2        NEW DIR,X,Y

 +3        KILL DIRUT

 +4        SET DIR(0)="F^^I X'=""90D""&(X'=""120D"")&(X'=""180D"")&(X'=""3M"")&(X'=""4M"")&(X'=""6M"") K X"

 +5        SET DIR("B")="180D"

 +6        SET DIR("A")="Enter a new REMINDER FREQUENCY"

 +7        SET DIR("A",1)=""

 +8        SET DIR("A",2)="The current frequency for this reminder definition is: "_$GET(CURFREQ)

 +9        SET DIR("A",3)=""

 +10      ;;

 +11       SET DIR("?")="90D (or 3M), 120D (or 4M), 180D (or 6M)"

 +12       SET DIR("?",1)="Choose one of the following frequencies for this reminder definition:"

 +13       SET DIR("?",2)=""

 +14       DO ^DIR

           KILL DIR

 +15       IF (Y="")!(Y="^")

               SET DUOUT=1

 +16       QUIT Y

EDIT      ;edit call

 +1       ;

 +2        NEW DA,DIE,DR,CURFREQ,NEWFREQ,DTOUT,DUOUT,FNSTR

 +3        SET DA(1)=$ORDER(^PXD(811.9,"B","VA-HT PERIODIC EVALUATION",""))

 +4        SET DA=$ORDER(^PXD(811.9,DA(1),7,0))

 +5       ;force numeric to remove unit letter

           SET CURFREQ=^PXD(811.9,DA(1),7,DA,0)

 +6        SET NEWFREQ=$$READ^PXRMHTED

 +7       ;ensure frequency in Days & numeric for use in function string

           if CURFREQ="3M"

               SET CURFREQ=90

 +8        if CURFREQ="4M"

               SET CURFREQ=120

 +9        if CURFREQ="6M"

               SET CURFREQ=180

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

               QUIT 

 +11       SET DIE="^PXD(811.9,"_DA(1)_",7,"

 +12       SET DR=".01///^S X=NEWFREQ"

 +13       DO ^DIE

 +14       SET DA=0

 +15       if NEWFREQ="3M"

               SET NEWFREQ=90

 +16       if NEWFREQ="4M"

               SET NEWFREQ=120

 +17       if NEWFREQ="6M"

               SET NEWFREQ=180

 +18       FOR 

               SET DA=$ORDER(^PXD(811.9,DA(1),25,DA))

               if +DA=0

                   QUIT 

               Begin DoDot:1

 +19               SET FNSTR=^PXD(811.9,DA(1),25,DA,3)

                   if $GET(FNSTR)=""

                       QUIT 

 +20               SET FNSTR=$$STRREP^PXRMUTIL(FNSTR,+CURFREQ,+NEWFREQ)

 +21               SET DIE="^PXD(811.9,"_DA(1)_",25,"

 +22               SET DR="3///^S X=FNSTR"

 +23               DO ^DIE

 +24               SET FNSTR=""

               End DoDot:1

 +25       WRITE !!,"Done",!

 +26       QUIT 

 +27      ;