source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMSEL1.m@ 940

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

initial load of FOIAVistA 6/30/08 version

File size: 6.7 KB
Line 
1PXRMSEL1 ; SLC/PJH - PXRM Selection ;04/04/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ; Called by PXRMSEL
5 ;
6BUILD ;Build selection list
7 ;
8 D CHGCAP^VALM("HEADER1"," Item")
9 ;Reminder Dialog
10 I PXRMGTYP="DLG" D Q
11 .N CODE,DATA,DDIS,PXRMDIEN,PXRMDNAM,PXRMITEM,PXRMRNAM,TXT,TYP
12 .S CODE="",VALMCNT=0
13 .F S CODE=$O(^PXRMD(801.41,"B",CODE)) Q:CODE="" D
14 ..;Get Dialog detail
15 ..S PXRMDIEN=$O(^PXRMD(801.41,"B",CODE,"")) Q:'PXRMDIEN
16 ..S DATA=$G(^PXRMD(801.41,PXRMDIEN,0)) Q:$P(DATA,U,4)'="R"
17 ..S PXRMDNAM=$P(DATA,U),PXRMRNAM="",DDIS=0
18 ..I $P(DATA,U,3)]"" S DDIS=1
19 ..I $O(^PXD(811.9,"AG",PXRMDIEN,"")),DDIS=0 S DDIS=2
20 ..S PXRMITEM=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U,2)
21 ..I PXRMITEM D
22 ...I $E(PXRMVIEW,2)="N" S PXRMRNAM=$P($G(^PXD(811.9,PXRMITEM,0)),U)
23 ...I $E(PXRMVIEW,2)="P" S PXRMRNAM=$P($G(^PXD(811.9,PXRMITEM,0)),U,3)
24 ..S PXRMDNAM=$E(PXRMDNAM,1,39),PXRMRNAM=$E(PXRMRNAM,1,39)
25 ..S:PXRMRNAM="" PXRMRNAM="*NONE*"
26 ..S TXT=PXRMDNAM_$J("",40-$L(PXRMDNAM))_PXRMRNAM
27 ..S VALMCNT=VALMCNT+1,TXT=$J(VALMCNT,4)_" "_TXT
28 ..S TXT=$E(TXT,1,71)_$J("",71-$L(TXT))
29 ..S TXT=TXT_" "_$S(DDIS=1:"Disabled",DDIS=2:"Linked",1:"")
30 ..D SET^VALM10(VALMCNT,TXT,PXRMDIEN)
31 .D CHGCAP^VALM("HEADER2","Reminder Dialog Name"_$J("",20)_"Source Reminder")
32 .D CHGCAP^VALM("HEADER3"," Status")
33 ;
34 ;All dialogs types
35 I PXRMGTYP="DLGE" D Q
36 .N CODE,DATA,DDIS,DTYP,PXRMDIEN,PXRMDNAM,PXRMITEM,TXT
37 .S CODE="",VALMCNT=0,VALMBG=1
38 .F S CODE=$O(^PXRMD(801.41,"B",CODE)) Q:CODE="" D
39 ..;Get Dialog detail
40 ..S PXRMDIEN=$O(^PXRMD(801.41,"B",CODE,"")) Q:'PXRMDIEN
41 ..S DATA=$G(^PXRMD(801.41,PXRMDIEN,0)),DTYP=$P(DATA,U,4)
42 ..I PXRMDTYP'="A" Q:DTYP'=PXRMDTYP
43 ..Q:DTYP="R"
44 ..S PXRMDNAM=$P(DATA,U),DDIS=0 I $P(DATA,U,3)]"" S DDIS=1
45 ..S PXRMITEM=$O(^PXD(811.9,"AG",PXRMDIEN,""))
46 ..I PXRMITEM,DDIS=0 S DDIS=2
47 ..S PXRMDNAM=$E(PXRMDNAM,1,39)
48 ..S TXT=PXRMDNAM_$J("",40-$L(PXRMDNAM))_$$LIT(DTYP)
49 ..S VALMCNT=VALMCNT+1,TXT=$J(VALMCNT,4)_" "_TXT
50 ..S TXT=$E(TXT,1,71)_$J("",71-$L(TXT))
51 ..S TXT=TXT_$S(DDIS=1:"Disabled",1:"")
52 ..D SET^VALM10(VALMCNT,TXT,PXRMDIEN)
53 .D CHGCAP^VALM("HEADER2","Dialog Name"_$J("",29)_"Dialog type")
54 .D CHGCAP^VALM("HEADER3","Status")
55 ;
56 ;Link reminders to dialogs
57 I PXRMGTYP="DLGR" D Q
58 .N CODE,DATA,DDIS,DTYP,DIEN,DNAM,MODE,PNAM,RIEN,RNAM,SUB,TXT,TYPE
59 .S CODE="",VALMCNT=0,VALMBG=1,MODE=$E(PXRMVIEW,2),TYPE=$E(PXRMVIEW)
60 .S SUB=$S(MODE="P":"D",1:"B")
61 .F S CODE=$O(^PXD(811.9,SUB,CODE)) Q:CODE="" D
62 ..;Get Dialog detail
63 ..S RIEN=""
64 ..F S RIEN=$O(^PXD(811.9,SUB,CODE,RIEN)) Q:'RIEN D
65 ...S DATA=$G(^PXD(811.9,RIEN,0)) Q:DATA=""
66 ...S RNAM=$P(DATA,U),PNAM=$P(DATA,U,3)
67 ...S DIEN=$P($G(^PXD(811.9,RIEN,51)),U)
68 ...I TYPE="L" Q:'DIEN
69 ...I MODE="P" S:PNAM]"" RNAM=PNAM
70 ...S RNAM=$E(RNAM,1,34),DNAM="",DDIS=2
71 ...D:DIEN
72 ....S DATA=$G(^PXRMD(801.41,DIEN,0)),DDIS=0
73 ....S DNAM=$P(DATA,U) I $P(DATA,U,3)]"" S DDIS=1
74 ....S DNAM=$E(DNAM,1,27) I DNAM="" S DNAM="??"
75 ...S TXT=RNAM_$J("",35-$L(RNAM))
76 ...S TXT=TXT_DNAM_$J("",28-$L(DNAM))
77 ...S VALMCNT=VALMCNT+1,TXT=$J(VALMCNT,4)_" "_TXT
78 ...S TXT=$E(TXT,1,71)_$J("",71-$L(TXT))
79 ...S TXT=TXT_$S(DDIS=1:"Disabled",1:"")
80 ...D SET^VALM10(VALMCNT,TXT,RIEN)
81 .I MODE="N" S TXT="Reminder Name"_$J("",22)
82 .I MODE="P" S TXT="Reminder Print Name"_$J("",16)
83 .S TXT=TXT_"Linked Dialog Name & Dialog St"
84 .D CHGCAP^VALM("HEADER2",TXT)
85 .D CHGCAP^VALM("HEADER3","atus")
86 ;
87 ;Finding item parameters
88 I PXRMGTYP="FIP" D Q
89 .N CODE,DATA,DNAM,DSUB,IEN,FDIS,FSUB,FITEM,FLIT,FTYP,TXT
90 .S CODE="",VALMCNT=0
91 .F S CODE=$O(^PXRMD(801.43,"B",CODE)) Q:CODE="" D
92 ..S IEN=$O(^PXRMD(801.43,"B",CODE,""))
93 ..S DATA=$G(^PXRMD(801.43,IEN,0)),TXT=$E($P(DATA,U),1,39)
94 ..S FITEM=$P(DATA,U,2),FTYP=$P(FITEM,";",2),FSUB=$P(FITEM,";")
95 ..I FTYP]"" S FTYP=$G(DEF1(FTYP)) S:FTYP="" FTYP="??"
96 ..S FLIT="??" I FSUB S FLIT=FTYP_"("_FSUB_")"
97 ..S VALMCNT=VALMCNT+1,TXT=$J(VALMCNT,4)_" "_FTYP_"-"_TXT
98 ..S DSUB=$P(DATA,U,4),DNAM="",FDIS=$P(DATA,U,3)
99 ..I DSUB S DNAM=$P($G(^PXRMD(801.41,DSUB,0)),U)
100 ..S TXT=TXT_$J("",40-$L(TXT))_DNAM
101 ..S TXT=$E(TXT,1,71)_$J("",71-$L(TXT))_$S(FDIS=1:"Disabled",1:"Enabled")
102 ..D SET^VALM10(VALMCNT,TXT,IEN)
103 .D CHGCAP^VALM("HEADER2","Finding Item Type & Name"_$J("",10)_"Dialog Group/Element")
104 .D CHGCAP^VALM("HEADER3","Status")
105 ;
106 ;Finding Type Parameters
107 I PXRMGTYP="FPAR" D
108 .N CODE,FDES,TXT,IEN
109 .S CODE="",VALMCNT=0
110 .F S CODE=$O(^PXRMD(801.45,"B",CODE)) Q:CODE="" D
111 ..I CODE="POV" S FDES="DIAGNOSIS (POV)"
112 ..I CODE="CPT" S FDES="PROCEDURE (CPT)"
113 ..I $D(DEF2(CODE)) S FDES=DEF2(CODE)
114 ..S VALMCNT=VALMCNT+1,TXT=$J(VALMCNT,4)_" "_FDES
115 ..S IEN=$O(^PXRMD(801.45,"B",CODE,""))
116 ..D SET^VALM10(VALMCNT,TXT,IEN)
117 .D CHGCAP^VALM("HEADER2","Finding Type Parameter")
118 ;
119 ;Reminder Categories
120 I PXRMGTYP="RCAT" D Q
121 .N CODE,DATA,TXT,IEN
122 .S CODE="",VALMCNT=0
123 .F S CODE=$O(^PXRMD(811.7,"B",CODE)) Q:CODE="" D
124 ..S IEN=$O(^PXRMD(811.7,"B",CODE,""))
125 ..S DATA=$G(^PXRMD(811.7,IEN,0)),TXT=$P(DATA,U)
126 ..S VALMCNT=VALMCNT+1,TXT=$J(VALMCNT,4)_" "_TXT
127 ..D SET^VALM10(VALMCNT,TXT,IEN)
128 .D CHGCAP^VALM("HEADER2","Reminder Category")
129 ;
130 ;Taxonomy
131 I PXRMGTYP="DTAX" D Q
132 .N CODE,DATA,TXT,IEN
133 .S CODE="",VALMCNT=0
134 .F S CODE=$O(^PXD(811.2,"B",CODE)) Q:CODE="" D
135 ..S IEN=$O(^PXD(811.2,"B",CODE,""))
136 ..S DATA=$G(^PXD(811.2,IEN,0)),TXT=$P(DATA,U)
137 ..S VALMCNT=VALMCNT+1,TXT=$J(VALMCNT,4)_" "_TXT
138 ..D SET^VALM10(VALMCNT,TXT,IEN)
139 .D CHGCAP^VALM("HEADER2","Reminder Taxonomy")
140 ;
141 ;Resolution Statuses
142 I PXRMGTYP="RESN" D Q
143 .N CODE,DATA,HED,IEN,TXT,TYP
144 .S CODE="",VALMCNT=0
145 .F S CODE=$O(^PXRMD(801.9,"B",CODE)) Q:CODE="" D
146 ..S IEN=$O(^PXRMD(801.9,"B",CODE,""))
147 ..S DATA=$G(^PXRMD(801.9,IEN,0))
148 ..S TXT=$E($P(DATA,U),1,39),TYP=$P(DATA,U,6)
149 ..S VALMCNT=VALMCNT+1,TXT=$J(VALMCNT,4)_" "_TXT
150 ..S TXT=TXT_$J("",40-$L(TXT))_$S(TYP=1:"NATIONAL",1:"LOCAL")
151 ..D SET^VALM10(VALMCNT,TXT,IEN)
152 .S HED="Reminder Resolution Status National/Local"
153 .D CHGCAP^VALM("HEADER2",HED)
154 ;
155 ;Health Factor Resolutions
156 I PXRMGTYP="SHFR" D Q
157 .N CODE,DARRAY,DATA,HCNT,IEN,RNAM,SUB,TXT
158 .S IEN=0
159 .F S IEN=$O(^PXRMD(801.95,IEN)) Q:'IEN D
160 ..S DATA=$G(^AUTTHF(IEN,0)),TXT=$E($P(DATA,U),1,39) Q:TXT=""
161 ..S DARRAY(TXT)=IEN
162 .S CODE="",VALMCNT=0,HCNT=0
163 .F S CODE=$O(DARRAY(CODE)) Q:CODE="" D
164 ..S IEN=DARRAY(CODE)
165 ..S DATA=$G(^AUTTHF(IEN,0))
166 ..S VALMCNT=VALMCNT+1,HCNT=HCNT+1,TXT=$J(VALMCNT,4)_" "_CODE
167 ..S SUB=$O(^PXRMD(801.95,IEN,1,"B",0))
168 ..S RNAM="" I SUB S RNAM=$P($G(^PXRMD(801.9,SUB,0)),U)
169 ..S TXT=TXT_$J("",40-$L(TXT))_RNAM
170 ..F S SUB=$O(^PXRMD(801.95,IEN,1,"B",SUB)) Q:'SUB D
171 ...S RNAM=$P($G(^PXRMD(801.9,SUB,0)),U)
172 ...S TXT=TXT_"/"_RNAM
173 ..D SET^VALM10(VALMCNT,TXT,IEN)
174 .D CHGCAP^VALM("HEADER2","Health Factors"_$J("",20)_"Resolution Status")
175 ;
176 Q
177 ;
178LIT(INP) ;Dialog type description
179 Q:INP="E" "Dialog Element"
180 Q:INP="F" "Forced Value"
181 Q:INP="G" "Dialog Group"
182 Q:INP="P" "Additional Prompt"
183 Q:INP="R" "Reminder Dialog"
184 Q:INP="S" "Result Group"
185 Q:INP="T" "Result Element"
186 Q "???"
Note: See TracBrowser for help on using the repository browser.