- ACKQWL1 ;AUG/JLTP - Compile A&SP Capitation Data - CONTINUED ;30 Jan 2013 3:15 PM
- ;;3.0;QUASAR;**21**;;Build 40
- ;
- ; Reference/IA
- ; $$CODEC^ICDEX - 5747
- ;
- 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=$$CODEC^ICDEX(80,ACKICP)
- ..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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQWL1 4162 printed Feb 18, 2025@23:59:31 Page 2
- ACKQWL1 ;AUG/JLTP - Compile A&SP Capitation Data - CONTINUED ;30 Jan 2013 3:15 PM
- +1 ;;3.0;QUASAR;**21**;;Build 40
- +2 ;
- +3 ; Reference/IA
- +4 ; $$CODEC^ICDEX - 5747
- +5 ;
- +6 NEW CPT,DFN,DIE,DR,I,ICD,VAPA,VAERR
- +7 KILL ^TMP("ACKQWL",$JOB)
- DO FYSTATS
- DO MONTH
- DO STUFF
- +8 QUIT
- FYSTATS ;Gather uniques from begin of FY to now to screen against.
- +1 FOR ACKD=ACKBFY:0
- SET ACKD=$ORDER(^ACK(509850.6,"B",ACKD))
- if 'ACKD!(ACKD>ACKM)
- QUIT
- Begin DoDot:1
- +2 SET ACKV=0
- FOR
- SET ACKV=$ORDER(^ACK(509850.6,"B",ACKD,ACKV))
- if 'ACKV
- QUIT
- Begin DoDot:2
- +3 SET ACKV(0)=$GET(^ACK(509850.6,ACKV,0))
- if ACKV(0)=""
- QUIT
- +4 SET DFN=$PIECE(ACKV(0),U,2)
- if 'DFN
- QUIT
- SET ACKSTOP=$PIECE($GET(^ACK(509850.6,ACKV,2)),U)
- if ACKSTOP=""
- QUIT
- +5 DO ADD^VADPT
- SET ACKZIP=$SELECT(VAPA(6):VAPA(6),1:0)
- +6 ;UNIQUE VISITS THIS FY PRE THIS MONTH
- SET ^TMP("ACKQWL",$JOB,"PRE",3,ACKSTOP,ACKZIP,DFN)=""
- +7 SET ICD=""
- FOR
- SET ICD=$ORDER(^ACK(509850.6,ACKV,1,"B",ICD))
- if ICD=""
- QUIT
- Begin DoDot:3
- +8 ;UNIQUE PTS W/ICD FY PRE THIS MO
- SET ^TMP("ACKQWL",$JOB,"PRE",1,ACKSTOP,ACKZIP,ICD,DFN)=""
- End DoDot:3
- +9 SET CPT=""
- FOR
- SET CPT=$ORDER(^ACK(509850.6,ACKV,3,"B",CPT))
- if CPT=""
- QUIT
- Begin DoDot:3
- +10 ;UNIQUE PTS W/CPT FY PRE THIS MO
- SET ^TMP("ACKQWL",$JOB,"PRE",2,ACKSTOP,ACKZIP,CPT,DFN)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 QUIT
- MONTH ;Gather stats from selected month.
- +1 FOR ACKD=ACKM:0
- SET ACKD=$ORDER(^ACK(509850.6,"B",ACKD))
- if 'ACKD!(ACKD>ACKEM)
- QUIT
- Begin DoDot:1
- +2 SET ACKV=0
- FOR
- SET ACKV=$ORDER(^ACK(509850.6,"B",ACKD,ACKV))
- if 'ACKV
- QUIT
- Begin DoDot:2
- +3 SET ACKV(0)=$GET(^ACK(509850.6,ACKV,0))
- if ACKV(0)=""
- QUIT
- +4 SET DFN=$PIECE(ACKV(0),U,2)
- if 'DFN
- QUIT
- SET ACKSTOP=$PIECE($GET(^ACK(509850.6,ACKV,2)),U)
- if ACKSTOP=""
- QUIT
- +5 DO ADD^VADPT
- SET ACKZIP=$SELECT(VAPA(6):VAPA(6),1:0)
- +6 SET ^TMP("ACKQWL",$JOB,3,ACKSTOP,ACKZIP)=$GET(^TMP("ACKQWL",$JOB,3,ACKSTOP,ACKZIP))+1
- +7 if $PIECE(ACKV(0),U,5)
- SET ^TMP("ACKQWL",$JOB,4,ACKSTOP,ACKZIP)=$GET(^TMP("ACKQWL",$JOB,4,ACKSTOP,ACKZIP))+1
- +8 if $PIECE(ACKV(0),U,5)
- SET $PIECE(^TMP("ACKQWL",$JOB,3,ACKSTOP,ACKZIP),U,2)=$PIECE(^TMP("ACKQWL",$JOB,3,ACKSTOP,ACKZIP),U,2)+1
- +9 if '$DATA(^TMP("ACKQWL",$JOB,"PRE",3,ACKSTOP,ACKZIP,DFN))
- SET ^TMP("ACKQWL",$JOB,"U",3,ACKSTOP,ACKZIP,DFN)=""
- +10 SET ICD=""
- FOR
- SET ICD=$ORDER(^ACK(509850.6,ACKV,1,"B",ICD))
- if ICD=""
- QUIT
- Begin DoDot:3
- +11 SET ^TMP("ACKQWL",$JOB,1,ACKSTOP,ACKZIP,ICD)=$GET(^TMP("ACKQWL",$JOB,1,ACKSTOP,ACKZIP,ICD))+1
- +12 if '$DATA(^TMP("ACKQWL",$JOB,"PRE",1,ACKSTOP,ACKZIP,ICD,DFN))
- SET ^TMP("ACKQWL",$JOB,"U",1,ACKSTOP,ACKZIP,ICD,DFN)=""
- End DoDot:3
- +13 SET CPT=""
- FOR
- SET CPT=$ORDER(^ACK(509850.6,ACKV,3,"B",CPT))
- if CPT=""
- QUIT
- Begin DoDot:3
- +14 SET ^TMP("ACKQWL",$JOB,2,ACKSTOP,ACKZIP,CPT)=$GET(^TMP("ACKQWL",$JOB,2,ACKSTOP,ACKZIP,CPT))+1
- +15 if '$DATA(^TMP("ACKQWL",$JOB,"PRE",2,ACKSTOP,ACKZIP,CPT,DFN))
- SET ^TMP("ACKQWL",$JOB,"U",2,ACKSTOP,ACKZIP,CPT,DFN)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 QUIT
- STUFF ;Stuff data into A&SP WORKLOAD file (#509850.7).
- +1 ;First by visit only.
- +2 FOR ACKSTOP="A","S"
- SET ACKZIP=-1
- FOR
- SET ACKZIP=$ORDER(^TMP("ACKQWL",$JOB,3,ACKSTOP,ACKZIP))
- if ACKZIP=""
- QUIT
- Begin DoDot:1
- +3 SET ACKNV=^TMP("ACKQWL",$JOB,3,ACKSTOP,ACKZIP)
- +4 SET (ACKNU,I)=0
- FOR
- SET I=$ORDER(^TMP("ACKQWL",$JOB,"U",3,ACKSTOP,ACKZIP,I))
- if 'I
- QUIT
- SET ACKNU=ACKNU+1
- +5 SET ACKCP=+$GET(^TMP("ACKQWL",$JOB,4,ACKSTOP,ACKZIP))
- +6 SET DIE="^ACK(509850.7,"
- SET DA=ACKDA
- SET DR="3///"""_ACKZIP_""""
- +7 SET DR(2,509850.73)=".01///"_ACKZIP_";.02////"_ACKCP_";.03////"_ACKNV_";.04////"_ACKNU_";.05////^S X=$S(ACKSTOP=""A"":203,1:204)"
- +8 DO ^DIE
- KILL DIE,DA,DR
- End DoDot:1
- +9 ;Then by ICD.
- +10 FOR ACKSTOP="A","S"
- SET ACKZIP=-1
- FOR
- SET ACKZIP=$ORDER(^TMP("ACKQWL",$JOB,1,ACKSTOP,ACKZIP))
- if ACKZIP=""
- QUIT
- Begin DoDot:1
- +11 SET ACKICP=0
- FOR
- SET ACKICP=$ORDER(^TMP("ACKQWL",$JOB,1,ACKSTOP,ACKZIP,ACKICP))
- if 'ACKICP
- QUIT
- Begin DoDot:2
- +12 SET ACKICD=$$CODEC^ICDEX(80,ACKICP)
- +13 SET ACKNV=^TMP("ACKQWL",$JOB,1,ACKSTOP,ACKZIP,ACKICP)
- +14 SET (ACKNU,I)=0
- FOR
- SET I=$ORDER(^TMP("ACKQWL",$JOB,"U",1,ACKSTOP,ACKZIP,ACKICP,I))
- if 'I
- QUIT
- SET ACKNU=ACKNU+1
- +15 SET DIE="^ACK(509850.7,"
- SET DA=ACKDA
- SET DR="1///"""_ACKICD_""""
- +16 SET DR(2,509850.71)=".01///"_ACKICD_";.02////"_ACKNV_";.03////"_ACKNU_";.04////^S X=$S(ACKSTOP=""A"":203,1:204);.05///"_ACKZIP
- +17 DO ^DIE
- KILL DIE,DA,DR
- End DoDot:2
- End DoDot:1
- +18 ;Then by CPT.
- +19 FOR ACKSTOP="A","S"
- SET ACKZIP=-1
- FOR
- SET ACKZIP=$ORDER(^TMP("ACKQWL",$JOB,2,ACKSTOP,ACKZIP))
- if ACKZIP=""
- QUIT
- Begin DoDot:1
- +20 SET ACKCPP=0
- FOR
- SET ACKCPP=$ORDER(^TMP("ACKQWL",$JOB,2,ACKSTOP,ACKZIP,ACKCPP))
- if 'ACKCPP
- QUIT
- Begin DoDot:2
- +21 SET ACKCPT=$PIECE($GET(^ICPT(ACKCPP,0)),U)
- +22 SET ACKNV=^TMP("ACKQWL",$JOB,2,ACKSTOP,ACKZIP,ACKCPP)
- +23 SET (ACKNU,I)=0
- FOR
- SET I=$ORDER(^TMP("ACKQWL",$JOB,"U",2,ACKSTOP,ACKZIP,ACKCPP,I))
- if 'I
- QUIT
- SET ACKNU=ACKNU+1
- +24 SET DIE="^ACK(509850.7,"
- SET DA=ACKDA
- SET DR="2///"""_ACKCPT_""""
- +25 SET DR(2,509850.72)=".01///"_ACKCPT_";.02////"_ACKNV_";.03////"_ACKNU_";.04////^S X=$S(ACKSTOP=""A"":203,1:204);.05///"_ACKZIP
- +26 DO ^DIE
- KILL DIE,DA,DR
- End DoDot:2
- End DoDot:1