[623] | 1 | PXRMDLR ;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 | ;
|
---|
| 74 | OUT(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 | ;
|
---|
| 86 | TRUE(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
|
---|