VENPCC1B ; IHS/OIT/GIS - MORE ENCOUNTER FORM DATA MINING ;
;;2.6;PCC+;;NOV 12, 2007
;
; DEAD CODE REMOVED IN VER 2.5
;
EXT(EXT) ; EP-PROCESS EXTERNAL DATA
; DATA MUST BE A DELIMITED STRING IN THE FORMAT fieldname;value^
; e.g. c1;val1^c2;val2^...
N I,X,Y,%,SAB,TAB,AB,FLD,SIEN
F I=1:1:$L(EXT,U) D
. S %=$P(EXT,U,I) I '$L(%) Q
. S X=$P(%,";") I '$L(X) Q
. S Y=$P(%,";",2,99)
. I X="CC" D CC(Y) Q
. I $E(X,1,3)="RF-" D RF(%) Q
. I $E(X,1,6)="ADMTXT" S @TMP@(1,"c50")=Y Q
. I $E(X,1,5)="ORDER" D ORD(Y) Q
. S SIEN=$O(^VEN(7.93,"B",X,0)) I SIEN="" Q
. S FLD=$P($G(^VEN(7.93,SIEN,0)),U,8) I '$L(FLD) Q
. I $L(Y) S @TMP@(1,FLD)=Y
. Q
I '$D(SAB),'$D(TAB) Q
S AB=$G(SAB) I $L(AB) S AB=" "_AB
S AB=AB_$G(TAB)
S @TMP@(1,"ab")=AB
Q
;
RF(%) ; EP-GET RODUCTIVE FACTORS
N X,Z,VAL
S X=$P(%,";") I '$L(X) Q
S VAL=$P(%,";",2) I '$L(VAL) Q
S Z=$P(X,"-",2)
I Z'="LMP" Q
S @TMP@(1,"lab1")="LMP: "_VAL
Q
;
ORD(IEN) ; EP-CHECK OFF AN ORDER ; NOT USED IN VERSION 1
N FLD,X
S IEN=+$G(IEN)
I '$D(^VEN(7.93,IEN,0)) Q
S X=$P($G(^VEN(7.93,IEN,0)),U,8) I '$L(X) Q
S FLD=X_"x"
S @TMP@(1,FLD)=4
Q
;
CC(Y) ; EP-GETS CHIEF COMPLAINT ; NOT USED IN VER 1
N I,X,MAX
S MAX=$P($G(^VEN(7.41,DEFEF,14)),U,8)
I 'MAX S MAX=240
S Y=$E(Y,1,MAX)
S @TMP@(1,"c13")=Y
Q
;
CLASS(DFN) ; EP-GIVEN A DFN, RETURN THE PATIENT CLASS FOR USER PREFERENCES
N AGE,SEX,DOB,X,Y
S X=$P($G(^DPT(DFN,0)),U,2,3),DOB=$P(X,U,2),SEX=$P(X,U)
I DOB,$L(SEX)
E Q ""
S AGE=(DT-DOB)\10000
I AGE<2 Q 1
I AGE<12 Q 2
S Y=(SEX="F")
I AGE<18 Q (3+Y)
I AGE<65 Q (5+Y)
Q (7+Y)
;
VENPCC1B ; IHS/OIT/GIS - MORE ENCOUNTER FORM DATA MINING ;
+1 ;;2.6;PCC+;;NOV 12, 2007
+2 ;
+3 ; DEAD CODE REMOVED IN VER 2.5
+4 ;
EXT(EXT) ; EP-PROCESS EXTERNAL DATA
+1 ; DATA MUST BE A DELIMITED STRING IN THE FORMAT fieldname;value^
+2 ; e.g. c1;val1^c2;val2^...
+3 NEW I,X,Y,%,SAB,TAB,AB,FLD,SIEN
+4 FOR I=1:1:$LENGTH(EXT,U)
Begin DoDot:1
+5 SET %=$PIECE(EXT,U,I)
IF '$LENGTH(%)
QUIT
+6 SET X=$PIECE(%,";")
IF '$LENGTH(X)
QUIT
+7 SET Y=$PIECE(%,";",2,99)
+8 IF X="CC"
DO CC(Y)
QUIT
+9 IF $EXTRACT(X,1,3)="RF-"
DO RF(%)
QUIT
+10 IF $EXTRACT(X,1,6)="ADMTXT"
SET @TMP@(1,"c50")=Y
QUIT
+11 IF $EXTRACT(X,1,5)="ORDER"
DO ORD(Y)
QUIT
+12 SET SIEN=$ORDER(^VEN(7.93,"B",X,0))
IF SIEN=""
QUIT
+13 SET FLD=$PIECE($GET(^VEN(7.93,SIEN,0)),U,8)
IF '$LENGTH(FLD)
QUIT
+14 IF $LENGTH(Y)
SET @TMP@(1,FLD)=Y
+15 QUIT
End DoDot:1
+16 IF '$DATA(SAB)
IF '$DATA(TAB)
QUIT
+17 SET AB=$GET(SAB)
IF $LENGTH(AB)
SET AB=" "_AB
+18 SET AB=AB_$GET(TAB)
+19 SET @TMP@(1,"ab")=AB
+20 QUIT
+21 ;
RF(%) ; EP-GET RODUCTIVE FACTORS
+1 NEW X,Z,VAL
+2 SET X=$PIECE(%,";")
IF '$LENGTH(X)
QUIT
+3 SET VAL=$PIECE(%,";",2)
IF '$LENGTH(VAL)
QUIT
+4 SET Z=$PIECE(X,"-",2)
+5 IF Z'="LMP"
QUIT
+6 SET @TMP@(1,"lab1")="LMP: "_VAL
+7 QUIT
+8 ;
ORD(IEN) ; EP-CHECK OFF AN ORDER ; NOT USED IN VERSION 1
+1 NEW FLD,X
+2 SET IEN=+$GET(IEN)
+3 IF '$DATA(^VEN(7.93,IEN,0))
QUIT
+4 SET X=$PIECE($GET(^VEN(7.93,IEN,0)),U,8)
IF '$LENGTH(X)
QUIT
+5 SET FLD=X_"x"
+6 SET @TMP@(1,FLD)=4
+7 QUIT
+8 ;
CC(Y) ; EP-GETS CHIEF COMPLAINT ; NOT USED IN VER 1
+1 NEW I,X,MAX
+2 SET MAX=$PIECE($GET(^VEN(7.41,DEFEF,14)),U,8)
+3 IF 'MAX
SET MAX=240
+4 SET Y=$EXTRACT(Y,1,MAX)
+5 SET @TMP@(1,"c13")=Y
+6 QUIT
+7 ;
CLASS(DFN) ; EP-GIVEN A DFN, RETURN THE PATIENT CLASS FOR USER PREFERENCES
+1 NEW AGE,SEX,DOB,X,Y
+2 SET X=$PIECE($GET(^DPT(DFN,0)),U,2,3)
SET DOB=$PIECE(X,U,2)
SET SEX=$PIECE(X,U)
+3 IF DOB
IF $LENGTH(SEX)
+4 IF '$TEST
QUIT ""
+5 SET AGE=(DT-DOB)\10000
+6 IF AGE<2
QUIT 1
+7 IF AGE<12
QUIT 2
+8 SET Y=(SEX="F")
+9 IF AGE<18
QUIT (3+Y)
+10 IF AGE<65
QUIT (5+Y)
+11 QUIT (7+Y)
+12 ;
