VistA-WorldVistAEHR/r/CLINICAL_REMINDERS-PXRM/PXRMG2E4.m

65 lines
3.4 KiB
Mathematica
Raw Normal View History

2009-11-29 13:37:14 -05:00
PXRMG2E4 ;SLC/JVS -GEC #2 EXTRACT #4 ;7/14/05 08:11
;;2.0;CLINICAL REMINDERS;**2,4**;Feb 04, 2005;Build 21
Q
;
Q
PROGRAM ; Extracts the IEN for the health factors that represents
; each of the home health programs.
I $D(^AUTTHF("B","GEC ADULT DAY HEALTH CARE (REFERRED TO)")) D
.S P441($O(^AUTTHF("B","GEC ADULT DAY HEALTH CARE (REFERRED TO)",0)))=""
I $D(^AUTTHF("B","GEC HOMECARE FUNDING-VA")) D
.S P449($O(^AUTTHF("B","GEC HOMECARE FUNDING-VA",0)))=""
I $D(^AUTTHF("B","GEC HOMEMAKER/HOME HEALTH AIDE")) D
.S P4410($O(^AUTTHF("B","GEC HOMEMAKER/HOME HEALTH AIDE",0)))=""
I $D(^AUTTHF("B","GEC VA IN-HOME RESPITE")) D
.S P4412($O(^AUTTHF("B","GEC VA IN-HOME RESPITE",0)))=""
I $D(^AUTTHF("B","GEC HOME TELEHEALTH (REFERRED TO)")) D
.S P451($O(^AUTTHF("B","GEC HOME TELEHEALTH (REFERRED TO)",0)))=""
I $D(^AUTTHF("B","GEC TELEHEALTH FUNDING-VA")) D
.S P452($O(^AUTTHF("B","GEC TELEHEALTH FUNDING-VA",0)))=""
;
CRITER1 ; Extracts the IEN for the health factors that represents
; the 8 ADL's
I $D(^AUTTHF("B","GEC BATHING HELP/SUPERVISION LAST 7D-YES")) D
.S C212($O(^AUTTHF("B","GEC BATHING HELP/SUPERVISION LAST 7D-YES",0)))=""
I $D(^AUTTHF("B","GEC BATHING PHYS ASST NEEDED LAST 7D-YES")) D
.S C214($O(^AUTTHF("B","GEC BATHING PHYS ASST NEEDED LAST 7D-YES",0)))=""
I $D(^AUTTHF("B","GEC BED POSITIONING HELP LAST 7D-YES")) D
.S C216($O(^AUTTHF("B","GEC BED POSITIONING HELP LAST 7D-YES",0)))=""
I $D(^AUTTHF("B","GEC DRESS HELP/SUPERVISION LAST 7D-YES")) D
.S C218($O(^AUTTHF("B","GEC DRESS HELP/SUPERVISION LAST 7D-YES",0)))=""
I $D(^AUTTHF("B","GEC EATING HELP/SUPERVISION LAST 7D-YES")) D
.S C2110($O(^AUTTHF("B","GEC EATING HELP/SUPERVISION LAST 7D-YES",0)))=""
I $D(^AUTTHF("B","GEC MOVING AROUND INDOORS LAST 7D-YES")) D
.S C2114($O(^AUTTHF("B","GEC MOVING AROUND INDOORS LAST 7D-YES",0)))=""
I $D(^AUTTHF("B","GEC TOILET HELP/SUPERVISION LAST 7D-YES")) D
.S C2118($O(^AUTTHF("B","GEC TOILET HELP/SUPERVISION LAST 7D-YES",0)))=""
I $D(^AUTTHF("B","GEC TRANSFERS HELP/SPRVISION LAST 7D-YES")) D
.S C2120($O(^AUTTHF("B","GEC TRANSFERS HELP/SPRVISION LAST 7D-YES",0)))=""
;
CRITER2 ; Extracts the IEN for the health factors that represents
; the 8 "SIGNIFICANT COGNITIVE IMPARIMENT"
I $D(^AUTTHF("B","GEC CAN BE UNDERSTOOD LAST 7D-NO")) D
.S C221($O(^AUTTHF("B","GEC CAN BE UNDERSTOOD LAST 7D-NO",0)))=""
I $D(^AUTTHF("B","GEC ENDANGERED SAFETY LAST 90D-YES")) D
.S C224($O(^AUTTHF("B","GEC ENDANGERED SAFETY LAST 90D-YES",0)))=""
I $D(^AUTTHF("B","GEC MADE REASONABLE DECISIONS LAST 7D-NO")) D
.S C226($O(^AUTTHF("B","GEC MADE REASONABLE DECISIONS LAST 7D-NO",0)))=""
I $D(^AUTTHF("B","GEC HALLUCINATIONS/DELUSIONS LAST 7D-YES")) D
.S C272($O(^AUTTHF("B","GEC HALLUCINATIONS/DELUSIONS LAST 7D-YES",0)))=""
I $D(^AUTTHF("B","GEC PHYSICALLY ABUSIVE LAST 7D-YES")) D
.S C274($O(^AUTTHF("B","GEC PHYSICALLY ABUSIVE LAST 7D-YES",0)))=""
I $D(^AUTTHF("B","GEC RESISTS CARE LAST 7D-YES")) D
.S C276($O(^AUTTHF("B","GEC RESISTS CARE LAST 7D-YES",0)))=""
I $D(^AUTTHF("B","GEC VERBALLY ABUSIVE LAST 7D-YES")) D
.S C278($O(^AUTTHF("B","GEC VERBALLY ABUSIVE LAST 7D-YES",0)))=""
I $D(^AUTTHF("B","GEC WANDERING LAST 7D-YES")) D
.S C2710($O(^AUTTHF("B","GEC WANDERING LAST 7D-YES",0)))=""
;
CRITER3 ; Extracts the IEN for the health factors that represents
; the 1 "Life expectancy < 6 months"
I $D(^AUTTHF("B","GEC LIFE EXPECTANCY < 6MO-YES")) D
.S C286($O(^AUTTHF("B","GEC LIFE EXPECTANCY < 6MO-YES",0)))=""
;
;Continued in PXRMG2E3