source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMV2IR.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1PXRMV2IR ; SLC/JVS,PKR - Version 2.0 init routine. ;07/06/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;Reminder Exchange init rouines.
4 ;Rescinding of National Reminders
5 Q
6 ;The purpose of this routine is to rescind old national reminders
7 ;that are no longer needed. The name is changed to add "ZZVA" in the
8 ;place of VA,and inactivate it.
9 ;=================================================
10EN ;Start of loop for rescinding national reminders
11 D BMES^XPDUTL("Rescinding outdated National Reminders")
12 N II,OREM,OREMDA,PNAME,RDATEI,REM
13 N TEMP,TEXT,X,Y,ZZREM,ZZREMDA
14 ;Get the date to use from the second line.
15 S X=$P($T(+2^PXRMV2IR),";",6) D ^%DT
16 S RDATEI=Y
17 F II=1:1 S TEMP=$T(TEXT+II),OREM=$P(TEMP,";",3) Q:OREM="END" D
18 . S ZZREM=$P(TEMP,";",4)
19 . S OREMDA=+$O(^PXD(811.9,"B",OREM,0))
20 . I OREMDA>0 D
21 .. K REM
22 .. S PNAME=$P($G(^PXD(811.9,OREMDA,0)),"^",3)
23 .. S REM(1,811.9,OREMDA_",",.01)=ZZREM
24 .. S REM(1,811.9,OREMDA_",",1.6)=1
25 .. S REM(1,811.9,OREMDA_",",1.2)="ZZ "_PNAME
26 .. S REM(1,811.9,OREMDA_",",69)=RDATEI
27 .. D FILE^DIE("","REM(1)")
28 .. S TEXT(1)="Rescinding reminder: "_OREM
29 .. S TEXT(2)="It was renamed to: "_ZZREM
30 .. S TEXT(3)=""
31 .. D BMES^XPDUTL(.TEXT)
32 .;Keep the rescission date updated for test sites.
33 . S ZZREMDA=+$O(^PXD(811.9,"B",ZZREM,0))
34 . I ZZREMDA>0 D
35 .. K REM
36 .. S REM(1,811.9,ZZREMDA_",",69)=RDATEI
37 .. D FILE^DIE("","REM(1)")
38 Q
39 ;=================================================
40TEXT ;
41 ;;VA-*BREAST CANCER SCREEN;ZZVA-*BREAST CANCER SCREEN
42 ;;VA-*CERVICAL CANCER SCREEN;ZZVA-*CERVICAL CANCER SCREEN
43 ;;VA-*CHOLESTEROL SCREEN (F);ZZVA-*CHOLESTEROL SCREEN (F)
44 ;;VA-*CHOLESTEROL SCREEN (M);ZZVA-*CHOLESTEROL SCREEN (M)
45 ;;VA-*COLORECTAL CANCER SCREEN (FOBT);ZZVA-*COLORECTAL CANCER SCREEN (FOBT)
46 ;;VA-*COLORECTAL CANCER SCREEN (SIG.);ZZVA-*COLORECTAL CANCER SCREEN (SIG.)
47 ;;VA-*FITNESS AND EXERCISE SCREEN;ZZVA-*FITNESS AND EXERCISE SCREEN
48 ;;VA-*HYPERTENSION SCREEN;ZZVA-*HYPERTENSION SCREEN
49 ;;VA-*INFLUENZA IMMUNIZATION;ZZVA-*INFLUENZA IMMUNIZATION
50 ;;VA-*PNEUMOCOCCAL VACCINE;ZZVA-*PNEUMOCOCCAL VACCINE
51 ;;VA-*PROBLEM DRINKING SCREEN;ZZVA-*PROBLEM DRINKING SCREEN
52 ;;VA-*SEATBELT AND ACCIDENT SCREEN;ZZVA-*SEATBELT AND ACCIDENT SCREEN
53 ;;VA-*TETANUS DIPHTHERIA IMMUNIZATION;ZZVA-*TETANUS DIPHTHERIA IMMUNIZATION
54 ;;VA-*TOBACCO USE SCREEN;ZZVA-*TOBACCO USE SCREEN
55 ;;VA-*WEIGHT AND NUTRITION SCREEN;ZZVA-*WEIGHT AND NUTRITION SCREEN
56 ;;VA-ADVANCED DIRECTIVES EDUCATION;ZZVA-ADVANCED DIRECTIVES EDUCATION
57 ;;VA-ALCOHOL ABUSE EDUCATION;ZZVA-ALCOHOL ABUSE EDUCATION
58 ;;VA-BLOOD PRESSURE CHECK;ZZVA-BLOOD PRESSURE CHECK
59 ;;VA-BREAST EXAM;ZZVA-BREAST EXAM
60 ;;VA-BREAST SELF EXAM EDUCATION;ZZVA-BREAST SELF EXAM EDUCATION
61 ;;VA-DIABETIC EYE EXAM;ZZVA-DIABETIC EYE EXAM
62 ;;VA-DIABETIC FOOT CARE ED.;ZZVA-DIABETIC FOOT CARE ED.
63 ;;VA-DIABETIC FOOT EXAM;ZZVA-DIABETIC FOOT EXAM
64 ;;VA-DIGITAL RECTAL (PROSTATE) EXAM;ZZVA-DIGITAL RECTAL (PROSTATE) EXAM
65 ;;VA-EXERCISE EDUCATION;ZZVA-EXERCISE EDUCATION
66 ;;VA-FECAL OCCULT BLOOD TEST;ZZVA-FECAL OCCULT BLOOD TEST
67 ;;VA-FLEXISIGMOIDOSCOPY;ZZVA-FLEXISIGMOIDOSCOPY
68 ;;VA-INFLUENZA VACCINE;ZZVA-INFLUENZA VACCINE
69 ;;VA-MAMMOGRAM;ZZVA-MAMMOGRAM
70 ;;VA-NUTRITION/OBESITY EDUCATION;ZZVA-NUTRITION/OBESITY EDUCATION
71 ;;VA-PAP SMEAR;ZZVA-PAP SMEAR
72 ;;VA-PNEUMOVAX;ZZVA-PNEUMOVAX
73 ;;VA-PPD;ZZVA-PPD
74 ;;VA-PSA;ZZVA-PSA
75 ;;VA-SEATBELT EDUCATION;ZZVA-SEATBELT EDUCATION
76 ;;VA-TOBACCO EDUCATION;ZZVA-TOBACCO EDUCATION
77 ;;VA-WEIGHT;ZZVA-WEIGHT
78 ;;END
79 Q
80 ;=================================================
81UNDO ;Undo all the changes
82 N II,OREM,OREMDA,PNAME,TEMP,ZZREM,ZZREMDA
83 F II=1:1 S TEMP=$T(TEXT+II),OREM=$P(TEMP,";",3) Q:OREM="END" D
84 . S ZZREM=$P(TEMP,";",4)
85 . S OREMDA=+$O(^PXD(811.9,"B",OREM,0))
86 . I OREMDA>0 Q
87 . S ZZREMDA=+$O(^PXD(811.9,"B",ZZREM,0))
88 . I ZZREMDA>0 D
89 .. S PNAME=$P($G(^PXD(811.9,ZZREMDA,0)),"^",3)
90 .. K REM
91 .. S REM(1,811.9,ZZREMDA_",",.01)=OREM
92 .. S REM(1,811.9,ZZREMDA_",",1.6)=""
93 .. S REM(1,811.9,ZZREMDA_",",1.2)=$P(PNAME,"ZZ ",$L(PNAME,"ZZ "))
94 .. S REM(1,811.9,ZZREMDA_",",69)=""
95 .. D FILE^DIE("","REM(1)")
96 Q
97 ;
Note: See TracBrowser for help on using the repository browser.