PXRMDRSG.m

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