PXRMDRSG ;SLC/AGP - DIALOG RESULTS LOADER ;05/14/2007
;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
;
;Build score related P/N text from score and result group
;
MHDLL(ORY,RESULTS,SCORES,DFN) ;
N ARY,CNT,NODE,RESULT,SCORE,SCALENUM
N OCNT,IMULT,MULT
S OCNT=0,IMULT=0,MULT=0
S CNT=0 F S CNT=$O(SCORES(CNT)) Q:CNT'>0 D
.S NODE=$G(SCORES(CNT)) Q:NODE=""
.S ARY($P(NODE,"~"))=$P(NODE,"~",2)
S CNT=0 F S CNT=$O(RESULTS(CNT)) Q:CNT'>0 D
.S RESULT=$G(RESULTS(CNT)) Q:RESULT=""
.I $P($G(^PXRMD(801.41,RESULT,50)),U,1)="" Q
.S SCALENUM=$P($G(^PXRMD(801.41,RESULT,50)),U,2) Q:SCALENUM=""
.S SCORE=$G(ARY(SCALENUM)) Q:SCORE=""
.S INSERT("SCORE")=SCORE
.D TEXT(.ORY,.OCNT,IMULT,.MULT,SCORE)
Q
;
OUT(DATA) ;Display element details
N DITEM S DITEM=$P(DATA,U,2) Q:'DITEM
W $P($G(^PXRMD(801.41,DITEM,0)),U)
W !,$J("Element Condition: ",19)
W $TR($P($G(^PXRMD(801.41,DITEM,0)),U,13),"~"," ")
W !,$J("Element text:",17)
;Get progress note text if defined
N SUB,TEXT S SUB=0
F S SUB=$O(^PXRMD(801.41,DITEM,35,SUB)) Q:'SUB D
.S TEXT=$G(^PXRMD(801.41,DITEM,35,SUB,0)) W !,?5,TEXT
W !,$J("Informational text:",17)
N SUB,TEXT S SUB=0
F S SUB=$O(^PXRMD(801.41,DITEM,25,SUB)) Q:'SUB D
.S TEXT=$G(^PXRMD(801.41,DITEM,25,SUB,0)) W !,?5,TEXT
Q
;
TEXT(ORY,OCNT,IMULT,MULT,SCORE) ;
;Load dialog results into ORY array
N DATA,DCON,DITEM,DSEQ,DSUB,DTYP,INS,SEP,TEXT
N INFOTEXT
;S SCORE=$G(INSERT("SCORE")) Q:SCORE=""
;Get the result elements
S DSEQ=0
F S DSEQ=$O(^PXRMD(801.41,RESULT,10,"B",DSEQ)) Q:'DSEQ D
.S DSUB=$O(^PXRMD(801.41,RESULT,10,"B",DSEQ,"")) Q:'DSUB
.S DITEM=$P($G(^PXRMD(801.41,RESULT,10,DSUB,0)),U,2) Q:'DITEM
.;Get the result element
.S DTYP=$P($G(^PXRMD(801.41,DITEM,0)),U,4) Q:DTYP'="T"
.;Get the result element condition
.S DCON=$P($G(^PXRMD(801.41,DITEM,0)),U,13)
.;Skip if condition not satisfied
.I DCON'="" S DCON=$TR(DCON,"~"," ") Q:'$$TRUE(SCORE,DCON,DFN)
.;Get progress note/Info text if defined
.N LAST,NULL,SUB,TEXT S SUB=0,LAST=0
.S INFOTEXT=""
.F S SUB=$O(^PXRMD(801.41,DITEM,25,SUB)) Q:'SUB D
..S TEXT=$G(^PXRMD(801.41,DITEM,25,SUB,0))
..I INFOTEXT="" S INFOTEXT="[INFOTEXT]"
..S NULL=0 I ($E(TEXT)=" ")!(TEXT="") S NULL=1
..;Add line breaks if is or preceded by blank line or starts with space
..I ('NULL),LAST S TEXT="
"_TEXT
..S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","
")
..S LAST=0 I NULL S TEXT="
"_TEXT,LAST=1
..I MULT=1,SUB=1,$E(TEXT,1,4)'="
" S TEXT="
"_TEXT
..S TEXT=$$STRREP^PXRMUTIL(TEXT,"
",U)
..I SUB=1,IMULT=1 S TEXT=U_TEXT
..S OCNT=OCNT+1,ORY(OCNT)=INFOTEXT_TEXT
..I IMULT=0,OCNT>0 S IMULT=1
..;S INFOTEXT=INFOTEXT_TEXT
.;
.S LAST=0,NULL=0,SUB=0
.F S SUB=$O(^PXRMD(801.41,DITEM,35,SUB)) Q:'SUB D
..;Insert score into text (if neccessary)
..S TEXT=$G(^PXRMD(801.41,DITEM,35,SUB,0))
..S NULL=0 I ($E(TEXT)=" ")!(TEXT="") S NULL=1
..;Add line breaks if is or preceded by blank line or starts with space
..I ('NULL),LAST S TEXT="
"_TEXT
..S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","
")
..S LAST=0 I NULL S TEXT="
"_TEXT,LAST=1
..I MULT=1,SUB=1,$E(TEXT,1,4)'="
" S TEXT="
"_TEXT
..;Check for inserts - note there may be embedded TIU markers too
..N INS
..S INS=""
..F S INS=$O(INSERT(INS)) Q:INS="" D
...S SEP="|"_INS_"|" I '$F(TEXT,SEP) Q
...S TEXT=$P(TEXT,SEP)_$G(INSERT(INS))_$P(TEXT,SEP,2,99)
..S OCNT=OCNT+1,ORY(OCNT)=TEXT
..I MULT=0,OCNT>0 S MULT=1
.;I $G(INFOTEXT)'="" S OCNT=OCNT+1,ORY(OCNT)=INFOTEXT
Q
;
TRUE(V,COND,DFN) ; Check if value meets element condition
N RESULT,SEX
I COND["SEX" D Q RESULT
. S RESULT=0
. S SEX=$P($G(^DPT(DFN,0)),U,2)
. X COND I S RESULT=1
X COND I Q 1
Q 0