PXRMV2IR.m

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 ---PXRMV2IR   4133     printed  Apr 23, 2025@18:04:20                                                                                                                                                                                                    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      ;