APCLDF2.m

APCLDF2 ; IHS/CMI/LAB - YRULER<->PCC PROCESS ALGORITHM ;

 ;;2.0;IHS PCC SUITE;**2,4**;MAY 14, 2009

 ;

VI ; - ENTRY POINT - Ptr val for .01 field not in "AA" xref for this V FILE

 I VAL]"",'$D(APCLTX) S TVAL=$O(@TABLE@(XREF,VAL_" ","")) I TVAL="" S X=VAL,DIC(0)=$S($D(APCLINT):"MQEZ",1:"MO"),DIC=$S($E(TABLE,$L(TABLE))=")":$TR(TABLE,")",","),1:TABLE_"(") D ^DIC K DIC D  I Y=-1 S APCLER=8 G X4

 . I Y'=-1 S TVAL=+Y,VAL=$P(@TABLE@(+Y,0),U)

 S N=$S($G(N):N,1:0),C=$S($G(C):C,1:0)

 F D=0:0 S D=$O(@LKUP@("AA",PAT,D)) Q:'D  S E="" F  S E=$O(@LKUP@("AA",PAT,D,E)) Q:'E  I $D(@LKUP@(E,0)),$D(@TABLE@(+@LKUP@(E,0),0)) D

 . I $S('$D(TVAL)&($D(APCLTX)):$D(^TMP("APCLTAX",$J,$P(@LKUP@(E,0),U))),$D(TVAL):$P(@LKUP@(E,0),U)=TVAL,1:1) S C=C+1,N=N+1 S:'$D(TVAL) VAL=$P(@TABLE@(+@LKUP@(E,0),0),U) D TMP

 I '$D(APCLTX) D RESULTS

 I $D(APCLTX) S VAL=""

X4 Q

 ;

VV ; - ENTRY POINT - Ptr val. for .01 field in "AA" xref for this V FILE

 K NVAL

 I VAL]"",'$D(APCLTX) S TVAL=$O(@TABLE@(XREF,VAL,"")) S:$P($O(@TABLE@(XREF,VAL)),VAL)="" TVAL=""

 E  S TVAL=0,NVAL=""

 I VAL]"",TVAL="" S X=VAL,DIC(0)=$S($D(APCLINT):"MZQE",1:"MO"),DIC=$S($E(TABLE,$L(TABLE))=")":$TR(TABLE,")",","),1:TABLE_"(") D ^DIC K DIC D  I Y=-1 S APCLER=8 G X5

 . I Y'=-1 S TVAL=+Y,VAL=$P(@TABLE@(+Y,0),U)

 I 'TVAL D  I 1

 . S (C,N)=0 F  S TVAL=$O(@LKUP@("AA",PAT,TVAL)) Q:'TVAL  I $S('$D(APCLTX):1,$D(APCLTX)&$D(^TMP("APCLTAX",$J,TVAL)):1,1:0) D

 .. F D=0:0 S D=$O(@LKUP@("AA",PAT,TVAL,D)) Q:'D  S E="" F  S E=$O(@LKUP@("AA",PAT,TVAL,D,E)) Q:'E  I $D(@LKUP@(E,0)) S C=C+1,N=N+1,VAL=$P(@TABLE@(+@LKUP@(E,0),0),U) D TMP

 E  D

 . S N=$S($G(N):N,1:0),C=$S($G(C):C,1:0)

 . F D=0:0 S D=$O(@LKUP@("AA",PAT,TVAL,D)) Q:'D  S E="" F  S E=$O(@LKUP@("AA",PAT,TVAL,D,E)) Q:'E  I $D(@LKUP@(E,0)) S C=C+1,N=N+1 D TMP

 I '$D(APCLTX) D RESULTS

X5 Q

 ;

