source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTDLG.m@ 789

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

initial load of WorldVistAEHR

File size: 4.2 KB
Line 
1PXRMTDLG ; SLC/PJH - Edit/Inquire Taxonomy Dialog ;9/9/2003
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Called by option PXRM TAXONOMY DIALOG
5 ;
6START N DIC,PXRMGTYP,PXRMHD,PXRMTIEN,Y
7SELECT ;General selection
8 S PXRMHD="Taxonomy Dialog",PXRMGTYP="DTAX",PXRMTIEN=""
9 D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMTIEN")
10 ;Should return a value
11 I PXRMTIEN D G SELECT
12 .S PXRMHD="TAXONOMY NAME:"
13 .;Listman option
14 .D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMTIEN)
15 ;
16END Q
17 ;
18 ;List all Taxonomy Dialogs (for protocol PXRM SELECTION LIST)
19 ;-------------------------
20ALL N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO,Y
21 S Y=1
22 D SET
23 S DIC="^PXD(811.2,"
24 S BY=".01"
25 S FR=""
26 S TO=""
27 S DHD="W ?0 D HED^PXRMTDLG"
28 D DISP
29 Q
30 ;
31 ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
32 ;--------------------
33INQ(Y) N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO
34 S DIC="^PXD(811.2,"
35 S DIC(0)="AEMQ"
36 D SET
37 D DISP
38 Q
39 ;
40 ;Display Header (see DHD variable)
41 ;--------------
42HED N TEMP,TEXTLEN,TEXTHED,TEXTUND
43 S TEXTHED="TAXONOMY DIALOG LIST"
44 S TEXTUND=$TR($J("",IOM)," ","-")
45 S TEMP=NOW_" Page "_DC
46 S TEXTLEN=$L(TEMP)
47 W TEXTHED
48 W ?(IOM-TEXTLEN),TEMP
49 W !,TEXTUND,!!
50 Q
51 ;
52 ;DISPLAY (Display from FLDS array)
53 ;-------
54DISP S L=0,FLDS="[PXRM TAXONOMY DIALOG]"
55 D EN1^DIP
56 Q
57 ;
58SET ;Setup all the variables
59 ; Set Date for Header
60 S NOW=$$NOW^XLFDT
61 S NOW=$$FMTE^XLFDT(NOW,"1P")
62 ;
63 ;These variables need to be setup every time because DIP kills them.
64 S BY="NUMBER"
65 S (FR,TO)=+$P(Y,U,1)
66 S DHD="W ?0 D HED^PXRMTDLG"
67 ;
68 Q
69 ;
70 ;Build display for selected taxonomy - Called from PXRMGEN
71 ;---------------------------------------------------------
72DTAX(TIEN) ;
73 ;If dialog selectable codes don't exist build them
74 I ('$D(^PXD(811.2,TIEN,"SDX")))&('$D(^PXD(811.2,TIEN,"SPR"))) D
75 .D BUILD^PXRMTDUP(TIEN)
76 ;
77 N ARRAY,CNT,SEQ,TSEQ
78 S VALMCNT=0 K ^TMP("PXRMGEN",$J)
79 ;Format headings to include taxonomy name
80 S HEADER=PXRMHD_" "_$P(^PXD(811.2,TIEN,0),U)
81 ;Get associated codes
82 D TAX^PXRMDLL(TIEN,.ARRAY)
83 ;Taxonomy header
84 S SEQ=1,TSEQ=$J(SEQ,3)_" "
85 S CNT=0,VALMCNT=VALMCNT+1
86 S ^TMP("PXRMGEN",$J,VALMCNT,0)=TSEQ_$J("",15-$L(TSEQ))_ARRAY
87 ;Dialog and Procedure entries
88 F S CNT=$O(ARRAY(CNT)) Q:CNT="" D
89 .S TSEQ=$J(SEQ,3)_"."_CNT
90 .S VALMCNT=VALMCNT+1
91 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=TSEQ_$J("",15-$L(TSEQ))_$P(ARRAY(CNT),U)
92 .D CODES($P(ARRAY(CNT),U,2),TIEN)
93 .S VALMCNT=VALMCNT+1
94 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",79)
95 ;Create headings
96 D CHGCAP^VALM("HEADER1","Taxonomy Dialog")
97 D CHGCAP^VALM("HEADER2","")
98 D CHGCAP^VALM("HEADER3","")
99 Q
100 ;
101 ;Selectable codes
102 ;----------------
103CODES(FILE,TIEN) ;
104 N BDATE,CODES,CODE,DATES,DESC,DTEXT,EDATE,STR,SUB,TAB,TEXT
105 ;Display text
106 S TEXT=$J("",15)_"Selectable codes:",TAB=18
107 S STR=$$LJ^XLFSTR($G(TEXT),60)
108 S STR=STR_"Activation Periods"
109 S VALMCNT=VALMCNT+1
110 ;S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_$G(TEXT)
111 S ^TMP("PXRMGEN",$J,VALMCNT,0)=STR
112 ;Get array
113 D CODES^PXRMDLLB(FILE,TIEN,.CODES)
114 ;Move results into workfile
115 S SUB=""
116 F S SUB=$O(CODES(SUB)) Q:SUB="" D
117 .S CODE=$P(CODES(SUB),U,2),DESC=$P(CODES(SUB),U,3)
118 .S BDATE=$$FMTE^XLFDT($P($G(CODE),":",2))
119 .I $P($G(CODE),":",3)'="" S EDATE=$$FMTE^XLFDT($P($G(CODE),":",3))
120 .S DATE=BDATE I $G(EDATE)'="" S DATE=DATE_"-"_EDATE
121 .S STR=$$LJ^XLFSTR($P($G(CODE),":"),8)
122 .S STR=STR_$$LJ^XLFSTR(DESC,37)
123 .S DTEXT=STR_DATE
124 .S VALMCNT=VALMCNT+1
125 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",15)_DTEXT
126 .;S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_$G(TEXT)_DTEXT
127 .;S TEXT=$J("",TAB)
128 Q
129 ;
130 ;Display selectable codes - called from print template
131 ;-----------------------------------------------------
132TDES(FILE,D0,D1) ;
133 N CNT,CODE,DATA,IEN,TEMP,TEXT,NODE
134 S NODE=$S(FILE=80:"SDX",FILE=81:"SPR")
135 S DATA=$G(^PXD(811.2,D0,NODE,D1,0)) Q:DATA=""
136 ;Get ien of code
137 S IEN=$P(DATA,U) Q:IEN=""
138 S TEMP=$S(FILE=80:$$ICDDX^ICDCODE(IEN,DT),FILE=81:$$CPT^ICPTCOD(IEN,DT))
139 S CODE=$P(TEMP,U,2)
140 ;Set display text from taxonomy selectable code text
141 ;otherwise use icd9/cpt diagnosis or short name.
142 S TEXT=$P(DATA,U,2)
143 ;Check for an invalid code.
144 I $P(TEMP,U,1)=-1 S CODE=$$CODEC^ICDCODE(IEN),TEXT=$P(TEMP,U,2)_" (invalid code)"
145 I TEXT="" S TEXT=$S(FILE=80:$P(TEMP,U,4),FILE=81:$P(TEMP,U,3))
146 S TEXT=" "_$E(TEXT,1,40)_$J("",40-$L(TEXT))
147 ;Lineup file 80 codes on the ".".
148 I FILE=80,$L(CODE)=5 S CODE=CODE_" "
149 W $J(CODE,10)_TEXT
150 Q
Note: See TracBrowser for help on using the repository browser.