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 ---[H[J[2J[HPXRMHTED 1830 printed Dec 13, 2024@01:46:04 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 ;
