source: FOIAVistA/trunk/r/QUASAR-ACKQ/ACKQWL1.m@ 770

Last change on this file since 770 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.0 KB
Line 
1ACKQWL1 ;AUG/JLTP-Compile A&SP Capitation Data - CONTINUED ; [ 12/05/95 12:03 PM ]
2 ;;3.0;QUASAR;;Feb 11, 2000
3 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
4 N CPT,DFN,DIE,DR,I,ICD,VAPA,VAERR
5 K ^TMP("ACKQWL",$J) D FYSTATS,MONTH,STUFF
6 Q
7FYSTATS ;Gather uniques from begin of FY to now to screen against.
8 F ACKD=ACKBFY:0 S ACKD=$O(^ACK(509850.6,"B",ACKD)) Q:'ACKD!(ACKD>ACKM) D
9 .S ACKV=0 F S ACKV=$O(^ACK(509850.6,"B",ACKD,ACKV)) Q:'ACKV D
10 ..S ACKV(0)=$G(^ACK(509850.6,ACKV,0)) Q:ACKV(0)=""
11 ..S DFN=$P(ACKV(0),U,2) Q:'DFN S ACKSTOP=$P($G(^ACK(509850.6,ACKV,2)),U) Q:ACKSTOP=""
12 ..D ADD^VADPT S ACKZIP=$S(VAPA(6):VAPA(6),1:0)
13 ..S ^TMP("ACKQWL",$J,"PRE",3,ACKSTOP,ACKZIP,DFN)="" ;UNIQUE VISITS THIS FY PRE THIS MONTH
14 ..S ICD="" F S ICD=$O(^ACK(509850.6,ACKV,1,"B",ICD)) Q:ICD="" D
15 ...S ^TMP("ACKQWL",$J,"PRE",1,ACKSTOP,ACKZIP,ICD,DFN)="" ;UNIQUE PTS W/ICD FY PRE THIS MO
16 ..S CPT="" F S CPT=$O(^ACK(509850.6,ACKV,3,"B",CPT)) Q:CPT="" D
17 ...S ^TMP("ACKQWL",$J,"PRE",2,ACKSTOP,ACKZIP,CPT,DFN)="" ;UNIQUE PTS W/CPT FY PRE THIS MO
18 Q
19MONTH ;Gather stats from selected month.
20 F ACKD=ACKM:0 S ACKD=$O(^ACK(509850.6,"B",ACKD)) Q:'ACKD!(ACKD>ACKEM) D
21 .S ACKV=0 F S ACKV=$O(^ACK(509850.6,"B",ACKD,ACKV)) Q:'ACKV D
22 ..S ACKV(0)=$G(^ACK(509850.6,ACKV,0)) Q:ACKV(0)=""
23 ..S DFN=$P(ACKV(0),U,2) Q:'DFN S ACKSTOP=$P($G(^ACK(509850.6,ACKV,2)),U) Q:ACKSTOP=""
24 ..D ADD^VADPT S ACKZIP=$S(VAPA(6):VAPA(6),1:0)
25 ..S ^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP)=$G(^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP))+1
26 ..S:$P(ACKV(0),U,5) ^TMP("ACKQWL",$J,4,ACKSTOP,ACKZIP)=$G(^TMP("ACKQWL",$J,4,ACKSTOP,ACKZIP))+1
27 ..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
28 ..S:'$D(^TMP("ACKQWL",$J,"PRE",3,ACKSTOP,ACKZIP,DFN)) ^TMP("ACKQWL",$J,"U",3,ACKSTOP,ACKZIP,DFN)=""
29 ..S ICD="" F S ICD=$O(^ACK(509850.6,ACKV,1,"B",ICD)) Q:ICD="" D
30 ...S ^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP,ICD)=$G(^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP,ICD))+1
31 ...S:'$D(^TMP("ACKQWL",$J,"PRE",1,ACKSTOP,ACKZIP,ICD,DFN)) ^TMP("ACKQWL",$J,"U",1,ACKSTOP,ACKZIP,ICD,DFN)=""
32 ..S CPT="" F S CPT=$O(^ACK(509850.6,ACKV,3,"B",CPT)) Q:CPT="" D
33 ...S ^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP,CPT)=$G(^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP,CPT))+1
34 ...S:'$D(^TMP("ACKQWL",$J,"PRE",2,ACKSTOP,ACKZIP,CPT,DFN)) ^TMP("ACKQWL",$J,"U",2,ACKSTOP,ACKZIP,CPT,DFN)=""
35 Q
36STUFF ;Stuff data into A&SP WORKLOAD file (#509850.7).
37 ;First by visit only.
38 F ACKSTOP="A","S" S ACKZIP=-1 F S ACKZIP=$O(^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP)) Q:ACKZIP="" D
39 .S ACKNV=^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP)
40 .S (ACKNU,I)=0 F S I=$O(^TMP("ACKQWL",$J,"U",3,ACKSTOP,ACKZIP,I)) Q:'I S ACKNU=ACKNU+1
41 .S ACKCP=+$G(^TMP("ACKQWL",$J,4,ACKSTOP,ACKZIP))
42 .S DIE="^ACK(509850.7,",DA=ACKDA,DR="3///"""_ACKZIP_""""
43 .S DR(2,509850.73)=".01///"_ACKZIP_";.02////"_ACKCP_";.03////"_ACKNV_";.04////"_ACKNU_";.05////^S X=$S(ACKSTOP=""A"":203,1:204)"
44 .D ^DIE K DIE,DA,DR
45 ;Then by ICD.
46 F ACKSTOP="A","S" S ACKZIP=-1 F S ACKZIP=$O(^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP)) Q:ACKZIP="" D
47 .S ACKICP=0 F S ACKICP=$O(^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP,ACKICP)) Q:'ACKICP D
48 ..S ACKICD=$P($G(^ICD9(ACKICP,0)),U)
49 ..S ACKNV=^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP,ACKICP)
50 ..S (ACKNU,I)=0 F S I=$O(^TMP("ACKQWL",$J,"U",1,ACKSTOP,ACKZIP,ACKICP,I)) Q:'I S ACKNU=ACKNU+1
51 ..S DIE="^ACK(509850.7,",DA=ACKDA,DR="1///"""_ACKICD_""""
52 ..S DR(2,509850.71)=".01///"_ACKICD_";.02////"_ACKNV_";.03////"_ACKNU_";.04////^S X=$S(ACKSTOP=""A"":203,1:204);.05///"_ACKZIP
53 ..D ^DIE K DIE,DA,DR
54 ;Then by CPT.
55 F ACKSTOP="A","S" S ACKZIP=-1 F S ACKZIP=$O(^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP)) Q:ACKZIP="" D
56 .S ACKCPP=0 F S ACKCPP=$O(^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP,ACKCPP)) Q:'ACKCPP D
57 ..S ACKCPT=$P($G(^ICPT(ACKCPP,0)),U)
58 ..S ACKNV=^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP,ACKCPP)
59 ..S (ACKNU,I)=0 F S I=$O(^TMP("ACKQWL",$J,"U",2,ACKSTOP,ACKZIP,ACKCPP,I)) Q:'I S ACKNU=ACKNU+1
60 ..S DIE="^ACK(509850.7,",DA=ACKDA,DR="2///"""_ACKCPT_""""
61 ..S DR(2,509850.72)=".01///"_ACKCPT_";.02////"_ACKNV_";.03////"_ACKNU_";.04////^S X=$S(ACKSTOP=""A"":203,1:204);.05///"_ACKZIP
62 ..D ^DIE K DIE,DA,DR
Note: See TracBrowser for help on using the repository browser.