source: FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMV2IR.m@ 636

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
 ;