NV ; - ENTRY POINT - Not a V FILE

 I VAL]"" S TVAL=$S('$D(APCLTX):$O(@TABLE@(XREF,VAL,"")),1:VAL)

 E  I VAL="" F D=0:0 S D=$O(@LKUP@("AC",PAT,D)) D:'D RESULTS Q:'D  D

 . X:$D(SCRN) SCRN I $T S ^TMP("APCLDF",$J,"TMP",$S(COND="LAST":9999999-$P(@LKUP@(D,0),U,3),1:$P(@LKUP@(D,0),U,3)),D)=$P(@TABLE@(+@LKUP@(D,0),0),U)_"^"_$P(@TABLE@(+@LKUP@(D,0),0),U)_"^"_D_";"_$E(LKUP,2,20)

 I VAL]"",TVAL="" S X=VAL,DIC(0)=$S($D(APCLINT):"MZQE",1:"MO"),DIC=TABLE_"(" D ^DIC K DIC D  I Y=-1 S APCLER=8 G X6

 . I Y'=-1 S TVAL=+Y,VAL=$P(@TABLE@(+Y,0),U)

 I VAL]"" D

 . F D=0:0 S D=$O(@LKUP@("AC",PAT,D)) D:'D RESULTS Q:'D  D

 .. I 1 X:$D(SCRN) SCRN I $T,+@LKUP@(D,0)=TVAL D

 ... Q:$P(@LKUP@(D,0),U,3)=""

 ... S ^TMP("APCLDF",$J,"TMP",$S(COND="LAST":9999999-$P(@LKUP@(D,0),U,3),1:$P(@LKUP@(D,0),U,3)),D)=$S('$D(APCLTX):VAL,1:TVAL)_"^"_$S('$D(APCLTX):VAL_"^"_D_";"_$E(LKUP,1,20),1:TVAL_"^"_D_";"_$E(LKUP,2,20))

X6 Q

 ;

TMP ; Store dates, values

 ; if in a lab taxonomy lookup q if vlab site exists and doesn't equal site in taxonomy file

 ;I $D(APCLTX),TAX="LAB TAX",$P($G(^AUPNVLAB(E,11)),U,3)]"",$O(^TMP("APCLTAX",$J,TVAL,0)),'$D(^TMP("APCLTAX",$J,TVAL,$P($G(^AUPNVLAB(E,11)),U,3))) Q  ;IHS/CMI/LAB - do not look at site/specimen

 I LKUP["AUPNVMSR" Q:$P($G(^AUPNVMSR(E,2)),U,1)  ;skip measurements entered in error

 S ^TMP("APCLDF",$J,"TMP",$S(COND="LAST"&(DATE=""):D,1:9999999-D),C)=$S(TYPE="VV"&($P(@LKUP@(E,0),U,4)]""):$P(^(0),U,4)_"^"_VAL,1:$S(TYPE="VI":VAL_"^"_VAL,1:"?"_"^"_VAL))_"^"_E_";"_$E(LKUP,2,20)_"^"_$P(^(0),U,3)

 I DATE="",COND="LAST",N=NUM,'$D(NVAL) S (D,E)=999999999,VAL=""

X2 Q

 ;

RESULTS ;EP - Store results

 NEW D

 I DATE]"" D DATE^APCLDF3

 S I=0,%="" F  S %=$O(^TMP("APCLDF",$J,"TMP",%)) Q:'%  F D=0:0 S D=$O(^TMP("APCLDF",$J,"TMP",%,D)) S:D I=I+1 Q:'D!(I>NUM)  D

 . S @(APCLY_I_")")=$S(COND="LAST":9999999-%,1:%)_"^"_^TMP("APCLDF",$J,"TMP",%,D)

 K ^TMP("APCLDF",$J,"TMP")

 Q

 ;

ERROR ; Error flag list - APCLER value

1 ;;variable with patient and script value not passed

2 ;;variable with array value not passed

3 ;;taxonomy not allowed for this file

4 ;;demographic field/value not found

5 ;;class (file name) not found

6 ;;patient id not passed

7 ;;lookup into QMAN DICTIONARY OF TERMS failed

8 ;;entity unresolved, i.e., the name of a lab test or medication

9 ;;

10 ;;unresolved taxonomy

