source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLG1.m@ 724

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1PXRMDLG1 ; SLC/PJH - Reminder Dialog Edit/Inquiry (overflow) ;07/29/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Get selectable codes for a taxonomy
5 ;-----------------------------------
6CODES(FILE,TIEN,NLINE,HIST) ;
7 N BDATE,CODES,CODE,DATES,DESC,DTEXT,EDATE,STR,SUB,TAB,TEXT
8 ;Display text
9 D CODES^PXRMDLLB(FILE,TIEN,.CODES)
10 I '$D(CODES) Q
11 S TEXT=$J("",15)_"Selectable codes:",TAB=18
12 S STR=$$LJ^XLFSTR($G(TEXT),60)
13 S STR=STR_"Activation Periods"
14 S NLINE=NLINE+1
15 S ^TMP(NODE,$J,NLINE,0)=STR
16 S SUB=""
17 F S SUB=$O(CODES(SUB)) Q:SUB="" D
18 .S CODE=$P(CODES(SUB),U,2),DESC=$P(CODES(SUB),U,3)
19 .S BDATE=$$FMTE^XLFDT($P($G(CODE),":",2))
20 .I $P($G(CODE),":",3)'="" S EDATE=$$FMTE^XLFDT($P($G(CODE),":",3))
21 .S DATE=BDATE I $G(EDATE)'="" S DATE=DATE_"-"_EDATE
22 .S STR=$$LJ^XLFSTR($P($G(CODE),":"),8)
23 .S STR=STR_$$LJ^XLFSTR(DESC,31)
24 .S DTEXT=STR_DATE
25 .S NLINE=NLINE+1
26 .S ^TMP(NODE,$J,NLINE,0)=$J("",15)_DTEXT
27 Q
28 ;Either dialog text or P/N text
29 ;------------------------------
30TSUB(IEN,VIEW) ;
31 ;Dialog View uses Dialog text
32 I VIEW=1 Q 25
33 I VIEW=2,$D(^PXRMD(801.41,IEN,25)) Q 25
34 ;P/N View uses P/N TEXT if defined
35 I $D(^PXRMD(801.41,IEN,35)) Q 35
36 ;Otherwise Dialog Text
37 Q 25
38 ;
39 ;additional prompts in the dialog file
40 ;-------------------------------------
41PROMPT(IEN,TAB,TEXT,DGRP) ;
42 N DATA,DDIS,DGSEQ,DSUB,DTITLE,DTXT,DTYP,SEQ,SUB
43 S SEQ=0
44 F S SEQ=$O(^PXRMD(801.41,IEN,10,"B",SEQ)) Q:'SEQ D
45 .S SUB=$O(^PXRMD(801.41,IEN,10,"B",SEQ,"")) Q:'SUB
46 .S DSUB=$P($G(^PXRMD(801.41,IEN,10,SUB,0)),U,2) Q:'DSUB
47 .S DATA=$G(^PXRMD(801.41,DSUB,0)) Q:DATA=""
48 .S DNAME=$P(DATA,U),DDIS=$P(DATA,U,3),DTYP=$P(DATA,U,4)
49 .I VIEW,('DGRP),(DTYP'="P") Q
50 .I ('VIEW),('DGRP),("FP"'[DTYP) Q
51 .S:VIEW DDIS=""
52 .I DTYP="F" S DNAME=DNAME_" (forced value)"
53 .I DGRP D
54 ..S DGSEQ=$P($G(^PXRMD(801.41,IEN,10,SUB,0)),U)
55 ..S DNAME=DGSEQ_$J("",3-$L(DGSEQ))_DNAME
56 .I TAB=0,DTYP="P" D
57 ..;Override prompt caption
58 ..S DTITLE=$P($G(^PXRMD(801.41,IEN,10,SUB,0)),U,6)
59 ..I DTITLE="" S DTITLE=$P($G(^PXRMD(801.41,DSUB,2)),U,4)
60 ..S DNAME=$J("",3)_DTITLE
61 .I TAB=0,DTYP="F" S DNAME=$J("",3)_DNAME
62 .S DNAME=$J("",15)_$G(TEXT)_DNAME
63 .S:DDIS]"" DNAME=DNAME_$J("",72-$L(DNAME))_DDIS
64 .S VALMCNT=VALMCNT+1
65 .S ^TMP("PXRMDLG",$J,VALMCNT,0)=DNAME
66 .S TEXT=$J("",TAB)
67 Q
68 ;
69FIND(FIEN,SEQ,DIEN,NLINE,NODE) ;
70 N FNUM,TIEN,HIST,SUB,CODE,CODES,BDATE,EDATE,DATE,DESC,DTEXT
71 S HIST=0
72 S TIEN=$P(FIEN,";")
73 I FIEN["ICPT" S FNUM=81
74 I FIEN["ICD9" S FNUM=80
75 I FNUM=80 S CODE=$P($G(^ICD9(TIEN,0)),U) D PERIOD^ICDAPIU(CODE,.CODES)
76 I FNUM=81 S CODE=$P($$CPT^ICPTCOD(TIEN),U,2) D PERIOD^ICPTAPIU(CODE,.CODES)
77 S TEXT=$J("",15)_"Selectable codes:",TAB=18
78 S STR=$$LJ^XLFSTR($G(TEXT),60)
79 S STR=STR_"Activation Periods"
80 S NLINE=NLINE+1
81 S ^TMP(NODE,$J,NLINE,0)=STR
82 S BDATE=""
83 F S BDATE=$O(CODES(BDATE)) Q:BDATE="" D
84 .I $G(BDATE)=0 Q
85 .S EDATE=$P(CODES(BDATE),U),DESC=$P(CODES(BDATE),U,2)
86 .S BDATE=$$FMTE^XLFDT(BDATE)
87 .I $G(EDATE)'="" S EDATE=$$FMTE^XLFDT(EDATE)
88 .S DATE=BDATE I $G(EDATE)'="" S DATE=DATE_"-"_EDATE
89 .S STR=$$LJ^XLFSTR($G(CODE),8)
90 .S STR=STR_$$LJ^XLFSTR(DESC,31)
91 .S DTEXT=STR_DATE
92 .S NLINE=NLINE+1
93 .S ^TMP(NODE,$J,NLINE,0)=$J("",15)_DTEXT
94 S NLINE=NLINE+1
95 S ^TMP(NODE,$J,NLINE,0)=$J("",79)
96 Q
97 ;
98TAX(FIEN,SEQ,DIEN,NLINE,NODE) ;
99 N ARRAY,CNT,FILE,HIST,TIEN,TSEQ
100 N CNT,DTXT,FNODE,RSUB,TDX,TNAME,TPAR,TPR,TYP
101 N TCUR,TDTXT,TDHTXT,THIS,TPTXT,TPHTXT
102 S TIEN=$P(FIEN,";") Q:TIEN=""
103 S HIST=0,FILE=""
104 ;Get associated codes
105 ;
106 ;Get taxonomy name
107 S TNAME=$P($G(^PXD(811.2,TIEN,0)),U,1)
108 ;
109 ;Check what type of taxonomy codes exist
110 S TDX=$$TOK^PXRMDLLA(TIEN,"SDX")
111 S TPR=$$TOK^PXRMDLLA(TIEN,"SPR")
112 ;
113 ;Diagnoses
114 I TDX D
115 .;Diagnosis texts
116 .S TPAR=$G(^PXD(811.2,TIEN,"SDZ"))
117 .;Get parameter file node for this finding type
118 .S FNODE=$O(^PXRMD(801.45,"B","POV","")) Q:FNODE=""
119 .;check if finding parameters are disabled
120 .S TCUR=$P($G(^PXRMD(801.45,FNODE,1,1,0)),U,2)
121 .S THIS=$P($G(^PXRMD(801.45,FNODE,1,2,0)),U,2)
122 .;get category text (diagnoses)
123 .S FILE=80
124 ;Procedures
125 I TPR D
126 .;Procedure texts
127 .S TPAR=$G(^PXD(811.2,TIEN,"SPZ"))
128 .;Get parameter file node for this finding type
129 .S FNODE=$O(^PXRMD(801.45,"B","CPT","")) Q:FNODE=""
130 .;check if finding parameters are disabled
131 .S TCUR=$P($G(^PXRMD(801.45,FNODE,1,1,0)),U,2)
132 .S THIS=$P($G(^PXRMD(801.45,FNODE,1,2,0)),U,2)
133 .;get category text (procedures)
134 .S FILE=81
135 I FILE]"" D CODES(FILE,TIEN,.NLINE,HIST)
136 S NLINE=NLINE+1
137 S ^TMP(NODE,$J,NLINE,0)=$J("",79)
138 Q
139 ;
Note: See TracBrowser for help on using the repository browser.