- 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 Feb 18, 2025@23:12:27 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 ;