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="<br>"_TEXT
..S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
..S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
..I MULT=1,SUB=1,$E(TEXT,1,4)'="<br>" S TEXT="<br>"_TEXT
..S TEXT=$$STRREP^PXRMUTIL(TEXT,"<br>",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="<br>"_TEXT
..S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
..S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1
..I MULT=1,SUB=1,$E(TEXT,1,4)'="<br>" S TEXT="<br>"_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
PXRMDRSG ;SLC/AGP - DIALOG RESULTS LOADER ;05/14/2007
+1 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123
+2 ;
+3 ;Build score related P/N text from score and result group
+4 ;
MHDLL(ORY,RESULTS,SCORES,DFN) ;
+1 NEW ARY,CNT,NODE,RESULT,SCORE,SCALENUM
+2 NEW OCNT,IMULT,MULT
+3 SET OCNT=0
SET IMULT=0
SET MULT=0
+4 SET CNT=0
FOR
SET CNT=$ORDER(SCORES(CNT))
IF CNT'>0
QUIT
Begin DoDot:1
+5 SET NODE=$GET(SCORES(CNT))
IF NODE=""
QUIT
+6 SET ARY($PIECE(NODE,"~"))=$PIECE(NODE,"~",2)
End DoDot:1
+7 SET CNT=0
FOR
SET CNT=$ORDER(RESULTS(CNT))
IF CNT'>0
QUIT
Begin DoDot:1
+8 SET RESULT=$GET(RESULTS(CNT))
IF RESULT=""
QUIT
+9 IF $PIECE($GET(^PXRMD(801.41,RESULT,50)),U,1)=""
QUIT
+10 SET SCALENUM=$PIECE($GET(^PXRMD(801.41,RESULT,50)),U,2)
IF SCALENUM=""
QUIT
+11 SET SCORE=$GET(ARY(SCALENUM))
IF SCORE=""
QUIT
+12 SET INSERT("SCORE")=SCORE
+13 DO TEXT(.ORY,.OCNT,IMULT,.MULT,SCORE)
End DoDot:1
+14 QUIT
+15 ;
OUT(DATA) ;Display element details
+1 NEW DITEM
SET DITEM=$PIECE(DATA,U,2)
IF 'DITEM
QUIT
+2 WRITE $PIECE($GET(^PXRMD(801.41,DITEM,0)),U)
+3 WRITE !,$JUSTIFY("Element Condition: ",19)
+4 WRITE $TRANSLATE($PIECE($GET(^PXRMD(801.41,DITEM,0)),U,13),"~"," ")
+5 WRITE !,$JUSTIFY("Element text:",17)
+6 ;Get progress note text if defined
+7 NEW SUB,TEXT
SET SUB=0
+8 FOR
SET SUB=$ORDER(^PXRMD(801.41,DITEM,35,SUB))
IF 'SUB
QUIT
Begin DoDot:1
+9 SET TEXT=$GET(^PXRMD(801.41,DITEM,35,SUB,0))
WRITE !,?5,TEXT
End DoDot:1
+10 WRITE !,$JUSTIFY("Informational text:",17)
+11 NEW SUB,TEXT
SET SUB=0
+12 FOR
SET SUB=$ORDER(^PXRMD(801.41,DITEM,25,SUB))
IF 'SUB
QUIT
Begin DoDot:1
+13 SET TEXT=$GET(^PXRMD(801.41,DITEM,25,SUB,0))
WRITE !,?5,TEXT
End DoDot:1
+14 QUIT
+15 ;
TEXT(ORY,OCNT,IMULT,MULT,SCORE) ;
+1 ;Load dialog results into ORY array
+2 NEW DATA,DCON,DITEM,DSEQ,DSUB,DTYP,INS,SEP,TEXT
+3 NEW INFOTEXT
+4 ;S SCORE=$G(INSERT("SCORE")) Q:SCORE=""
+5 ;Get the result elements
+6 SET DSEQ=0
+7 FOR
SET DSEQ=$ORDER(^PXRMD(801.41,RESULT,10,"B",DSEQ))
IF 'DSEQ
QUIT
Begin DoDot:1
+8 SET DSUB=$ORDER(^PXRMD(801.41,RESULT,10,"B",DSEQ,""))
IF 'DSUB
QUIT
+9 SET DITEM=$PIECE($GET(^PXRMD(801.41,RESULT,10,DSUB,0)),U,2)
IF 'DITEM
QUIT
+10 ;Get the result element
+11 SET DTYP=$PIECE($GET(^PXRMD(801.41,DITEM,0)),U,4)
IF DTYP'="T"
QUIT
+12 ;Get the result element condition
+13 SET DCON=$PIECE($GET(^PXRMD(801.41,DITEM,0)),U,13)
+14 ;Skip if condition not satisfied
+15 IF DCON'=""
SET DCON=$TRANSLATE(DCON,"~"," ")
IF '$$TRUE(SCORE,DCON,DFN)
QUIT
+16 ;Get progress note/Info text if defined
+17 NEW LAST,NULL,SUB,TEXT
SET SUB=0
SET LAST=0
+18 SET INFOTEXT=""
+19 FOR
SET SUB=$ORDER(^PXRMD(801.41,DITEM,25,SUB))
IF 'SUB
QUIT
Begin DoDot:2
+20 SET TEXT=$GET(^PXRMD(801.41,DITEM,25,SUB,0))
+21 IF INFOTEXT=""
SET INFOTEXT="[INFOTEXT]"
+22 SET NULL=0
IF ($EXTRACT(TEXT)=" ")!(TEXT="")
SET NULL=1
+23 ;Add line breaks if is or preceded by blank line or starts with space
+24 IF ('NULL)
IF LAST
SET TEXT="<br>"_TEXT
+25 SET TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
+26 SET LAST=0
IF NULL
SET TEXT="<br>"_TEXT
SET LAST=1
+27 IF MULT=1
IF SUB=1
IF $EXTRACT(TEXT,1,4)'="<br>"
SET TEXT="<br>"_TEXT
+28 SET TEXT=$$STRREP^PXRMUTIL(TEXT,"<br>",U)
+29 IF SUB=1
IF IMULT=1
SET TEXT=U_TEXT
+30 SET OCNT=OCNT+1
SET ORY(OCNT)=INFOTEXT_TEXT
+31 IF IMULT=0
IF OCNT>0
SET IMULT=1
+32 ;S INFOTEXT=INFOTEXT_TEXT
End DoDot:2
+33 ;
+34 SET LAST=0
SET NULL=0
SET SUB=0
+35 FOR
SET SUB=$ORDER(^PXRMD(801.41,DITEM,35,SUB))
IF 'SUB
QUIT
Begin DoDot:2
+36 ;Insert score into text (if neccessary)
+37 SET TEXT=$GET(^PXRMD(801.41,DITEM,35,SUB,0))
+38 SET NULL=0
IF ($EXTRACT(TEXT)=" ")!(TEXT="")
SET NULL=1
+39 ;Add line breaks if is or preceded by blank line or starts with space
+40 IF ('NULL)
IF LAST
SET TEXT="<br>"_TEXT
+41 SET TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>")
+42 SET LAST=0
IF NULL
SET TEXT="<br>"_TEXT
SET LAST=1
+43 IF MULT=1
IF SUB=1
IF $EXTRACT(TEXT,1,4)'="<br>"
SET TEXT="<br>"_TEXT
+44 ;Check for inserts - note there may be embedded TIU markers too
+45 NEW INS
+46 SET INS=""
+47 FOR
SET INS=$ORDER(INSERT(INS))
IF INS=""
QUIT
Begin DoDot:3
+48 SET SEP="|"_INS_"|"
IF '$FIND(TEXT,SEP)
QUIT
+49 SET TEXT=$PIECE(TEXT,SEP)_$GET(INSERT(INS))_$PIECE(TEXT,SEP,2,99)
End DoDot:3
+50 SET OCNT=OCNT+1
SET ORY(OCNT)=TEXT
+51 IF MULT=0
IF OCNT>0
SET MULT=1
End DoDot:2
+52 ;I $G(INFOTEXT)'="" S OCNT=OCNT+1,ORY(OCNT)=INFOTEXT
End DoDot:1
+53 QUIT
+54 ;
TRUE(V,COND,DFN) ; Check if value meets element condition
+1 NEW RESULT,SEX
+2 IF COND["SEX"
Begin DoDot:1
+3 SET RESULT=0
+4 SET SEX=$PIECE($GET(^DPT(DFN,0)),U,2)
+5 XECUTE COND
IF $TEST
SET RESULT=1
End DoDot:1
QUIT RESULT
+6 XECUTE COND
IF $TEST
QUIT 1
+7 QUIT 0
