APCLDF1.m

APCLDF1 ; IHS/CMI/LAB -IHS -PROCESS ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

PARSE ;- ENTRY POINT from APCLDF - Parse script   

 S DATE=$P(X,";",2),X=$P(X,";")

 S COND=$P(X," ")

 I COND="ALL"!(COND="LAST")!(COND="FIRST")

 E  I "INACTIVEPROBLEMSFAMILYPERSONALHISTORY"[$P($P(X," "),".") S X="ALL "_X,COND="ALL"

 E  S X="ALL "_X,COND="ALL"

 I '$P(X," ",2) S X=$P(X," ")_$S(COND="ALL":" 9999999 ",1:" 1 ")_$P(X," ",2,15)

 S NUM=$P(X," ",2)

 S FILE=$P(X," ",3),FILE=$TR(FILE,"."," ")

 S VAL=$P(X," ",4,15)

 I DATE]"" D DATE

X3 Q

 ;

DATE ; Process dates

 NEW YRLER

 S BOOL=$P(DATE," "),BOOL=$S(BOOL="<>":"<>","BEFORELESS<"[BOOL:"<","BETWEENDURING"[BOOL:"<>","AFTERGREATERSINCE>"[BOOL:">","ON=EQUALS"[BOOL:"=",1:"")

 I BOOL="" S APCLER=16 G X9

 S DATE=$P(DATE," ",2,15)

 I BOOL="<>" S STDATE=$P(DATE,"-"),EDATE=$P(DATE,"-",2) D  I 1

 . S X=STDATE K %DT D ^%DT S STDATE=Y I Y=-1 S YRLER=17 G X10

 . I EDATE="",$E(STDATE,6,7)'="00" S APCLER=17 G X10

 . I EDATE="" S EDATE=STDATE

 . E  S X=EDATE K %DT D ^%DT S EDATE=Y I Y=-1 S YRLER=17 G X10

 . I $E(STDATE,6,7)="00"!($E(EDATE,6,7)="00") F X="STDATE","EDATE" D DATECHG

X10 . Q

 E  S X=DATE S:BOOL="=" %DT="X" D ^%DT K %DT S DATE=Y D  I Y=-1 S APCLER=17

 . I Y=-1 Q

 . I $E(DATE,6,7)="00" S X="DATE" D DATECHG

X9 Q

 ;

DATECHG ; Change dates to usuable form if user just enters date with year

 ; or month and year only

 I X="STDATE" D  G X11

 . S STDATE=$S($E(STDATE,4,5)="00":$E(STDATE,1,3)_"0101",1:$E(STDATE,1,5)_"01")

 I X="EDATE" D  G X11

 . S EDATE=$S($E(EDATE,4,5)="00":$E(EDATE,1,3)_1231,1:$E(EDATE,1,5)_31)

 E  D

 . I BOOL=">" S DATE=$S($E(DATE,4,5)="00":$E(DATE,1,3)_1231,1:$E(DATE,1,5)_31)

 . E  S DATE=$S($E(DATE,4,5)="00":$E(DATE,1,3)_"0101",1:$E(DATE,1,5)_"01")

X11 Q

 ;

PROCESS ;  - ENTRY POINT from APCLDF - Get values and/or create tax vals

 I TYPE="VISIT" D VISIT^APCLDF3 G X8

 I VAL="*" D  G X8

 . S APCLTX=""

 . I COND'="LAST" S VAL=0 F  S VAL=$O(^TMP("APCLTAX",$J,VAL))  Q:'VAL  D @(TYPE_"^APCLDF2") Q:'VAL  D  I 1

 .. I '$D(APCLER) D RESULTS^APCLDF2

 . E  S VAL="" D @(TYPE_"^APCLDF2") D

 .. I '$D(APCLER) D RESULTS^APCLDF2

 I $E(VAL)'="[" D

 . D @(TYPE_"^APCLDF2")

 E  D

 . I TAX="LAB TAX" D LABTAX G X8

 . S X=TAX,DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC

 . I Y=-1 S APCLER=7

 . E  D

 .. S AMQQLINK=$P(^AMQQ(5,+Y,0),U,5),AMQQTAXT=$P(^(0),U,14),AMQQTGBL=U_$P($P(^(0),U,18),"("),APCLTX=""

 .. S X=VAL,AMQQGTX="^TMP(""APCLTAX"","_$J_"," S:$D(APCLINT) AMQQECHO="" D EN1^AMQQGTX D

 ... I '$D(^TMP("APCLTAX",$J)) S APCLER=10 Q

 ... ;I COND'="LAST" D @(TYPE_"^APCLDF2") I 1

 ...I COND'="LAST" S VAL=0 F  S VAL=$O(^TMP("APCLTAX",$J,VAL))  Q:'VAL  D @(TYPE_"^APCLDF2") Q:'VAL  D  I 1

 ....I '$D(APCLER) D RESULTS^APCLDF2

 ... E  S VAL="" D @(TYPE_"^APCLDF2")

 .. I '$D(APCLER) D RESULTS^APCLDF2

X8 Q

 ;

LABTAX ;resolve lab taxonomy and store in ^TMP("APCLTAX",$J,lab ien,site/spec ien)=""

 NEW LABTAX,X

 S APCLTX=""

 S X=$E(VAL,2,99999999),DIC="^ATXLAB(",DIC(0)="FM" D ^DIC K DIC

 I Y=-1 S APCLER=7 Q

 S LABTAX=+Y

 S X=0 F  S X=$O(^ATXLAB(LABTAX,21,X)) Q:X'=+X  S ^TMP("APCLTAX",$J,$P(^ATXLAB(LABTAX,21,X,0),U))="",Y=0 F  S Y=$O(^ATXLAB(LABTAX,21,X,11,Y)) Q:Y'=+Y  D

 .Q  ;DON'T DO THIS SITE/SPECIMEN CHECK IHS/CMI/LAB

 .S Z=$P(^ATXLAB(LABTAX,21,X,0),U),T=$P(^ATXLAB(LABTAX,21,X,11,Y,0),U)

 .S ^TMP("APCLTAX",$J,Z,T)=""

 .Q

 I '$D(^TMP("APCLTAX",$J)) S APCLER=10 Q

 I COND'="LAST" S VAL=0 F  S VAL=$O(^TMP("APCLTAX",$J,VAL)) Q:'VAL  D @(TYPE_"^APCLDF2") Q:'VAL  D  I 1

 .I '$D(APCLER) D RESULTS^APCLDF2

 E  S VAL="" D @(TYPE_"^APCLDF2")

 I '$D(APCLER) D RESULTS^APCLDF2

 K LABTAX,X,Y,Z,T

 D @(TYPE_"^APCLDF2") Q:'VAL  I 1

 Q

APCLDF1   ; IHS/CMI/LAB -IHS -PROCESS ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

PARSE     ;- ENTRY POINT from APCLDF - Parse script   

 +1        SET DATE=$PIECE(X,";",2)

           SET X=$PIECE(X,";")

 +2        SET COND=$PIECE(X," ")

 +3        IF COND="ALL"!(COND="LAST")!(COND="FIRST")

 +4       IF '$TEST

               IF "INACTIVEPROBLEMSFAMILYPERSONALHISTORY"[$PIECE($PIECE(X," "),".")

                   SET X="ALL "_X

                   SET COND="ALL"

 +5       IF '$TEST

               SET X="ALL "_X

               SET COND="ALL"

 +6        IF '$PIECE(X," ",2)

               SET X=$PIECE(X," ")_$SELECT(COND="ALL":" 9999999 ",1:" 1 ")_$PIECE(X," ",2,15)

 +7        SET NUM=$PIECE(X," ",2)

 +8        SET FILE=$PIECE(X," ",3)

           SET FILE=$TRANSLATE(FILE,"."," ")

 +9        SET VAL=$PIECE(X," ",4,15)

 +10       IF DATE]""

               DO DATE

X3         QUIT 

 +1       ;

DATE      ; Process dates

 +1        NEW YRLER

 +2        SET BOOL=$PIECE(DATE," ")

           SET BOOL=$SELECT(BOOL="<>":"<>","BEFORELESS<"[BOOL:"<","BETWEENDURING"[BOOL:"<>","AFTERGREATERSINCE>"[BOOL:">","ON=EQUALS"[BOOL:"=",1:"")

 +3        IF BOOL=""

               SET APCLER=16

               GOTO X9

 +4        SET DATE=$PIECE(DATE," ",2,15)

 +5        IF BOOL="<>"

               SET STDATE=$PIECE(DATE,"-")

               SET EDATE=$PIECE(DATE,"-",2)

               Begin DoDot:1

 +6                SET X=STDATE

                   KILL %DT

                   DO ^%DT

                   SET STDATE=Y

                   IF Y=-1

                       SET YRLER=17

                       GOTO X10

 +7                IF EDATE=""

                       IF $EXTRACT(STDATE,6,7)'="00"

                           SET APCLER=17

                           GOTO X10

 +8                IF EDATE=""

                       SET EDATE=STDATE

 +9               IF '$TEST

                       SET X=EDATE

                       KILL %DT

                       DO ^%DT

                       SET EDATE=Y

                       IF Y=-1

                           SET YRLER=17

                           GOTO X10

 +10               IF $EXTRACT(STDATE,6,7)="00"!($EXTRACT(EDATE,6,7)="00")

                       FOR X="STDATE","EDATE"

                           DO DATECHG

X10                QUIT 

               End DoDot:1

               IF 1

 +1       IF '$TEST

               SET X=DATE

               IF BOOL="="

                   SET %DT="X"

               DO ^%DT

               KILL %DT

               SET DATE=Y

               Begin DoDot:1

 +2                IF Y=-1

                       QUIT 

 +3                IF $EXTRACT(DATE,6,7)="00"

                       SET X="DATE"

                       DO DATECHG

               End DoDot:1

               IF Y=-1

                   SET APCLER=17

X9         QUIT 

 +1       ;

DATECHG   ; Change dates to usuable form if user just enters date with year

 +1       ; or month and year only

 +2        IF X="STDATE"

               Begin DoDot:1

 +3                SET STDATE=$SELECT($EXTRACT(STDATE,4,5)="00":$EXTRACT(STDATE,1,3)_"0101",1:$EXTRACT(STDATE,1,5)_"01")

               End DoDot:1

               GOTO X11

 +4        IF X="EDATE"

               Begin DoDot:1

 +5                SET EDATE=$SELECT($EXTRACT(EDATE,4,5)="00":$EXTRACT(EDATE,1,3)_1231,1:$EXTRACT(EDATE,1,5)_31)

               End DoDot:1

               GOTO X11

 +6       IF '$TEST

               Begin DoDot:1

 +7                IF BOOL=">"

                       SET DATE=$SELECT($EXTRACT(DATE,4,5)="00":$EXTRACT(DATE,1,3)_1231,1:$EXTRACT(DATE,1,5)_31)

 +8               IF '$TEST

                       SET DATE=$SELECT($EXTRACT(DATE,4,5)="00":$EXTRACT(DATE,1,3)_"0101",1:$EXTRACT(DATE,1,5)_"01")

               End DoDot:1

X11        QUIT 

 +1       ;

PROCESS   ;  - ENTRY POINT from APCLDF - Get values and/or create tax vals

 +1        IF TYPE="VISIT"

               DO VISIT^APCLDF3

               GOTO X8

 +2        IF VAL="*"

               Begin DoDot:1

 +3                SET APCLTX=""

 +4                IF COND'="LAST"

                       SET VAL=0

                       FOR 

                           SET VAL=$ORDER(^TMP("APCLTAX",$JOB,VAL))

                           IF 'VAL

                               QUIT 

                           DO @(TYPE_"^APCLDF2")

                           IF 'VAL

                               QUIT 

                           Begin DoDot:2

 +5                            IF '$DATA(APCLER)

                                   DO RESULTS^APCLDF2

                           End DoDot:2

                           IF 1

 +6               IF '$TEST

                       SET VAL=""

                       DO @(TYPE_"^APCLDF2")

                       Begin DoDot:2

 +7                        IF '$DATA(APCLER)

                               DO RESULTS^APCLDF2

                       End DoDot:2

               End DoDot:1

               GOTO X8

 +8        IF $EXTRACT(VAL)'="["

               Begin DoDot:1

 +9                DO @(TYPE_"^APCLDF2")

               End DoDot:1

 +10      IF '$TEST

               Begin DoDot:1

 +11               IF TAX="LAB TAX"

                       DO LABTAX

                       GOTO X8

 +12               SET X=TAX

                   SET DIC="^AMQQ(5,"

                   SET DIC(0)="FM"

                   SET DIC("S")="I $P(^(0),U,14)"

                   DO ^DIC

                   KILL DIC

 +13               IF Y=-1

                       SET APCLER=7

 +14              IF '$TEST

                       Begin DoDot:2

 +15                       SET AMQQLINK=$PIECE(^AMQQ(5,+Y,0),U,5)

                           SET AMQQTAXT=$PIECE(^(0),U,14)

                           SET AMQQTGBL=U_$PIECE($PIECE(^(0),U,18),"(")

                           SET APCLTX=""

 +16                       SET X=VAL

                           SET AMQQGTX="^TMP(""APCLTAX"","_$JOB_","

                           IF $DATA(APCLINT)

                               SET AMQQECHO=""

                           DO EN1^AMQQGTX

                           Begin DoDot:3

 +17                           IF '$DATA(^TMP("APCLTAX",$JOB))

                                   SET APCLER=10

                                   QUIT 

 +18      ;I COND'="LAST" D @(TYPE_"^APCLDF2") I 1

 +19                           IF COND'="LAST"

                                   SET VAL=0

                                   FOR 

                                       SET VAL=$ORDER(^TMP("APCLTAX",$JOB,VAL))

                                       IF 'VAL

                                           QUIT 

                                       DO @(TYPE_"^APCLDF2")

                                       IF 'VAL

                                           QUIT 

                                       Begin DoDot:4

 +20                                       IF '$DATA(APCLER)

                                               DO RESULTS^APCLDF2

                                       End DoDot:4

                                       IF 1

 +21                          IF '$TEST

                                   SET VAL=""

                                   DO @(TYPE_"^APCLDF2")

                           End DoDot:3

 +22                       IF '$DATA(APCLER)

                               DO RESULTS^APCLDF2

                       End DoDot:2

               End DoDot:1

X8         QUIT 

 +1       ;

LABTAX    ;resolve lab taxonomy and store in ^TMP("APCLTAX",$J,lab ien,site/spec ien)=""

 +1        NEW LABTAX,X

 +2        SET APCLTX=""

 +3        SET X=$EXTRACT(VAL,2,99999999)

           SET DIC="^ATXLAB("

           SET DIC(0)="FM"

           DO ^DIC

           KILL DIC

 +4        IF Y=-1

               SET APCLER=7

               QUIT 

 +5        SET LABTAX=+Y

 +6        SET X=0

           FOR 

               SET X=$ORDER(^ATXLAB(LABTAX,21,X))

               IF X'=+X

                   QUIT 

               SET ^TMP("APCLTAX",$JOB,$PIECE(^ATXLAB(LABTAX,21,X,0),U))=""

               SET Y=0

               FOR 

                   SET Y=$ORDER(^ATXLAB(LABTAX,21,X,11,Y))

                   IF Y'=+Y

                       QUIT 

                   Begin DoDot:1

 +7       ;DON'T DO THIS SITE/SPECIMEN CHECK IHS/CMI/LAB

                       QUIT 

 +8                    SET Z=$PIECE(^ATXLAB(LABTAX,21,X,0),U)

                       SET T=$PIECE(^ATXLAB(LABTAX,21,X,11,Y,0),U)

 +9                    SET ^TMP("APCLTAX",$JOB,Z,T)=""

 +10                   QUIT 

                   End DoDot:1

 +11       IF '$DATA(^TMP("APCLTAX",$JOB))

               SET APCLER=10

               QUIT 

 +12       IF COND'="LAST"

               SET VAL=0

               FOR 

                   SET VAL=$ORDER(^TMP("APCLTAX",$JOB,VAL))

                   IF 'VAL

                       QUIT 

                   DO @(TYPE_"^APCLDF2")

                   IF 'VAL

                       QUIT 

                   Begin DoDot:1

 +13                   IF '$DATA(APCLER)

                           DO RESULTS^APCLDF2

                   End DoDot:1

                   IF 1

 +14      IF '$TEST

               SET VAL=""

               DO @(TYPE_"^APCLDF2")

 +15       IF '$DATA(APCLER)

               DO RESULTS^APCLDF2

 +16       KILL LABTAX,X,Y,Z,T

 +17       DO @(TYPE_"^APCLDF2")

           IF 'VAL

               QUIT 

           IF 1

 +18       QUIT