11 ;;value(s) not indicated

12 ;;unresolvable class(file name)

13 ;;unresolvable demographic attribute

14 ;;use last or first only for visit related data

15 ;;patient demographic attribute not entered

16 ;;indicated date parameter, i.e., since, before, etc., unacceptable

17 ;;date(s) not correctly indicated

18 ;;visit date not allowed for this attribute

APCLDF2   ; IHS/CMI/LAB - YRULER<->PCC PROCESS ALGORITHM ;

 +1       ;;2.0;IHS PCC SUITE;**2,4**;MAY 14, 2009

 +2       ;

VI        ; - ENTRY POINT - Ptr val for .01 field not in "AA" xref for this V FILE

 +1        IF VAL]""

               IF '$DATA(APCLTX)

                   SET TVAL=$ORDER(@TABLE@(XREF,VAL_" ",""))

                   IF TVAL=""

                       SET X=VAL

                       SET DIC(0)=$SELECT($DATA(APCLINT):"MQEZ",1:"MO")

                       SET DIC=$SELECT($EXTRACT(TABLE,$LENGTH(TABLE))=")":$TRANSLATE(TABLE,")",","),1:TABLE_"(")

                       DO ^DIC

                       KILL DIC

                       Begin DoDot:1

 +2                        IF Y'=-1

                               SET TVAL=+Y

                               SET VAL=$PIECE(@TABLE@(+Y,0),U)

                       End DoDot:1

                       IF Y=-1

                           SET APCLER=8

                           GOTO X4

 +3        SET N=$SELECT($GET(N):N,1:0)

           SET C=$SELECT($GET(C):C,1:0)

 +4        FOR D=0:0

               SET D=$ORDER(@LKUP@("AA",PAT,D))

               IF 'D

                   QUIT 

               SET E=""

               FOR 

                   SET E=$ORDER(@LKUP@("AA",PAT,D,E))

                   IF 'E

                       QUIT 

                   IF $DATA(@LKUP@(E,0))

                       IF $DATA(@TABLE@(+@LKUP@(E,0),0))

                           Begin DoDot:1

 +5                            IF $SELECT('$DATA(TVAL)&($DATA(APCLTX)):$DATA(^TMP("APCLTAX",$JOB,$PIECE(@LKUP@(E,0),U))),$DATA(TVAL):$PIECE(@LKUP@(E,0),U)=TVAL,1:1)

                                   SET C=C+1

                                   SET N=N+1

                                   IF '$DATA(TVAL)

                                       SET VAL=$PIECE(@TABLE@(+@LKUP@(E,0),0),U)

                                   DO TMP

                           End DoDot:1

 +6        IF '$DATA(APCLTX)

               DO RESULTS

 +7        IF $DATA(APCLTX)

               SET VAL=""

X4         QUIT 

 +1       ;

VV        ; - ENTRY POINT - Ptr val. for .01 field in "AA" xref for this V FILE

 +1        KILL NVAL

 +2        IF VAL]""

               IF '$DATA(APCLTX)

                   SET TVAL=$ORDER(@TABLE@(XREF,VAL,""))

                   IF $PIECE($ORDER(@TABLE@(XREF,VAL)),VAL)=""

                       SET TVAL=""

 +3       IF '$TEST

               SET TVAL=0

               SET NVAL=""

 +4        IF VAL]""

               IF TVAL=""

                   SET X=VAL

                   SET DIC(0)=$SELECT($DATA(APCLINT):"MZQE",1:"MO")

                   SET DIC=$SELECT($EXTRACT(TABLE,$LENGTH(TABLE))=")":$TRANSLATE(TABLE,")",","),1:TABLE_"(")

                   DO ^DIC

                   KILL DIC

                   Begin DoDot:1

 +5                    IF Y'=-1

                           SET TVAL=+Y

                           SET VAL=$PIECE(@TABLE@(+Y,0),U)

                   End DoDot:1

                   IF Y=-1

                       SET APCLER=8

                       GOTO X5

 +6        IF 'TVAL

               Begin DoDot:1

 +7                SET (C,N)=0

                   FOR 

                       SET TVAL=$ORDER(@LKUP@("AA",PAT,TVAL))

                       IF 'TVAL

                           QUIT 

                       IF $SELECT('$DATA(APCLTX):1,$DATA(APCLTX)&$DATA(^TMP("APCLTAX",$JOB,TVAL)):1,1:0)

                           Begin DoDot:2

 +8                            FOR D=0:0

                                   SET D=$ORDER(@LKUP@("AA",PAT,TVAL,D))

                                   IF 'D

                                       QUIT 

                                   SET E=""

                                   FOR 

                                       SET E=$ORDER(@LKUP@("AA",PAT,TVAL,D,E))

                                       IF 'E

                                           QUIT 

                                       IF $DATA(@LKUP@(E,0))

                                           SET C=C+1

                                           SET N=N+1

                                           SET VAL=$PIECE(@TABLE@(+@LKUP@(E,0),0),U)

                                           DO TMP

                           End DoDot:2

               End DoDot:1

               IF 1

 +9       IF '$TEST

               Begin DoDot:1

 +10               SET N=$SELECT($GET(N):N,1:0)

                   SET C=$SELECT($GET(C):C,1:0)

 +11               FOR D=0:0

                       SET D=$ORDER(@LKUP@("AA",PAT,TVAL,D))

                       IF 'D

                           QUIT 

                       SET E=""

                       FOR 

                           SET E=$ORDER(@LKUP@("AA",PAT,TVAL,D,E))

                           IF 'E

                               QUIT 

                           IF $DATA(@LKUP@(E,0))

                               SET C=C+1

                               SET N=N+1

                               DO TMP

               End DoDot:1

 +12       IF '$DATA(APCLTX)

               DO RESULTS

X5         QUIT 

 +1       ;

NV        ; - ENTRY POINT - Not a V FILE

 +1        IF VAL]""

               SET TVAL=$SELECT('$DATA(APCLTX):$ORDER(@TABLE@(XREF,VAL,"")),1:VAL)

 +2       IF '$TEST

               IF VAL=""

                   FOR D=0:0

                       SET D=$ORDER(@LKUP@("AC",PAT,D))

                       IF 'D

                           DO RESULTS

                       IF 'D

                           QUIT 

                       Begin DoDot:1

 +3                        IF $DATA(SCRN)

                               XECUTE SCRN

                           IF $TEST

                               SET ^TMP("APCLDF",$JOB,"TMP",$SELECT(COND="LAST":9999999-$PIECE(@LKUP@(D,0),U,3),1:$PIECE(@LKUP@(D,0),U,3)),D)=$PIECE(@TABLE@(+@LKUP@(D,0),0),U)_"^"_$PIECE(@TABLE@(+@LKUP@(D,0),0),U)_"^"_D_";"_$EXTRACT(LKUP,2,20)

                       End DoDot:1

 +4        IF VAL]""

               IF TVAL=""

                   SET X=VAL

                   SET DIC(0)=$SELECT($DATA(APCLINT):"MZQE",1:"MO")

                   SET DIC=TABLE_"("

                   DO ^DIC

                   KILL DIC

                   Begin DoDot:1

 +5                    IF Y'=-1

                           SET TVAL=+Y

                           SET VAL=$PIECE(@TABLE@(+Y,0),U)

                   End DoDot:1

                   IF Y=-1

                       SET APCLER=8

                       GOTO X6

 +6        IF VAL]""

               Begin DoDot:1

 +7                FOR D=0:0

                       SET D=$ORDER(@LKUP@("AC",PAT,D))

                       IF 'D

                           DO RESULTS

                       IF 'D

                           QUIT 

                       Begin DoDot:2

 +8                        IF 1

                               IF $DATA(SCRN)

                                   XECUTE SCRN

                               IF $TEST

                                   IF +@LKUP@(D,0)=TVAL

                                       Begin DoDot:3

 +9                                        IF $PIECE(@LKUP@(D,0),U,3)=""

                                               QUIT 

 +10                                       SET ^TMP("APCLDF",$JOB,"TMP",$SELECT(COND="LAST":9999999-$PIECE(@LKUP@(D,0),U,3),1:$PIECE(@LKUP@(D,0),U,3)),D)=$SELECT('$DATA(APCLTX):VAL,1:TVAL)_"^"_$SELECT('$DATA(APCLTX):VAL_"^"_D_";"_$EXTRACT(LKUP,1,20),1:TVA

L_"^"_D_";"_$EXTRACT(LKUP,2,20))

                                       End DoDot:3

                       End DoDot:2

               End DoDot:1

