Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLR.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDLR.m
r613 r623 1 PXRMDLR ;SLC/PJH - DIALOG RESULTS LOADER ;05/15/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ; 4 ;Build score related P/N text from score and result group 5 ; 6 ;If not found 7 START(ORY,RESULT,ORES) ; 8 I '$G(RESULT) S ORY(1)="-1^no results for this test" Q 9 ; 10 N ARRAY,ERROR,INSERT,OK,SCORE,SUB,YT,X 11 ; 12 I RESULT["~" S RESULT=$P(RESULT,"~") 13 S ERROR=0 14 ; 15 ;Get score using API 16 K ^TMP($J,"YSCOR") 17 I ORES("CODE")'="DOM80" D Q:ERROR 18 .M YT=ORES 19 .F X=1:1:$L(YT("R1")) I $E(YT("R1"),X)'="X" S YT(X)=X_U_$E(YT("R1"),X) 20 .K YT("R1") 21 .D CHECKCR^YTQPXRM4(.ARRAY,.YT) 22 .S OK=0 23 .;D PREVIEW^YTAPI4(.ARRAY,.YT) 24 .I ^TMP($J,"YSCOR",1)'="[DATA]" S ORY(1)="-1^"_^TMP($J,"YSCOR",1)_^TMP($J,"YSCOD",2),ERROR=1 Q 25 .;I ARRAY(1)'="[DATA]" S ORY(1)="-1^"_ARRAY(1)_ARRAY(2),ERROR=1 Q 26 .I $P($G(^TMP($J,"YSCOR",2)),"=",2)'="" S SCORE=$P($G(^TMP($J,"YSCOR",2)),"=",2),OK=1 27 .;S SUB=0,OK=0 28 .;F S SUB=$O(ARRAY(SUB)) Q:'SUB D Q:OK 29 .;.I $P(ARRAY(SUB),U)="S1" S SCORE=$P(ARRAY(SUB),U,3),OK=1 30 .I 'OK S ORY(1)="-1^[ERROR] no score returned",ERROR=1 Q 31 ; 32 ;Except for DOM80 33 I ORES("CODE")="DOM80" D 34 .I $E(ORES("R1"))="Y" S SCORE=1 Q 35 .I $E(ORES("R1"),2,3)="YY",($E(ORES("R1"),4)>1) S SCORE=1 Q 36 .S SCORE=0 37 ; 38 S DFN=$G(ORES("DFN")) 39 S INSERT("SCORE")=SCORE 40 ; 41 ;For AIMS special formatting is required 42 I ORES("CODE")="AIMS" D 43 .N CNT,LITS,RESP,SUM 44 .S LITS(0)="none",LITS(1)="minimal",LITS(2)="mild",LITS(3)="moderate" 45 .S LITS(4)="severe",SUM(2)=0,SUM(3)=0,SUM(4)=0 46 .F CNT=1:1 S RESP=$E(ORES("R1"),CNT) Q:RESP="" D 47 ..S INSERT("R"_CNT)=$G(LITS(RESP)) 48 ..I (CNT<8),(234[RESP) S SUM(RESP)=SUM(RESP)+1 49 .F CNT=2,3,4 S INSERT("SUM"_CNT)=SUM(CNT) 50 ; 51 TEXT ; 52 I RESULT["~" S RESULT=$P(RESULT,"~") 53 ;Load dialog results into ORY array 54 N DATA,DCON,DITEM,DSEQ,DSUB,DTYP,INS,SEP,TEXT 55 ;Get the result elements 56 S DSEQ=0,OCNT=0 57 F S DSEQ=$O(^PXRMD(801.41,RESULT,10,"B",DSEQ)) Q:'DSEQ D 58 .S DSUB=$O(^PXRMD(801.41,RESULT,10,"B",DSEQ,"")) Q:'DSUB 59 .S DITEM=$P($G(^PXRMD(801.41,RESULT,10,DSUB,0)),U,2) Q:'DITEM 60 .;Get the result element 61 .S DTYP=$P($G(^PXRMD(801.41,DITEM,0)),U,4) Q:DTYP'="T" 62 .;Get the result element condition 63 .S DCON=$P($G(^PXRMD(801.41,DITEM,0)),U,13) 64 .;Skip if condition not satisfied 65 .I DCON'="" S DCON=$TR(DCON,"~"," ") Q:'$$TRUE(SCORE,DCON,DFN) 66 .;Get progress note text if defined 67 .N LAST,NULL,SUB,TEXT S SUB=0,LAST=0 68 .F S SUB=$O(^PXRMD(801.41,DITEM,35,SUB)) Q:'SUB D 69 ..;Insert score into text (if neccessary) 70 ..S TEXT=$G(^PXRMD(801.41,DITEM,35,SUB,0)) 71 ..S NULL=0 I ($E(TEXT)=" ")!(TEXT="") S NULL=1 72 ..;Add line breaks if is or preceded by blank line or starts with space 73 ..I ('NULL),LAST S TEXT="<br>"_TEXT 74 ..S TEXT=$$STRREP^PXRMUTIL(TEXT,"\\","<br>") 75 ..S LAST=0 I NULL S TEXT="<br>"_TEXT,LAST=1 76 ..;Check for inserts - note there may be embedded TIU markers too 77 ..N INS 78 ..S INS="" 79 ..F S INS=$O(INSERT(INS)) Q:INS="" D 80 ...S SEP="|"_INS_"|" I '$F(TEXT,SEP) Q 81 ...S TEXT=$P(TEXT,SEP)_$G(INSERT(INS))_$P(TEXT,SEP,2,99) 82 ..S OCNT=OCNT+1,ORY(OCNT)=7_U_TEXT 83 Q 84 ; 85 MHDLL(ORES,RESULT,SCORE,DFN) ; 86 S INSERT("SCORE")=SCORE 87 D TEXT 88 Q 89 OUT(DATA) ;Display element details 90 N DITEM S DITEM=$P(DATA,U,2) Q:'DITEM 91 W $P($G(^PXRMD(801.41,DITEM,0)),U) 92 W !,$J("Element Condition: ",19) 93 W $TR($P($G(^PXRMD(801.41,DITEM,0)),U,13),"~"," ") 94 W !,$J("Element text:",17) 95 ;Get progress note text if defined 96 N SUB,TEXT S SUB=0 97 F S SUB=$O(^PXRMD(801.41,DITEM,35,SUB)) Q:'SUB D 98 .S TEXT=$G(^PXRMD(801.41,DITEM,35,SUB,0)) W !,?5,TEXT 99 Q 100 ; 101 TRUE(V,COND,DFN) ; Check if value meets element condition 102 N RESULT,SEX 103 I COND["SEX" D Q RESULT 104 . S RESULT=0 105 . S SEX=$P($G(^DPT(DFN,0)),U,2) 106 . X COND I S RESULT=1 107 X COND I Q 1 108 Q 0 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
Note:
See TracChangeset
for help on using the changeset viewer.
