PXRMV2IR ; SLC/JVS,PKR - Version 2.0 init routine. ;07/06/2004
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;Reminder Exchange init rouines.
;Rescinding of National Reminders
Q
;The purpose of this routine is to rescind old national reminders
;that are no longer needed. The name is changed to add "ZZVA" in the
;place of VA,and inactivate it.
;=================================================
EN ;Start of loop for rescinding national reminders
D BMES^XPDUTL("Rescinding outdated National Reminders")
N II,OREM,OREMDA,PNAME,RDATEI,REM
N TEMP,TEXT,X,Y,ZZREM,ZZREMDA
;Get the date to use from the second line.
S X=$P($T(+2^PXRMV2IR),";",6) D ^%DT
S RDATEI=Y
F II=1:1 S TEMP=$T(TEXT+II),OREM=$P(TEMP,";",3) Q:OREM="END" D
. S ZZREM=$P(TEMP,";",4)
. S OREMDA=+$O(^PXD(811.9,"B",OREM,0))
. I OREMDA>0 D
.. K REM
.. S PNAME=$P($G(^PXD(811.9,OREMDA,0)),"^",3)
.. S REM(1,811.9,OREMDA_",",.01)=ZZREM
.. S REM(1,811.9,OREMDA_",",1.6)=1
.. S REM(1,811.9,OREMDA_",",1.2)="ZZ "_PNAME
.. S REM(1,811.9,OREMDA_",",69)=RDATEI
.. D FILE^DIE("","REM(1)")
.. S TEXT(1)="Rescinding reminder: "_OREM
.. S TEXT(2)="It was renamed to: "_ZZREM
.. S TEXT(3)=""
.. D BMES^XPDUTL(.TEXT)
.;Keep the rescission date updated for test sites.
. S ZZREMDA=+$O(^PXD(811.9,"B",ZZREM,0))
. I ZZREMDA>0 D
.. K REM
.. S REM(1,811.9,ZZREMDA_",",69)=RDATEI
.. D FILE^DIE("","REM(1)")
Q
;=================================================
TEXT ;
;;VA-*BREAST CANCER SCREEN;ZZVA-*BREAST CANCER SCREEN
;;VA-*CERVICAL CANCER SCREEN;ZZVA-*CERVICAL CANCER SCREEN
;;VA-*CHOLESTEROL SCREEN (F);ZZVA-*CHOLESTEROL SCREEN (F)
;;VA-*CHOLESTEROL SCREEN (M);ZZVA-*CHOLESTEROL SCREEN (M)
;;VA-*COLORECTAL CANCER SCREEN (FOBT);ZZVA-*COLORECTAL CANCER SCREEN (FOBT)
;;VA-*COLORECTAL CANCER SCREEN (SIG.);ZZVA-*COLORECTAL CANCER SCREEN (SIG.)
;;VA-*FITNESS AND EXERCISE SCREEN;ZZVA-*FITNESS AND EXERCISE SCREEN
;;VA-*HYPERTENSION SCREEN;ZZVA-*HYPERTENSION SCREEN
;;VA-*INFLUENZA IMMUNIZATION;ZZVA-*INFLUENZA IMMUNIZATION
;;VA-*PNEUMOCOCCAL VACCINE;ZZVA-*PNEUMOCOCCAL VACCINE
;;VA-*PROBLEM DRINKING SCREEN;ZZVA-*PROBLEM DRINKING SCREEN
;;VA-*SEATBELT AND ACCIDENT SCREEN;ZZVA-*SEATBELT AND ACCIDENT SCREEN
;;VA-*TETANUS DIPHTHERIA IMMUNIZATION;ZZVA-*TETANUS DIPHTHERIA IMMUNIZATION
;;VA-*TOBACCO USE SCREEN;ZZVA-*TOBACCO USE SCREEN
;;VA-*WEIGHT AND NUTRITION SCREEN;ZZVA-*WEIGHT AND NUTRITION SCREEN
;;VA-ADVANCED DIRECTIVES EDUCATION;ZZVA-ADVANCED DIRECTIVES EDUCATION
;;VA-ALCOHOL ABUSE EDUCATION;ZZVA-ALCOHOL ABUSE EDUCATION
;;VA-BLOOD PRESSURE CHECK;ZZVA-BLOOD PRESSURE CHECK
;;VA-BREAST EXAM;ZZVA-BREAST EXAM
;;VA-BREAST SELF EXAM EDUCATION;ZZVA-BREAST SELF EXAM EDUCATION
;;VA-DIABETIC EYE EXAM;ZZVA-DIABETIC EYE EXAM
;;VA-DIABETIC FOOT CARE ED.;ZZVA-DIABETIC FOOT CARE ED.
;;VA-DIABETIC FOOT EXAM;ZZVA-DIABETIC FOOT EXAM
;;VA-DIGITAL RECTAL (PROSTATE) EXAM;ZZVA-DIGITAL RECTAL (PROSTATE) EXAM
;;VA-EXERCISE EDUCATION;ZZVA-EXERCISE EDUCATION
;;VA-FECAL OCCULT BLOOD TEST;ZZVA-FECAL OCCULT BLOOD TEST
;;VA-FLEXISIGMOIDOSCOPY;ZZVA-FLEXISIGMOIDOSCOPY
;;VA-INFLUENZA VACCINE;ZZVA-INFLUENZA VACCINE
;;VA-MAMMOGRAM;ZZVA-MAMMOGRAM
;;VA-NUTRITION/OBESITY EDUCATION;ZZVA-NUTRITION/OBESITY EDUCATION
;;VA-PAP SMEAR;ZZVA-PAP SMEAR
;;VA-PNEUMOVAX;ZZVA-PNEUMOVAX
;;VA-PPD;ZZVA-PPD
;;VA-PSA;ZZVA-PSA
;;VA-SEATBELT EDUCATION;ZZVA-SEATBELT EDUCATION
;;VA-TOBACCO EDUCATION;ZZVA-TOBACCO EDUCATION
;;VA-WEIGHT;ZZVA-WEIGHT
;;END
Q
;=================================================
UNDO ;Undo all the changes
N II,OREM,OREMDA,PNAME,TEMP,ZZREM,ZZREMDA
F II=1:1 S TEMP=$T(TEXT+II),OREM=$P(TEMP,";",3) Q:OREM="END" D
. S ZZREM=$P(TEMP,";",4)
. S OREMDA=+$O(^PXD(811.9,"B",OREM,0))
. I OREMDA>0 Q
. S ZZREMDA=+$O(^PXD(811.9,"B",ZZREM,0))
. I ZZREMDA>0 D
.. S PNAME=$P($G(^PXD(811.9,ZZREMDA,0)),"^",3)
.. K REM
.. S REM(1,811.9,ZZREMDA_",",.01)=OREM
.. S REM(1,811.9,ZZREMDA_",",1.6)=""
.. S REM(1,811.9,ZZREMDA_",",1.2)=$P(PNAME,"ZZ ",$L(PNAME,"ZZ "))
.. S REM(1,811.9,ZZREMDA_",",69)=""
.. D FILE^DIE("","REM(1)")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMV2IR 4133 printed Dec 13, 2024@01:49:53 Page 2
PXRMV2IR ; SLC/JVS,PKR - Version 2.0 init routine. ;07/06/2004
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;Reminder Exchange init rouines.
+3 ;Rescinding of National Reminders
+4 QUIT
+5 ;The purpose of this routine is to rescind old national reminders
+6 ;that are no longer needed. The name is changed to add "ZZVA" in the
+7 ;place of VA,and inactivate it.
+8 ;=================================================
EN ;Start of loop for rescinding national reminders
+1 DO BMES^XPDUTL("Rescinding outdated National Reminders")
+2 NEW II,OREM,OREMDA,PNAME,RDATEI,REM
+3 NEW TEMP,TEXT,X,Y,ZZREM,ZZREMDA
+4 ;Get the date to use from the second line.
+5 SET X=$PIECE($TEXT(+2^PXRMV2IR),";",6)
DO ^%DT
+6 SET RDATEI=Y
+7 FOR II=1:1
SET TEMP=$TEXT(TEXT+II)
SET OREM=$PIECE(TEMP,";",3)
if OREM="END"
QUIT
Begin DoDot:1
+8 SET ZZREM=$PIECE(TEMP,";",4)
+9 SET OREMDA=+$ORDER(^PXD(811.9,"B",OREM,0))
+10 IF OREMDA>0
Begin DoDot:2
+11 KILL REM
+12 SET PNAME=$PIECE($GET(^PXD(811.9,OREMDA,0)),"^",3)
+13 SET REM(1,811.9,OREMDA_",",.01)=ZZREM
+14 SET REM(1,811.9,OREMDA_",",1.6)=1
+15 SET REM(1,811.9,OREMDA_",",1.2)="ZZ "_PNAME
+16 SET REM(1,811.9,OREMDA_",",69)=RDATEI
+17 DO FILE^DIE("","REM(1)")
+18 SET TEXT(1)="Rescinding reminder: "_OREM
+19 SET TEXT(2)="It was renamed to: "_ZZREM
+20 SET TEXT(3)=""
+21 DO BMES^XPDUTL(.TEXT)
End DoDot:2
+22 ;Keep the rescission date updated for test sites.
+23 SET ZZREMDA=+$ORDER(^PXD(811.9,"B",ZZREM,0))
+24 IF ZZREMDA>0
Begin DoDot:2
+25 KILL REM
+26 SET REM(1,811.9,ZZREMDA_",",69)=RDATEI
+27 DO FILE^DIE("","REM(1)")
End DoDot:2
End DoDot:1
+28 QUIT
+29 ;=================================================
TEXT ;
+1 ;;VA-*BREAST CANCER SCREEN;ZZVA-*BREAST CANCER SCREEN
+2 ;;VA-*CERVICAL CANCER SCREEN;ZZVA-*CERVICAL CANCER SCREEN
+3 ;;VA-*CHOLESTEROL SCREEN (F);ZZVA-*CHOLESTEROL SCREEN (F)
+4 ;;VA-*CHOLESTEROL SCREEN (M);ZZVA-*CHOLESTEROL SCREEN (M)
+5 ;;VA-*COLORECTAL CANCER SCREEN (FOBT);ZZVA-*COLORECTAL CANCER SCREEN (FOBT)
+6 ;;VA-*COLORECTAL CANCER SCREEN (SIG.);ZZVA-*COLORECTAL CANCER SCREEN (SIG.)
+7 ;;VA-*FITNESS AND EXERCISE SCREEN;ZZVA-*FITNESS AND EXERCISE SCREEN
+8 ;;VA-*HYPERTENSION SCREEN;ZZVA-*HYPERTENSION SCREEN
+9 ;;VA-*INFLUENZA IMMUNIZATION;ZZVA-*INFLUENZA IMMUNIZATION
+10 ;;VA-*PNEUMOCOCCAL VACCINE;ZZVA-*PNEUMOCOCCAL VACCINE
+11 ;;VA-*PROBLEM DRINKING SCREEN;ZZVA-*PROBLEM DRINKING SCREEN
+12 ;;VA-*SEATBELT AND ACCIDENT SCREEN;ZZVA-*SEATBELT AND ACCIDENT SCREEN
+13 ;;VA-*TETANUS DIPHTHERIA IMMUNIZATION;ZZVA-*TETANUS DIPHTHERIA IMMUNIZATION
+14 ;;VA-*TOBACCO USE SCREEN;ZZVA-*TOBACCO USE SCREEN
+15 ;;VA-*WEIGHT AND NUTRITION SCREEN;ZZVA-*WEIGHT AND NUTRITION SCREEN
+16 ;;VA-ADVANCED DIRECTIVES EDUCATION;ZZVA-ADVANCED DIRECTIVES EDUCATION
+17 ;;VA-ALCOHOL ABUSE EDUCATION;ZZVA-ALCOHOL ABUSE EDUCATION
+18 ;;VA-BLOOD PRESSURE CHECK;ZZVA-BLOOD PRESSURE CHECK
+19 ;;VA-BREAST EXAM;ZZVA-BREAST EXAM
+20 ;;VA-BREAST SELF EXAM EDUCATION;ZZVA-BREAST SELF EXAM EDUCATION
+21 ;;VA-DIABETIC EYE EXAM;ZZVA-DIABETIC EYE EXAM
+22 ;;VA-DIABETIC FOOT CARE ED.;ZZVA-DIABETIC FOOT CARE ED.
+23 ;;VA-DIABETIC FOOT EXAM;ZZVA-DIABETIC FOOT EXAM
+24 ;;VA-DIGITAL RECTAL (PROSTATE) EXAM;ZZVA-DIGITAL RECTAL (PROSTATE) EXAM
+25 ;;VA-EXERCISE EDUCATION;ZZVA-EXERCISE EDUCATION
+26 ;;VA-FECAL OCCULT BLOOD TEST;ZZVA-FECAL OCCULT BLOOD TEST
+27 ;;VA-FLEXISIGMOIDOSCOPY;ZZVA-FLEXISIGMOIDOSCOPY
+28 ;;VA-INFLUENZA VACCINE;ZZVA-INFLUENZA VACCINE
+29 ;;VA-MAMMOGRAM;ZZVA-MAMMOGRAM
+30 ;;VA-NUTRITION/OBESITY EDUCATION;ZZVA-NUTRITION/OBESITY EDUCATION
+31 ;;VA-PAP SMEAR;ZZVA-PAP SMEAR
+32 ;;VA-PNEUMOVAX;ZZVA-PNEUMOVAX
+33 ;;VA-PPD;ZZVA-PPD
+34 ;;VA-PSA;ZZVA-PSA
+35 ;;VA-SEATBELT EDUCATION;ZZVA-SEATBELT EDUCATION
+36 ;;VA-TOBACCO EDUCATION;ZZVA-TOBACCO EDUCATION
+37 ;;VA-WEIGHT;ZZVA-WEIGHT
+38 ;;END
+39 QUIT
+40 ;=================================================
UNDO ;Undo all the changes
+1 NEW II,OREM,OREMDA,PNAME,TEMP,ZZREM,ZZREMDA
+2 FOR II=1:1
SET TEMP=$TEXT(TEXT+II)
SET OREM=$PIECE(TEMP,";",3)
if OREM="END"
QUIT
Begin DoDot:1
+3 SET ZZREM=$PIECE(TEMP,";",4)
+4 SET OREMDA=+$ORDER(^PXD(811.9,"B",OREM,0))
+5 IF OREMDA>0
QUIT
+6 SET ZZREMDA=+$ORDER(^PXD(811.9,"B",ZZREM,0))
+7 IF ZZREMDA>0
Begin DoDot:2
+8 SET PNAME=$PIECE($GET(^PXD(811.9,ZZREMDA,0)),"^",3)
+9 KILL REM
+10 SET REM(1,811.9,ZZREMDA_",",.01)=OREM
+11 SET REM(1,811.9,ZZREMDA_",",1.6)=""
+12 SET REM(1,811.9,ZZREMDA_",",1.2)=$PIECE(PNAME,"ZZ ",$LENGTH(PNAME,"ZZ "))
+13 SET REM(1,811.9,ZZREMDA_",",69)=""
+14 DO FILE^DIE("","REM(1)")
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