X6         QUIT 

 +1       ;

TMP       ; Store dates, values

 +1       ; if in a lab taxonomy lookup q if vlab site exists and doesn't equal site in taxonomy file

 +2       ;I $D(APCLTX),TAX="LAB TAX",$P($G(^AUPNVLAB(E,11)),U,3)]"",$O(^TMP("APCLTAX",$J,TVAL,0)),'$D(^TMP("APCLTAX",$J,TVAL,$P($G(^AUPNVLAB(E,11)),U,3))) Q  ;IHS/CMI/LAB - do not look at site/specimen

 +3       ;skip measurements entered in error

           IF LKUP["AUPNVMSR"

               IF $PIECE($GET(^AUPNVMSR(E,2)),U,1)

                   QUIT 

 +4        SET ^TMP("APCLDF",$JOB,"TMP",$SELECT(COND="LAST"&(DATE=""):D,1:9999999-D),C)=$SELECT(TYPE="VV"&($PIECE(@LKUP@(E,0),U,4)]""):$PIECE(^(0),U,4)_"^"_VAL,1:$SELECT(TYPE="VI":VAL_"^"_VAL,1:"?"_"^"_VAL))_"^"_E_";"_$EXTRACT(LKUP,2,20)_"^"_$PIECE(^(0),U

,3)

 +5        IF DATE=""

               IF COND="LAST"

                   IF N=NUM

                       IF '$DATA(NVAL)

                           SET (D,E)=999999999

                           SET VAL=""

