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

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 6.4 KB
Line 
1PXRMGECZ ;SLC/JVS - GEC Debug Utilities#3 ;7/14/05 10:46
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 Q
5PAGE ;On printed reports, form feed and add page numbers
6 I $Y=(IOSL-2)!($Y>IOSL) W @IOF D
7 .S PAGE=PAGE+1
8 .W !,?(IOM-10),"Page "_PAGE,!
9 Q
10 ;
11MATCHB ;Build tmp global with origingal health factor names from PXRMGECY
12 ;
13 N GECNA,I,GECDA
14 S CNT=0
15 S GECNA=""
16 F I=1:1:301 S GECNA=$P($T(MATCH+I),";",4) S CNT=CNT+1 Q:GECNA="" D
17 .S GECDA=$P($T(MATCH+I),";",3)
18 .S ^TMP("PXRMGEC",$J,"MATCH",GECNA,$S(GECDA="":0,1:$P($T(MATCH+I),";",3)))=""
19 ;
20 Q
21 ;
22MATCH ;MATCH AGINST
23 ;;100;GEC ALL INCLUSIVE CARE/PACE PROGRAM
24 ;;117;GEC ASSISTED LIVING (REFERRING TO)
25 ;;147;GEC CHORE SERVICES IN HOME
26 ;;185;GEC DOMICILIARY CARE
27 ;;218;GEC RESPITE CARE OUTPATIENT
28 ;;226;GEC HOME BASED PR. CARE (REFERRING TO)
29 ;;263;GEC LONG TERM NURSING HOME CARE
30 ;;300;GEC OTHER REFERRAL PROGRAM(REFERRING TO)
31 ;;313;GEC INPATIENT PALLIATIVE/HOSPICE (NHCU)
32 ;;367;GEC RESIDENTIAL CARE (SUPERVISED LIVING)
33 ;;370;GEC RESPITE CARE INPATIENT
34 ;;374;GEC SHORT TERM NURSING HOME CARE
35 ;;375;GEC SKILLED CARE IN HOME
36 ;;384;GEC SPECIALIZED DEMENTIA/GEROPSYCH CARE
37 ;;340;GEC REFERRAL DOMICILIARY
38 ;;186;GEC DOMICILIARY FUNDING-MEDICAID
39 ;;187;GEC DOMICILIARY FUNDING-MEDICARE
40 ;;188;GEC DOMICILIARY FUNDING-OTHER
41 ;;189;GEC DOMICILIARY FUNDING-OTHER INSURANCE
42 ;;190;GEC DOMICILIARY FUNDING-PRIVATE PAY
43 ;;191;GEC DOMICILIARY FUNDING-VA
44 ;;387;GEC STATE HOME DOMICILIARY
45 ;;417;GEC VA DOMICILIARY (REFERRED TO)
46 ;;343;GEC REFERRAL GERIATRIC SERVICES
47 ;;210;GEC GERI SERVICES FUNDING-MEDICAID
48 ;;211;GEC GERI SERVICES FUNDING-MEDICARE
49 ;;212;GEC GERI SERVICES FUNDING-OTHER
50 ;;213;GEC GERI SERVICES FUNDING-OTHER INSURER
51 ;;214;GEC GERI SERVICES FUNDING-PRIVATE PAY
52 ;;215;GEC GERI SERVICES FUNDING-VA
53 ;;216;GEC GERIATRIC EVAL/MGMT CLINIC
54 ;;217;GEC GERIATRIC EVAL/MGMT INPT UNIT
55 ;;219;GEC GERIATRIC PRIMARY CARE
56 ;;345;GEC REFERRAL HOME CARE
57 ;;95;GEC ADULT DAY HEALTH CARE (REFERRED TO)
58 ;;153;GEC COMMUNITY SKILLED HOME HEALTH CARE
59 ;;225;GEC HOME BASED PR. CARE (REFERRED TO)
60 ;;231;GEC HOMECARE FUNDING-MEDICAID
61 ;;232;GEC HOMECARE FUNDING-MEDICARE
62 ;;233;GEC HOMECARE FUNDING-OTHER
63 ;;234;GEC HOMECARE FUNDING-OTHER INSURANCE
64 ;;235;GEC HOMECARE FUNDING-PRIVATE PAY
65 ;;236;GEC HOMECARE FUNDING-VA
66 ;;239;GEC HOMEMAKER/HOME HEALTH AIDE
67 ;;415;GEC VA BOWEL AND BLADDER
68 ;;418;GEC VA IN-HOME RESPITE
69 ;;347;GEC REFERRAL HOSPICE CARE
70 ;;149;GEC COMMUNITY HOSPICE
71 ;;240;GEC HOSPICE FUNDING-MEDICAID
72 ;;241;GEC HOSPICE FUNDING-MEDICARE
73 ;;242;GEC HOSPICE FUNDING-OTHER
74 ;;243;GEC HOSPICE FUNDING-OTHER INSURANCE
75 ;;244;GEC HOSPICE FUNDING-PRIVATE PAY
76 ;;245;GEC HOSPICE FUNDING-VA
77 ;;421;GEC VA NHCU (RESPITE HOSPICE)
78 ;;425;GEC VA OUTPATIENT HOSPICE
79 ;;276;GEC REFERRAL NOT REFERRED TO CARE
80 ;;183;GEC DOES NOT MEET CRITERIA
81 ;;254;GEC INSUFFICIENT FINANCIAL RESOURCES
82 ;;317;GEC PATIENT BECAME TOO ILL
83 ;;318;GEC PATIENT EXPIRED
84 ;;326;GEC PROGRAM UNABLE TO ACCOMMODATE
85 ;;352;GEC REFERRAL NURSING HOME CARE
86 ;;151;GEC COMMUNITY NURSING HOME
87 ;;279;GEC NURSING HOME FUNDING-MEDICAID
88 ;;280;GEC NURSING HOME FUNDING-MEDICARE
89 ;;281;GEC NURSING HOME FUNDING-OTHER
90 ;;282;GEC NURSING HOME FUNDING-OTHER INSURANCE
91 ;;283;GEC NURSING HOME FUNDING-PRIVATE PAY
92 ;;284;GEC NURSING HOME FUNDING-VA
93 ;;388;GEC STATE VETERANS NURSING HOME
94 ;;419;GEC VA NHCU (LONG-TERM CARE)
95 ;;420;GEC VA NHCU (REHAB)
96 ;;422;GEC VA NHCU (RESPITE)
97 ;;423;GEC VA NHCU (SUBACUTE CARE)
98 ;;353;GEC REFERRAL OTHER REFERRAL PROGRAM
99 ;;293;GEC OTHER REF PROGRAM FUNDING-MEDICAID
100 ;;294;GEC OTHER REF PROGRAM FUNDING-MEDICARE
101 ;;295;GEC OTHER REF PROGRAM FUNDING-OTHER
102 ;;296;GEC OTHER REF PROGRAM FUNDING-OTHER INS.
103 ;;297;GEC OTHER REF PROGRAM FUNDING-PRIV PAY
104 ;;298;GEC OTHER REF PROGRAM FUNDING-VA
105 ;;299;GEC OTHER REFERRAL PROGRAM (REFERRED TO)
106 ;;363;GEC REFERRAL STRUCTURED LIVING SITUATION
107 ;;116;GEC ASSISTED LIVING (REFERRED TO)
108 ;;152;GEC COMMUNITY RESIDENTIAL CARE PROGRAM
109 ;;320;GEC PERSONAL CARE HOME
110 ;;391;GEC STRUCTURED LIVING FUNDING-MEDICAID
111 ;;392;GEC STRUCTURED LIVING FUNDING-MEDICARE
112 ;;393;GEC STRUCTURED LIVING FUNDING-OTHER
113 ;;394;GEC STRUCTURED LIVING FUNDING-OTHER INS.
114 ;;395;GEC STRUCTURED LIVING FUNDING-PRIV PAY
115 ;;396;GEC STRUCTURED LIVING FUNDING-VA
116 ;;134;GEC CARE COORDINATION COMMENTS
117 ;;135;GEC CARE RECOMMENDATIONS COMMENTS
118 ;;277;GEC NURSING ASSESSMENT COMMENTS
119 ;;379;GEC SOCIAL SERVICES COMMENTS
120 ;;337;GEC REFERRAL COMMENTS
121 ;;660149;GEC OUTPATIENT PALLIATIVE/HOSPICE (HOME)
122 ;;660148;GEC VA NHCU (HOSPICE)
123 ;;660158;GEC HOME TELEHEALTH (REFERRING TO)
124 ;;660157;GEC HOME TELEHEALTH (REFERRED TO)
125 ;;660151;GEC TELEHEALTH FUNDING-VA
126 ;
127COM ;FORMAT COMMENT
128 Q:'$D(COMMENT)
129 N WORD,SENT,I
130 S SENT=""
131 I $L(COMMENT)<52 W !,?6,"Comment: ",COMMENT D PB^PXRMGECR Q:Y=0 Q
132 I $L(COMMENT)>51 D
133 .W !,?6,"Comment:"
134 .S WORD="" F I=1:1:$L(COMMENT," ") S WORD=$P(COMMENT," ",I) D
135 ..S SENT=SENT_" "_WORD
136 ..I $L(SENT)>51 W !,?6,SENT D PB^PXRMGECR Q:Y=0 S SENT=""
137 I SENT'="" W !,?6,SENT D PB^PXRMGECR Q:Y=0
138 Q
139 ;
140COMQ ;FORMAT PRINTED COMMENT
141 Q:'$D(COMMENT)
142 N WORD,SENT,I
143 S SENT=""
144 I $L(COMMENT)<52 W !,?6,"Comment: ",COMMENT Q
145 I $L(COMMENT)>51 D
146 .W !,?6,"Comment:"
147 .S WORD="" F I=1:1:$L(COMMENT," ") S WORD=$P(COMMENT," ",I) D
148 ..S SENT=SENT_" "_WORD
149 ..I $L(SENT)>51 W !,?6,SENT S SENT="" D PAGE
150 I SENT'="" W !,?6,SENT D PAGE
151 Q
152 ;
153OBJECT(DFN) ;
154 N CNT,CNT1,RESULT,STR,STR1,X
155 S CNT=0
156 K ^TMP("PXRMGECZ",$J,"REFERRAL")
157 S STR=$NA(^TMP("PXRMGECZ",$J,"REFERRAL"))
158 S RESULT=$P($$STATUS^PXRMGECU(DFN),U)
159 I $G(RESULT)["No GEC Referral on record." D NONE Q "~@"_$NA(@STR)
160 F X=1:1:$L(RESULT) I $E(RESULT,X,X+2)="~ ~" S CNT=CNT+1
161 S STR1=$P(RESULT,"~ ~",CNT+1),CNT1=0
162 S @STR@(CNT1+1,0)="=================================================="
163 S @STR@(CNT1+1,0)="REFERRAL STATUS:"
164 F X=1:1:CNT D
165 .S CNT1=CNT1+1
166 .I $L($P(RESULT,"~ ~",X))'>0 Q
167 .S @STR@(CNT1,0)=$P(RESULT,"~ ~",X)
168 .S:@STR@(CNT1,0)["~" @STR@(CNT1,0)=$TR(@STR@(CNT1,0),"~","")
169 S CNT=0 F X=1:1:$L(STR1) I $E(STR1,X,X+1)="~ "!($E(STR1,X,X+1)="~~") S CNT=CNT+1
170 F X=1:1:CNT D
171 .S CNT1=CNT1+1
172 .I $L($P(STR1,"~",X))'>0 Q
173 .I $P(STR1,"~",X)["Care Coo" Q
174 .S @STR@(CNT1,0)=$P(STR1,"~",X)
175 .S:@STR@(CNT1,0)["~" @STR@(CNT1,0)=$TR(@STR@(CNT1,0),"~","")
176 G EXIT
177NONE ;If no activity happening
178 S @STR@(1,0)="=================================================="
179 S @STR@(2,0)="REFERRAL STATUS:"
180 S @STR@(3,0)="This is the first dialog activity on this Referral."
181 S @STR@(4,0)="=================================================="
182 Q
183EXIT ;Exit
184 S @STR@(CNT1+1,0)="=================================================="
185 Q "~@"_$NA(@STR)
Note: See TracBrowser for help on using the repository browser.