source: FOIAVistA/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLG2.m@ 1050

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1PXRMDLG2 ; SLC/PJH - Reminder Dialog Edit/Inquiry ;07/29/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Find description for dialog type
5LIT(INP) ;
6 Q:INP="G" "Dialog group: "
7 Q:INP="F" "Forced value: "
8 Q:INP="P" "Prompt: "
9 Q:INP="E" "Dialog element: "
10 Q "???"
11 ;
12 ;Additional Findings
13ADD(DIEN) ;
14 N FIND,FSUB,FTYP,FNAME,FNUM
15 S FSUB=0
16 F S FSUB=$O(^PXRMD(801.41,DIEN,3,FSUB)) Q:'FSUB D
17 .S FIND=$P($G(^PXRMD(801.41,DIEN,3,FSUB,0)),U) Q:FIND=""
18 .S FNAME="" D DESC(FIND) Q:FNAME=""
19 .S FNAME="Additional Finding: "_FNAME
20 .;Save additional finding name
21 .S VALMCNT=VALMCNT+1
22 .S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_FNAME
23 Q
24 ;Finding description
25DESC(FIEN) ;
26 ;Determine finding type
27 S FGLOB=$P(FIEN,";",2) Q:FGLOB=""
28 S FITEM=$P(FIEN,";") Q:FITEM=""
29 ;Diagnosis POV
30 I FGLOB["ICD9" D Q
31 .S FTYP="DIAGNOSIS",FGLOB=U_FGLOB_FITEM_",0)"
32 .S FNAME=$P($G(@FGLOB),U,3)_" ["_FITEM_"]"
33 ;Procedure CPT
34 I FGLOB["ICPT" D Q
35 .S FTYP="PROCEDURE",FGLOB=U_FGLOB_FITEM_",0)"
36 .S FNAME=$P($G(@FGLOB),U,2)_" ["_FITEM_"]"
37 ;Quick order
38 I FGLOB["ORD(101.41" D Q
39 .S FTYP="QUICK ORDER",FGLOB=U_FGLOB_FITEM_",0)"
40 .S FNAME=$P($G(@FGLOB),U,2)_" ["_FITEM_"]"
41 ;Short name for finding type
42 S FTYP=$G(DEF1(FGLOB)) Q:FTYP=""
43 S FNUM=" ["_FTYP_"("_FITEM_")]"
44 ;Long name
45 S FTYP=$G(DEF2(FTYP))
46 S FGLOB=U_FGLOB_FITEM_",0)"
47 S FNAME=$P($G(@FGLOB),U,1)
48 I FNAME="" S FNAME=$P($G(@FGLOB),U)
49 I FNAME]"" S FNAME=FNAME_FNUM Q
50 S FNAME=FITEM
51 Q
52 ;
53 ;Dialog Details (DD)
54DETAIL(PIEN) ;
55 ;Get prompt data
56 S DATA=$G(^PXRMD(801.41,PIEN,0))
57 ;Extract name, type and disabled
58 S PNAME=$P(DATA,U),PDIS=$P(DATA,U,3),PTYP=$P(DATA,U,4),PTYP=$$LIT(PTYP)
59 ;Result (if any)
60 S RESULT=$P(DATA,U,15)
61 I RESULT S RESNM=$P($G(^PXRMD(801.41,RESULT,0)),U)
62 ;Get Resolution/Finding details
63 S DATA=$G(^PXRMD(801.41,PIEN,1)),RIEN=$P(DATA,U,3),FIEN=$P(DATA,U,5)
64 ;Resolution status name (assume this is a set)
65 S RNAME="???"
66 I RIEN S RNAME=$P($G(^PXRMD(801.9,RIEN,0)),U) S:RNAME="" RNAME="???"
67 ;Set Default display values
68 S FNAME="???",FTYP="???",ONAME="???"
69 ;For quick orders get the orderable item
70 I RNAME="ORDERED" D
71 .S FTYP="QUICK ORDER",FNAME="*QUICK ORDER MISSING*"
72 .S OIEN=$P($G(^PXRMD(801.41,PIEN,1)),U,7) Q:'OIEN
73 .S FGLOB="^ORD(101.43,"_OIEN_",0)"
74 .S ONAME=$P($G(@FGLOB),U)_" ["_OIEN_"]"
75 ;Description of finding
76 D DESC(FIEN)
77 ;
78 S RNAME="Resolution: "_RNAME
79 S FTYP="Finding type: "_FTYP
80 S FNAME="Finding item: "_FNAME
81 S VALMCNT=VALMCNT+1
82 S PTXT=$J(SEQ,3)_$J("",12)_PTYP_PNAME
83 S ^TMP("PXRMDLG",$J,VALMCNT,0)=PTXT_$J("",72-$L(PTXT))_PDIS
84 S ^TMP("PXRMDLG",$J,"IDX",SEQ,PIEN)=""
85 ;Save resolution
86 I ('DGRP),(FTYP'["TAXONOMY"),(FTYP'["MENTAL HEALTH") D
87 .I RNAME'["???" D
88 ..S VALMCNT=VALMCNT+1
89 ..S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_RNAME
90 .I FTYP["QUICK ORDER" D
91 ..S VALMCNT=VALMCNT+1
92 ..S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_"Orderable item: "_ONAME
93 I ('DGRP) D
94 .;Save finding type
95 .I FTYP'["???" D
96 ..S VALMCNT=VALMCNT+1
97 ..S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_FTYP
98 ;Save finding name
99 I ('DGRP),(FNAME'["???") D
100 .S VALMCNT=VALMCNT+1
101 .S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_FNAME
102 ;Additional Findings
103 I (FTYP'["TAXONOMY"),(FTYP'["MENTAL HEALTH") D ADD(PIEN)
104 ;Result group/element (mental health)
105 I RESULT D
106 .;Save result details
107 .S VALMCNT=VALMCNT+1
108 .S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_"Result name: "_RESNM
109 ;Get additional prompts/dialog group elements
110 D PROMPT^PXRMDLG1(PIEN,20,DHED,DGRP)
111 Q
112 ;
113 ;Group findings and prompts
114GROUP(PIEN) ;
115 ;Get prompt data
116 S DATA=$G(^PXRMD(801.41,PIEN,0))
117 ;Extract name, type and disabled
118 S PNAME=$P(DATA,U),PDIS=$P(DATA,U,3),PTYP=$P(DATA,U,4),PTYP=$$LIT(PTYP)
119 ;Result (if any)
120 S RESULT=$P(DATA,U,15)
121 I RESULT S RESNM=$P($G(^PXRMD(801.41,RESULT,0)),U)
122 ;Get Resolution/Finding details
123 S DATA=$G(^PXRMD(801.41,PIEN,1)),RIEN=$P(DATA,U,3),FIEN=$P(DATA,U,5)
124 ;Resolution status name (assume this is a set)
125 S RNAME="???"
126 I RIEN S RNAME=$P($G(^PXRMD(801.9,RIEN,0)),U) S:RNAME="" RNAME="???"
127 ;Set Default display values
128 S FNAME="???",FTYP="???",ONAME="???"
129 ;For quick orders get the orderable item
130 I RNAME="ORDERED" D
131 .S FTYP="QUICK ORDER",FNAME="*QUICK ORDER MISSING*"
132 .S OIEN=$P($G(^PXRMD(801.41,PIEN,1)),U,7) Q:'OIEN
133 .S FGLOB="^ORD(101.43,"_OIEN_",0)"
134 .S ONAME=$P($G(@FGLOB),U)_" ["_OIEN_"]"
135 ;Description of finding
136 D DESC(FIEN)
137 ;
138 S RNAME="Resolution: "_RNAME
139 S FTYP="Finding type: "_FTYP
140 S FNAME="Finding item: "_FNAME
141 ;Save resolution
142 I (FTYP'["TAXONOMY"),(FTYP'["MENTAL HEALTH") D
143 .I RNAME'["???" D
144 ..S VALMCNT=VALMCNT+1
145 ..S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_RNAME
146 .I FTYP["QUICK ORDER" D
147 ..S VALMCNT=VALMCNT+1
148 ..S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_"Orderable item: "_ONAME
149 ;Save finding type
150 I FTYP'["???" D
151 .S VALMCNT=VALMCNT+1
152 .S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_FTYP
153 ;Save finding name
154 I (FNAME'["???") D
155 .S VALMCNT=VALMCNT+1
156 .S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_FNAME
157 ;Additional Findings
158 I (FTYP'["TAXONOMY"),(FTYP'["MENTAL HEALTH") D ADD(PIEN)
159 ;Get additional prompts/dialog group elements
160 D PROMPT^PXRMDLG1(PIEN,20,"Additional prompts: ",0)
161 ;Final line feed
162 S VALMCNT=VALMCNT+1
163 S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",79)
164 Q
Note: See TracBrowser for help on using the repository browser.