APCLDF3.m

APCLDF3 ; IHS/CMI/LAB -IHS ;

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

DATE ; - ENTRY POINT - from APCLDF2

 I BOOL="=" D EQUAL

 I BOOL=">" D GREATER

 I BOOL="<" D LESSTHAN

 I BOOL="<>" D GREATER,LESSTHAN

 I COND="LAST" D INVDATE

 Q

 ;

EQUAL ; Save nodes equal to visit date

 S %=0 F  S %=$O(^TMP("APCLDF",$J,"TMP",%)) Q:'%  I DATE'=% K ^(%)

 Q

 ;

GREATER ; Kill nodes less than indicated visit date plus 1

 ; e.g., if not "<>", after 1/1/87 kills nodes less than 2870102

 ; if =">", then kills nodes less than 2870101

 NEW TMPDATE

 I BOOL=">" S TMPDATE=DATE_.9999 S %="" F  S %=$O(^TMP("APCLDF",$J,"TMP",%)) Q:'%!(%>TMPDATE)  K ^(%)

 I BOOL="<>" S TMPDATE=STDATE-.0001 S %="" F  S %=$O(^TMP("APCLDF",$J,"TMP",%)) Q:'%!(%>TMPDATE)  K ^(%)

 Q

 ;

LESSTHAN ; Kill nodes greater than indicated visit date minus .0001

 ; e.g., less than 1/1/87 kills nodes greater than 2870100.9999

 S X=$S(BOOL="<>":EDATE+.9999,1:DATE-.0001)

 F  S X=$O(^TMP("APCLDF",$J,"TMP",X)) Q:'X  K ^(X)

 Q

 ;

INVDATE ; If COND is 'LAST', then invert date to have in latest to earliest

 S %="" F  S %=$O(^TMP("APCLDF",$J,"TMP",%)) Q:$E(%)>3!'%  F D=0:0 S D=$O(^TMP("APCLDF",$J,"TMP",%,D)) Q:'D  S ^TMP("APCLDF",$J,"TMP",9999999-%,D)=^(D) K ^TMP("APCLDF",$J,"TMP",%,D)

 Q

 ;

VISIT ; - ENTRY POINT - Evaluate visits

 S N=0

 I COND'="FIRST",DATE="" F D=0:0 S D=$O(^AUPNVSIT("AA",PAT,D)) Q:'D!(N>NUM)  F E=0:0 S E=$O(^(D,E)) Q:'E!(N>NUM)  S N=N+1 I N'>NUM S @(APCLY_N_")")=9999999-$P(D,".")_"^^VISIT^^"_E

 I COND="FIRST"!(DATE]"") S C=0 F D=0:0 S D=$O(^AUPNVSIT("AA",PAT,D)) D:'D DATE:DATE]"",VISRES Q:'D  F E=0:0 S E=$O(^AUPNVSIT("AA",PAT,D,E)) Q:'E  S C=C+1,^TMP("APCLDF",$J,"TMP",9999999-$P(D,"."),C)=9999999-$P(D,".")_"^^VISIT^^"_E

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

 Q

 ;

VISRES ; Finds first n visits or visits as a result of date entered

 N D

 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_")")=^TMP("APCLDF",$J,"TMP",%,D)

 Q

 ;

APCLDF3   ; IHS/CMI/LAB -IHS ;

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

DATE      ; - ENTRY POINT - from APCLDF2

 +1        IF BOOL="="

               DO EQUAL

 +2        IF BOOL=">"

               DO GREATER

 +3        IF BOOL="<"

               DO LESSTHAN

 +4        IF BOOL="<>"

               DO GREATER

               DO LESSTHAN

 +5        IF COND="LAST"

               DO INVDATE

 +6        QUIT 

 +7       ;

EQUAL     ; Save nodes equal to visit date

 +1        SET %=0

           FOR 

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

               IF '%

                   QUIT 

               IF DATE'=%

                   KILL ^(%)

 +2        QUIT 

 +3       ;

GREATER   ; Kill nodes less than indicated visit date plus 1

 +1       ; e.g., if not "<>", after 1/1/87 kills nodes less than 2870102

 +2       ; if =">", then kills nodes less than 2870101

 +3        NEW TMPDATE

 +4        IF BOOL=">"

               SET TMPDATE=DATE_.9999

               SET %=""

               FOR 

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

                   IF '%!(%>TMPDATE)

                       QUIT 

                   KILL ^(%)

 +5        IF BOOL="<>"

               SET TMPDATE=STDATE-.0001

               SET %=""

               FOR 

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

                   IF '%!(%>TMPDATE)

                       QUIT 

                   KILL ^(%)

 +6        QUIT 

 +7       ;

LESSTHAN  ; Kill nodes greater than indicated visit date minus .0001

 +1       ; e.g., less than 1/1/87 kills nodes greater than 2870100.9999

 +2        SET X=$SELECT(BOOL="<>":EDATE+.9999,1:DATE-.0001)

 +3        FOR 

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

               IF 'X

                   QUIT 

               KILL ^(X)

 +4        QUIT 

 +5       ;

INVDATE   ; If COND is 'LAST', then invert date to have in latest to earliest

 +1        SET %=""

           FOR 

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

               IF $EXTRACT(%)>3!'%

                   QUIT 

               FOR D=0:0

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

                   IF 'D

                       QUIT 

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

                   KILL ^TMP("APCLDF",$JOB,"TMP",%,D)

 +2        QUIT 

 +3       ;

VISIT     ; - ENTRY POINT - Evaluate visits

 +1        SET N=0

 +2        IF COND'="FIRST"

               IF DATE=""

                   FOR D=0:0

                       SET D=$ORDER(^AUPNVSIT("AA",PAT,D))

                       IF 'D!(N>NUM)

                           QUIT 

                       FOR E=0:0

                           SET E=$ORDER(^(D,E))

                           IF 'E!(N>NUM)

                               QUIT 

                           SET N=N+1

                           IF N'>NUM

                               SET @(APCLY_N_")")=9999999-$PIECE(D,".")_"^^VISIT^^"_E

 +3        IF COND="FIRST"!(DATE]"")

               SET C=0

               FOR D=0:0

                   SET D=$ORDER(^AUPNVSIT("AA",PAT,D))

                   IF 'D

                       IF DATE]""

                           DO DATE

                       DO VISRES

                   IF 'D

                       QUIT 

                   FOR E=0:0

                       SET E=$ORDER(^AUPNVSIT("AA",PAT,D,E))

                       IF 'E

                           QUIT 

                       SET C=C+1

                       SET ^TMP("APCLDF",$JOB,"TMP",9999999-$PIECE(D,"."),C)=9999999-$PIECE(D,".")_"^^VISIT^^"_E

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

 +5        QUIT 

 +6       ;

VISRES    ; Finds first n visits or visits as a result of date entered

 +1        NEW D

 +2        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

 +3                    SET @(APCLY_I_")")=^TMP("APCLDF",$JOB,"TMP",%,D)

                   End DoDot:1

 +4        QUIT 

 +5       ;