- 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 ;
