source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDRSG.m@ 824

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

initial load of WorldVistAEHR
File size: 3.6 KB
RevLine 
[613]1PXRMDRSG ;SLC/AGP - DIALOG RESULTS LOADER ;05/14/2007
2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
3 ;
4 ;Build score related P/N text from score and result group
5 ;
6MHDLL(ORY,RESULTS,SCORES,DFN) ;
7 N ARY,CNT,NODE,RESULT,SCORE,SCALENUM
8 N OCNT,IMULT,MULT
9 S OCNT=0,IMULT=0,MULT=0
10 S CNT=0 F S CNT=$O(SCORES(CNT)) Q:CNT'>0 D
11 .S NODE=$G(SCORES(CNT)) Q:NODE=""
12 .S ARY($P(NODE,"~"))=$P(NODE,"~",2)
13 S CNT=0 F S CNT=$O(RESULTS(CNT)) Q:CNT'>0 D
14 .S RESULT=$G(RESULTS(CNT)) Q:RESULT=""
15 .I $P($G(^PXRMD(801.41,RESULT,50)),U,1)="" Q
16 .S SCALENUM=$P($G(^PXRMD(801.41,RESULT,50)),U,2) Q:SCALENUM=""
17 .S SCORE=$G(ARY(SCALENUM)) Q:SCORE=""
18 .S INSERT("SCORE")=SCORE
19 .D TEXT(.ORY,.OCNT,IMULT,.MULT,SCORE)
20 Q
21 ;
22OUT(DATA) ;Display element details
23 N DITEM S DITEM=$P(DATA,U,2) Q:'DITEM
24 W $P($G(^PXRMD(801.41,DITEM,0)),U)
25 W !,$J("Element Condition: ",19)
26 W $TR($P($G(^PXRMD(801.41,DITEM,0)),U,13),"~"," ")
27 W !,$J("Element text:",17)
28 ;Get progress note text if defined
29 N SUB,TEXT S SUB=0
30 F S SUB=$O(^PXRMD(801.41,DITEM,35,SUB)) Q:'SUB D
31 .S TEXT=$G(^PXRMD(801.41,DITEM,35,SUB,0)) W !,?5,TEXT
32 W !,$J("Informational text:",17)
33 N SUB,TEXT S SUB=0
34 F S SUB=$O(^PXRMD(801.41,DITEM,25,SUB)) Q:'SUB D
35 .S TEXT=$G(^PXRMD(801.41,DITEM,25,SUB,0)) W !,?5,TEXT
36 Q
37 ;
38TEXT(ORY,OCNT,IMULT,MULT,SCORE) ;
39 ;Load dialog results into ORY array
40 N DATA,DCON,DITEM,DSEQ,DSUB,DTYP,INS,SEP,TEXT
41 N INFOTEXT
42 ;S SCORE=$G(INSERT("SCORE")) Q:SCORE=""
43 ;Get the result elements
44 S DSEQ=0
45 F S DSEQ=$O(^PXRMD(801.41,RESULT,10,"B",DSEQ)) Q:'DSEQ D
46 .S DSUB=$O(^PXRMD(801.41,RESULT,10,"B",DSEQ,"")) Q:'DSUB
47 .S DITEM=$P($G(^PXRMD(801.41,RESULT,10,DSUB,0)),U,2) Q:'DITEM
48 .;Get the result element
49 .S DTYP=$P($G(^PXRMD(801.41,DITEM,0)),U,4) Q:DTYP'="T"
50 .;Get the result element condition
51 .S DCON=$P($G(^PXRMD(801.41,DITEM,0)),U,13)
52 .;Skip if condition not satisfied
53 .I DCON'="" S DCON=$TR(DCON,"~"," ") Q:'$$TRUE(SCORE,DCON,DFN)
54 .;Get progress note/Info text if defined
55 .N LAST,NULL,SUB,TEXT S SUB=0,LAST=0
56 .S INFOTEXT=""
57 .F S SUB=$O(^PXRMD(801.41,DITEM,25,SUB)) Q:'SUB D
58 ..S TEXT=$G(^PXRMD(801.41,DITEM,25,SUB,0))
59 ..I INFOTEXT="" S INFOTEXT="[INFOTEXT]"
60 ..S NULL=0 I ($E(TEXT)=" ")!(TEXT="") S NULL=1
61 ..;Add line breaks if is or preceded by blank line or starts with space
62 ..I ('NULL),LAST S TEXT="<br>"_TEXT
63 ..S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
64 ..S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
65 ..I MULT=1,SUB=1,$E(TEXT,1,4)'="<br>" S TEXT="<br>"_TEXT
66 ..S TEXT=$$STRREP^PXRMUTIL(TEXT,"<br>",U)
67 ..I SUB=1,IMULT=1 S TEXT=U_TEXT
68 ..S OCNT=OCNT+1,ORY(OCNT)=INFOTEXT_TEXT
69 ..I IMULT=0,OCNT>0 S IMULT=1
70 ..;S INFOTEXT=INFOTEXT_TEXT
71 .;
72 .S LAST=0,NULL=0,SUB=0
73 .F S SUB=$O(^PXRMD(801.41,DITEM,35,SUB)) Q:'SUB D
74 ..;Insert score into text (if neccessary)
75 ..S TEXT=$G(^PXRMD(801.41,DITEM,35,SUB,0))
76 ..S NULL=0 I ($E(TEXT)=" ")!(TEXT="") S NULL=1
77 ..;Add line breaks if is or preceded by blank line or starts with space
78 ..I ('NULL),LAST S TEXT="<br>"_TEXT
79 ..S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
80 ..S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
81 ..I MULT=1,SUB=1,$E(TEXT,1,4)'="<br>" S TEXT="<br>"_TEXT
82 ..;Check for inserts - note there may be embedded TIU markers too
83 ..N INS
84 ..S INS=""
85 ..F S INS=$O(INSERT(INS)) Q:INS="" D
86 ...S SEP="|"_INS_"|" I '$F(TEXT,SEP) Q
87 ...S TEXT=$P(TEXT,SEP)_$G(INSERT(INS))_$P(TEXT,SEP,2,99)
88 ..S OCNT=OCNT+1,ORY(OCNT)=TEXT
89 ..I MULT=0,OCNT>0 S MULT=1
90 .;I $G(INFOTEXT)'="" S OCNT=OCNT+1,ORY(OCNT)=INFOTEXT
91 Q
92 ;
93TRUE(V,COND,DFN) ; Check if value meets element condition
94 N RESULT,SEX
95 I COND["SEX" D Q RESULT
96 . S RESULT=0
97 . S SEX=$P($G(^DPT(DFN,0)),U,2)
98 . X COND I S RESULT=1
99 X COND I Q 1
100 Q 0
Note: See TracBrowser for help on using the repository browser.