X2         QUIT 

 +1       ;

RESULTS   ;EP - Store results

 +1        NEW D

 +2        IF DATE]""

               DO DATE^APCLDF3

 +3        SET I=0

           SET %=""

           FOR 

               SET %=$ORDER(^TMP("APCLDF",$JOB,"TMP",%))

               IF '%

                   QUIT 

               FOR D=0:0

                   SET D=$ORDER(^TMP("APCLDF",$JOB,"TMP",%,D))

                   IF D

                       SET I=I+1

                   IF 'D!(I>NUM)

                       QUIT 

                   Begin DoDot:1

 +4                    SET @(APCLY_I_")")=$SELECT(COND="LAST":9999999-%,1:%)_"^"_^TMP("APCLDF",$JOB,"TMP",%,D)

                   End DoDot:1

 +5        KILL ^TMP("APCLDF",$JOB,"TMP")

 +6        QUIT 

 +7       ;

ERROR     ; Error flag list - APCLER value

1         ;;variable with patient and script value not passed

2         ;;variable with array value not passed

3         ;;taxonomy not allowed for this file

4         ;;demographic field/value not found

5         ;;class (file name) not found

6         ;;patient id not passed

7         ;;lookup into QMAN DICTIONARY OF TERMS failed

8         ;;entity unresolved, i.e., the name of a lab test or medication

9         ;;

10        ;;unresolved taxonomy

11        ;;value(s) not indicated

12        ;;unresolvable class(file name)

13        ;;unresolvable demographic attribute

14        ;;use last or first only for visit related data

15        ;;patient demographic attribute not entered

16        ;;indicated date parameter, i.e., since, before, etc., unacceptable

17        ;;date(s) not correctly indicated

18        ;;visit date not allowed for this attribute