63 lines
4.0 KiB
Mathematica
63 lines
4.0 KiB
Mathematica
ACKQWL1 ;AUG/JLTP-Compile A&SP Capitation Data - CONTINUED ; [ 12/05/95 12:03 PM ]
|
|
;;3.0;QUASAR;;Feb 11, 2000
|
|
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
|
N CPT,DFN,DIE,DR,I,ICD,VAPA,VAERR
|
|
K ^TMP("ACKQWL",$J) D FYSTATS,MONTH,STUFF
|
|
Q
|
|
FYSTATS ;Gather uniques from begin of FY to now to screen against.
|
|
F ACKD=ACKBFY:0 S ACKD=$O(^ACK(509850.6,"B",ACKD)) Q:'ACKD!(ACKD>ACKM) D
|
|
.S ACKV=0 F S ACKV=$O(^ACK(509850.6,"B",ACKD,ACKV)) Q:'ACKV D
|
|
..S ACKV(0)=$G(^ACK(509850.6,ACKV,0)) Q:ACKV(0)=""
|
|
..S DFN=$P(ACKV(0),U,2) Q:'DFN S ACKSTOP=$P($G(^ACK(509850.6,ACKV,2)),U) Q:ACKSTOP=""
|
|
..D ADD^VADPT S ACKZIP=$S(VAPA(6):VAPA(6),1:0)
|
|
..S ^TMP("ACKQWL",$J,"PRE",3,ACKSTOP,ACKZIP,DFN)="" ;UNIQUE VISITS THIS FY PRE THIS MONTH
|
|
..S ICD="" F S ICD=$O(^ACK(509850.6,ACKV,1,"B",ICD)) Q:ICD="" D
|
|
...S ^TMP("ACKQWL",$J,"PRE",1,ACKSTOP,ACKZIP,ICD,DFN)="" ;UNIQUE PTS W/ICD FY PRE THIS MO
|
|
..S CPT="" F S CPT=$O(^ACK(509850.6,ACKV,3,"B",CPT)) Q:CPT="" D
|
|
...S ^TMP("ACKQWL",$J,"PRE",2,ACKSTOP,ACKZIP,CPT,DFN)="" ;UNIQUE PTS W/CPT FY PRE THIS MO
|
|
Q
|
|
MONTH ;Gather stats from selected month.
|
|
F ACKD=ACKM:0 S ACKD=$O(^ACK(509850.6,"B",ACKD)) Q:'ACKD!(ACKD>ACKEM) D
|
|
.S ACKV=0 F S ACKV=$O(^ACK(509850.6,"B",ACKD,ACKV)) Q:'ACKV D
|
|
..S ACKV(0)=$G(^ACK(509850.6,ACKV,0)) Q:ACKV(0)=""
|
|
..S DFN=$P(ACKV(0),U,2) Q:'DFN S ACKSTOP=$P($G(^ACK(509850.6,ACKV,2)),U) Q:ACKSTOP=""
|
|
..D ADD^VADPT S ACKZIP=$S(VAPA(6):VAPA(6),1:0)
|
|
..S ^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP)=$G(^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP))+1
|
|
..S:$P(ACKV(0),U,5) ^TMP("ACKQWL",$J,4,ACKSTOP,ACKZIP)=$G(^TMP("ACKQWL",$J,4,ACKSTOP,ACKZIP))+1
|
|
..S:$P(ACKV(0),U,5) $P(^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP),U,2)=$P(^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP),U,2)+1
|
|
..S:'$D(^TMP("ACKQWL",$J,"PRE",3,ACKSTOP,ACKZIP,DFN)) ^TMP("ACKQWL",$J,"U",3,ACKSTOP,ACKZIP,DFN)=""
|
|
..S ICD="" F S ICD=$O(^ACK(509850.6,ACKV,1,"B",ICD)) Q:ICD="" D
|
|
...S ^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP,ICD)=$G(^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP,ICD))+1
|
|
...S:'$D(^TMP("ACKQWL",$J,"PRE",1,ACKSTOP,ACKZIP,ICD,DFN)) ^TMP("ACKQWL",$J,"U",1,ACKSTOP,ACKZIP,ICD,DFN)=""
|
|
..S CPT="" F S CPT=$O(^ACK(509850.6,ACKV,3,"B",CPT)) Q:CPT="" D
|
|
...S ^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP,CPT)=$G(^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP,CPT))+1
|
|
...S:'$D(^TMP("ACKQWL",$J,"PRE",2,ACKSTOP,ACKZIP,CPT,DFN)) ^TMP("ACKQWL",$J,"U",2,ACKSTOP,ACKZIP,CPT,DFN)=""
|
|
Q
|
|
STUFF ;Stuff data into A&SP WORKLOAD file (#509850.7).
|
|
;First by visit only.
|
|
F ACKSTOP="A","S" S ACKZIP=-1 F S ACKZIP=$O(^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP)) Q:ACKZIP="" D
|
|
.S ACKNV=^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP)
|
|
.S (ACKNU,I)=0 F S I=$O(^TMP("ACKQWL",$J,"U",3,ACKSTOP,ACKZIP,I)) Q:'I S ACKNU=ACKNU+1
|
|
.S ACKCP=+$G(^TMP("ACKQWL",$J,4,ACKSTOP,ACKZIP))
|
|
.S DIE="^ACK(509850.7,",DA=ACKDA,DR="3///"""_ACKZIP_""""
|
|
.S DR(2,509850.73)=".01///"_ACKZIP_";.02////"_ACKCP_";.03////"_ACKNV_";.04////"_ACKNU_";.05////^S X=$S(ACKSTOP=""A"":203,1:204)"
|
|
.D ^DIE K DIE,DA,DR
|
|
;Then by ICD.
|
|
F ACKSTOP="A","S" S ACKZIP=-1 F S ACKZIP=$O(^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP)) Q:ACKZIP="" D
|
|
.S ACKICP=0 F S ACKICP=$O(^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP,ACKICP)) Q:'ACKICP D
|
|
..S ACKICD=$P($G(^ICD9(ACKICP,0)),U)
|
|
..S ACKNV=^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP,ACKICP)
|
|
..S (ACKNU,I)=0 F S I=$O(^TMP("ACKQWL",$J,"U",1,ACKSTOP,ACKZIP,ACKICP,I)) Q:'I S ACKNU=ACKNU+1
|
|
..S DIE="^ACK(509850.7,",DA=ACKDA,DR="1///"""_ACKICD_""""
|
|
..S DR(2,509850.71)=".01///"_ACKICD_";.02////"_ACKNV_";.03////"_ACKNU_";.04////^S X=$S(ACKSTOP=""A"":203,1:204);.05///"_ACKZIP
|
|
..D ^DIE K DIE,DA,DR
|
|
;Then by CPT.
|
|
F ACKSTOP="A","S" S ACKZIP=-1 F S ACKZIP=$O(^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP)) Q:ACKZIP="" D
|
|
.S ACKCPP=0 F S ACKCPP=$O(^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP,ACKCPP)) Q:'ACKCPP D
|
|
..S ACKCPT=$P($G(^ICPT(ACKCPP,0)),U)
|
|
..S ACKNV=^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP,ACKCPP)
|
|
..S (ACKNU,I)=0 F S I=$O(^TMP("ACKQWL",$J,"U",2,ACKSTOP,ACKZIP,ACKCPP,I)) Q:'I S ACKNU=ACKNU+1
|
|
..S DIE="^ACK(509850.7,",DA=ACKDA,DR="2///"""_ACKCPT_""""
|
|
..S DR(2,509850.72)=".01///"_ACKCPT_";.02////"_ACKNV_";.03////"_ACKNU_";.04////^S X=$S(ACKSTOP=""A"":203,1:204);.05///"_ACKZIP
|
|
..D ^DIE K DIE,DA,DR
|