source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLR.m@ 1177

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

revised back to 6/30/08 version
File size: 3.0 KB
RevLine 
[623]1PXRMDLR ;SLC/PJH - DIALOG RESULTS LOADER ;06/09/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Build score related P/N text from score and result group
5 ;
6 ;If not found
7 I '$G(RESULT) S ORY(1)="-1^no results for this test" Q
8 ;
9 N ARRAY,ERROR,INSERT,OK,SCORE,SUB,YT
10 ;
11 S ERROR=0
12 ;
13 ;Get score using API
14 S DFN=$G(ORES("DFN"))
15 I ORES("CODE")'="DOM80" D Q:ERROR
16 .M YT=ORES
17 .D PREVIEW^YTAPI4(.ARRAY,.YT)
18 .I ARRAY(1)'="[DATA]" S ORY(1)="-1^"_ARRAY(1)_ARRAY(2),ERROR=1 Q
19 .S SUB=0,OK=0
20 .F S SUB=$O(ARRAY(SUB)) Q:'SUB D Q:OK
21 ..I $P(ARRAY(SUB),U)="S1" S SCORE=$P(ARRAY(SUB),U,3),OK=1
22 .I 'OK S ORY(1)="-1^[ERROR] no score returned",ERROR=1 Q
23 ;
24 ;Except for DOM80
25 I ORES("CODE")="DOM80" D
26 .I $E(ORES("R1"))="Y" S SCORE=1 Q
27 .I $E(ORES("R1"),2,3)="YY",($E(ORES("R1"),4)>1) S SCORE=1 Q
28 .S SCORE=0
29 ;
30 S INSERT("SCORE")=SCORE
31 ;
32 ;For AIMS special formatting is required
33 I ORES("CODE")="AIMS" D
34 .N CNT,LITS,RESP,SUM
35 .S LITS(0)="none",LITS(1)="minimal",LITS(2)="mild",LITS(3)="moderate"
36 .S LITS(4)="severe",SUM(2)=0,SUM(3)=0,SUM(4)=0
37 .F CNT=1:1 S RESP=$E(ORES("R1"),CNT) Q:RESP="" D
38 ..S INSERT("R"_CNT)=$G(LITS(RESP))
39 ..I (CNT<8),(234[RESP) S SUM(RESP)=SUM(RESP)+1
40 .F CNT=2,3,4 S INSERT("SUM"_CNT)=SUM(CNT)
41 ;
42 ;Load dialog results into ORY array
43 N DATA,DCON,DITEM,DSEQ,DSUB,DTYP,INS,SEP,TEXT
44 ;Get the result elements
45 S DSEQ=0,OCNT=0
46 F S DSEQ=$O(^PXRMD(801.41,RESULT,10,"B",DSEQ)) Q:'DSEQ D
47 .S DSUB=$O(^PXRMD(801.41,RESULT,10,"B",DSEQ,"")) Q:'DSUB
48 .S DITEM=$P($G(^PXRMD(801.41,RESULT,10,DSUB,0)),U,2) Q:'DITEM
49 .;Get the result element
50 .S DTYP=$P($G(^PXRMD(801.41,DITEM,0)),U,4) Q:DTYP'="T"
51 .;Get the result element condition
52 .S DCON=$P($G(^PXRMD(801.41,DITEM,0)),U,13)
53 .;Skip if condition not satisfied
54 .I DCON'="" S DCON=$TR(DCON,"~"," ") Q:'$$TRUE(SCORE,DCON,DFN)
55 .;Get progress note text if defined
56 .N LAST,NULL,SUB,TEXT S SUB=0,LAST=0
57 .F S SUB=$O(^PXRMD(801.41,DITEM,35,SUB)) Q:'SUB D
58 ..;Insert score into text (if neccessary)
59 ..S TEXT=$G(^PXRMD(801.41,DITEM,35,SUB,0))
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 ..;Check for inserts - note there may be embedded TIU markers too
66 ..N INS
67 ..S INS=""
68 ..F S INS=$O(INSERT(INS)) Q:INS="" D
69 ...S SEP="|"_INS_"|" I '$F(TEXT,SEP) Q
70 ...S TEXT=$P(TEXT,SEP)_$G(INSERT(INS))_$P(TEXT,SEP,2,99)
71 ..S OCNT=OCNT+1,ORY(OCNT)=7_U_TEXT
72 Q
73 ;
74OUT(DATA) ;Display element details
75 N DITEM S DITEM=$P(DATA,U,2) Q:'DITEM
76 W $P($G(^PXRMD(801.41,DITEM,0)),U)
77 W !,$J("Element Condition: ",19)
78 W $TR($P($G(^PXRMD(801.41,DITEM,0)),U,13),"~"," ")
79 W !,$J("Element text:",17)
80 ;Get progress note text if defined
81 N SUB,TEXT S SUB=0
82 F S SUB=$O(^PXRMD(801.41,DITEM,35,SUB)) Q:'SUB D
83 .S TEXT=$G(^PXRMD(801.41,DITEM,35,SUB,0)) W !,?5,TEXT
84 Q
85 ;
86TRUE(V,COND,DFN) ; Check if value meets element condition
87 N RESULT,SEX
88 I COND["SEX" D Q RESULT
89 . S RESULT=0
90 . S SEX=$P($G(^DPT(DFN,0)),U,2)
91 . X COND I S RESULT=1
92 X COND I Q 1
93 Q 0
Note: See TracBrowser for help on using the repository browser.