source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLG3.m@ 701

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1PXRMDLG3 ; SLC/PJH - Reminder Dialog Edit/Inquiry ;07/29/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;
5 ;Display national dialog
6START N NLINE,NSEL
7 S NLINE=0,NSEL=0
8 ;
9 ;Group header
10 I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,4)="G" D
11 .D DLINE(PXRMDIEN,"","")
12 ;Other components
13 D DETAIL(PXRMDIEN,"")
14 ;Create headings
15 D CHGCAP^VALM("HEADER1","Item Seq.")
16 D CHGCAP^VALM("HEADER2","Dialog Details/Findings")
17 D CHGCAP^VALM("HEADER3","Type")
18 S VALMCNT=NLINE
19 S ^TMP("PXRMDLG",$J,"VALMCNT")=VALMCNT
20EXIT Q
21 ;
22 ;Additional Findings
23 ;-------------------
24ADD(DIEN) ;
25 N FIND,FSUB,FTYP,FNAME,FNUM
26 S FSUB=0
27 F S FSUB=$O(^PXRMD(801.41,DIEN,3,FSUB)) Q:'FSUB D
28 .S FIND=$P($G(^PXRMD(801.41,DIEN,3,FSUB,0)),U) Q:FIND=""
29 .S FNAME="" D FDESC(FIND) Q:FNAME=""
30 .;Save additional finding name
31 .S FOUND=1 D SAVE(2,FNAME,FTYP)
32 Q
33 ;
34 ;Build listman global for all components
35 ;---------------------------------------
36DETAIL(PXRMDIEN,LEV) ;
37 N DDATA,DDLG,DEND,DIEN,DNAM,DSEQ,DSTRT,IND,JND,DSUB
38 S DSEQ=0
39 ;
40 ;Get each sequence number
41 F S DSEQ=$O(^PXRMD(801.41,PXRMDIEN,10,"B",DSEQ)) Q:'DSEQ D
42 .;Determine subscript
43 .S DSUB=$O(^PXRMD(801.41,PXRMDIEN,10,"B",DSEQ,"")) Q:'DSUB
44 .;Get ien of prompt/component
45 .S DIEN=$P($G(^PXRMD(801.41,PXRMDIEN,10,DSUB,0)),U,2) Q:'DIEN
46 .;Ignore prompts and forced values
47 .I "PF"[$P($G(^PXRMD(801.41,DIEN,0)),U,4) Q
48 .;Save line in workfile
49 .D DLINE(DIEN,LEV,DSEQ)
50 .;
51 .;Process any sub-components
52 .D DETAIL(DIEN,LEV_DSEQ_".")
53 .;Extra line feed
54 .I LEV="" D
55 ..S NLINE=NLINE+1
56 ..S ^TMP("PXRMDLG",$J,NLINE,0)=$J("",79)
57 Q
58 ;
59 ;Save individual component details
60 ;---------------------------------
61DLINE(DIEN,LEV,DSEQ) ;
62 ;Dialog name
63 S DNAM=$P($G(^PXRMD(801.41,DIEN,0)),U) Q:DNAM=""
64 ;Check if standard PXRM prompt
65 I $$PXRM^PXRMEXID(DNAM) Q
66 ;
67 N DPTX,DTXT,DTYP,EXIST,ITEM,TEMP,SEP
68 S ITEM=""
69 S NSEL=NSEL+1,ITEM=NSEL
70 S NLINE=NLINE+1,SEP=$E(LEV,$L(LEV))
71 S TEMP=$J(ITEM,3)_$J("",4)_LEV_DSEQ
72 ;Determine type
73 S DTYP=$S($P($G(^PXRMD(801.41,DIEN,0)),U,4)="G":"group",1:"element")
74 ;Dialog component display
75 I $L(TEMP)<13 S TEMP=TEMP_$J("",12+$L(SEP)-$L(TEMP))_$E(DNAM,1,50)
76 E S TEMP=TEMP_" "_$E(DNAM,1,50)
77 ;Add Type
78 S ^TMP("PXRMDLG",$J,NLINE,0)=TEMP_$J("",70-$L(TEMP))_DTYP
79 ;
80 ;Set up selection index
81 S ^TMP("PXRMDLG",$J,"IDX",NSEL,DIEN)=""
82 ;
83 ;Insert finding items
84 I ("element;group"[DTYP) D
85 .N DSUB,FDATA,FILENUM,FLIT,FLONG,FNAME,FOUND,FREP,FTAB,FTYP,TEMP
86 .;Findings
87 .S FNAME="",FOUND=0
88 .D FDESC($P($G(^PXRMD(801.41,DIEN,1)),U,5))
89 .I FNAME'="" S FOUND=1 D SAVE(1,FNAME,FTYP)
90 .;Additional findings (see ADD^PXRMDLG2)
91 .D ADD(DIEN)
92 .;If no findings
93 .I 'FOUND D
94 ..S NLINE=NLINE+1
95 ..S ^TMP("PXRMDLG",$J,NLINE,0)=$J("",12+$L(SEP))_"Finding: *NONE*"
96 Q
97 ;
98 ;Finding description
99 ;-------------------
100FDESC(FIEN) ;
101 N FGLOB,FITEM
102 ;Determine finding type
103 S FGLOB=$P(FIEN,";",2) Q:FGLOB=""
104 S FITEM=$P(FIEN,";") Q:FITEM=""
105 ;Diagnosis POV
106 I FGLOB["ICD9" D Q
107 .S FTYP="DIAGNOSIS",FGLOB=U_FGLOB_FITEM_",0)"
108 .S FNAME=$P($G(@FGLOB),U,3)
109 I FGLOB["WV" D Q
110 .S FTYP="WH NOTIFICATION PURPOSE",FGLOB=U_FGLOB_FITEM_",0)"
111 .S FNAME=$P($G(@FGLOB),U)
112 ;Procedure CPT
113 I FGLOB["ICPT" D Q
114 .S FTYP="PROCEDURE",FGLOB=U_FGLOB_FITEM_",0)"
115 .S FNAME=$P($G(@FGLOB),U,2)
116 ;Quick order
117 I FGLOB["ORD(101.41" D Q
118 .S FTYP="QUICK ORDER",FGLOB=U_FGLOB_FITEM_",0)"
119 .S FNAME=$P($G(@FGLOB),U,2)
120 ;Short name for finding type
121 S FTYP=$G(DEF1(FGLOB)) Q:FTYP=""
122 ;Long name
123 S FTYP=$G(DEF2(FTYP))
124 S FGLOB=U_FGLOB_FITEM_",0)"
125 S FNAME=$P($G(@FGLOB),U,1)
126 I FNAME="" S FNAME=$P($G(@FGLOB),U)
127 I FNAME]"" S FNAME=FNAME Q
128 S FNAME=FITEM
129 Q
130 ;
131 ;Save finding details
132 ;--------------------
133SAVE(DSUB,FNAME,FTYP) ;
134 N TEMP
135 I DSUB=1 S FLIT="Finding: "
136 I DSUB>1 S FLIT="Add. Finding: "
137 S FLONG=0
138 I $L(FLIT_FNAME_" ("_FTYP_")")>60 S FLONG=1
139 I 'FLONG S FNAME=FLIT_FNAME_" ("_FTYP_")"
140 I FLONG S FNAME=FLIT_FNAME
141 S TEMP=$J("",12+$L(SEP))_$E(FNAME,1,60)_$J("",60-$L(FNAME))
142 S NLINE=NLINE+1
143 S ^TMP("PXRMDLG",$J,NLINE,0)=TEMP
144 I FLONG D
145 .S NLINE=NLINE+1
146 .S FTAB=$S(DSUB=1:21,1:26)
147 .S ^TMP("PXRMDLG",$J,NLINE,0)=$J("",FTAB)_"("_FTYP_")"
148 Q
Note: See TracBrowser for help on using the repository browser.