Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACKQWL1

ACKQWL1.m

Go to the documentation of this file.
  1. ACKQWL1 ;AUG/JLTP - Compile A&SP Capitation Data - CONTINUED ;30 Jan 2013 3:15 PM
  1. ;;3.0;QUASAR;**21**;;Build 40
  1. ;
  1. ; Reference/IA
  1. ; $$CODEC^ICDEX - 5747
  1. ;
  1. N CPT,DFN,DIE,DR,I,ICD,VAPA,VAERR
  1. K ^TMP("ACKQWL",$J) D FYSTATS,MONTH,STUFF
  1. Q
  1. FYSTATS ;Gather uniques from begin of FY to now to screen against.
  1. F ACKD=ACKBFY:0 S ACKD=$O(^ACK(509850.6,"B",ACKD)) Q:'ACKD!(ACKD>ACKM) D
  1. .S ACKV=0 F S ACKV=$O(^ACK(509850.6,"B",ACKD,ACKV)) Q:'ACKV D
  1. ..S ACKV(0)=$G(^ACK(509850.6,ACKV,0)) Q:ACKV(0)=""
  1. ..S DFN=$P(ACKV(0),U,2) Q:'DFN S ACKSTOP=$P($G(^ACK(509850.6,ACKV,2)),U) Q:ACKSTOP=""
  1. ..D ADD^VADPT S ACKZIP=$S(VAPA(6):VAPA(6),1:0)
  1. ..S ^TMP("ACKQWL",$J,"PRE",3,ACKSTOP,ACKZIP,DFN)="" ;UNIQUE VISITS THIS FY PRE THIS MONTH
  1. ..S ICD="" F S ICD=$O(^ACK(509850.6,ACKV,1,"B",ICD)) Q:ICD="" D
  1. ...S ^TMP("ACKQWL",$J,"PRE",1,ACKSTOP,ACKZIP,ICD,DFN)="" ;UNIQUE PTS W/ICD FY PRE THIS MO
  1. ..S CPT="" F S CPT=$O(^ACK(509850.6,ACKV,3,"B",CPT)) Q:CPT="" D
  1. ...S ^TMP("ACKQWL",$J,"PRE",2,ACKSTOP,ACKZIP,CPT,DFN)="" ;UNIQUE PTS W/CPT FY PRE THIS MO
  1. Q
  1. MONTH ;Gather stats from selected month.
  1. F ACKD=ACKM:0 S ACKD=$O(^ACK(509850.6,"B",ACKD)) Q:'ACKD!(ACKD>ACKEM) D
  1. .S ACKV=0 F S ACKV=$O(^ACK(509850.6,"B",ACKD,ACKV)) Q:'ACKV D
  1. ..S ACKV(0)=$G(^ACK(509850.6,ACKV,0)) Q:ACKV(0)=""
  1. ..S DFN=$P(ACKV(0),U,2) Q:'DFN S ACKSTOP=$P($G(^ACK(509850.6,ACKV,2)),U) Q:ACKSTOP=""
  1. ..D ADD^VADPT S ACKZIP=$S(VAPA(6):VAPA(6),1:0)
  1. ..S ^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP)=$G(^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP))+1
  1. ..S:$P(ACKV(0),U,5) ^TMP("ACKQWL",$J,4,ACKSTOP,ACKZIP)=$G(^TMP("ACKQWL",$J,4,ACKSTOP,ACKZIP))+1
  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
  1. ..S:'$D(^TMP("ACKQWL",$J,"PRE",3,ACKSTOP,ACKZIP,DFN)) ^TMP("ACKQWL",$J,"U",3,ACKSTOP,ACKZIP,DFN)=""
  1. ..S ICD="" F S ICD=$O(^ACK(509850.6,ACKV,1,"B",ICD)) Q:ICD="" D
  1. ...S ^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP,ICD)=$G(^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP,ICD))+1
  1. ...S:'$D(^TMP("ACKQWL",$J,"PRE",1,ACKSTOP,ACKZIP,ICD,DFN)) ^TMP("ACKQWL",$J,"U",1,ACKSTOP,ACKZIP,ICD,DFN)=""
  1. ..S CPT="" F S CPT=$O(^ACK(509850.6,ACKV,3,"B",CPT)) Q:CPT="" D
  1. ...S ^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP,CPT)=$G(^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP,CPT))+1
  1. ...S:'$D(^TMP("ACKQWL",$J,"PRE",2,ACKSTOP,ACKZIP,CPT,DFN)) ^TMP("ACKQWL",$J,"U",2,ACKSTOP,ACKZIP,CPT,DFN)=""
  1. Q
  1. STUFF ;Stuff data into A&SP WORKLOAD file (#509850.7).
  1. ;First by visit only.
  1. F ACKSTOP="A","S" S ACKZIP=-1 F S ACKZIP=$O(^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP)) Q:ACKZIP="" D
  1. .S ACKNV=^TMP("ACKQWL",$J,3,ACKSTOP,ACKZIP)
  1. .S (ACKNU,I)=0 F S I=$O(^TMP("ACKQWL",$J,"U",3,ACKSTOP,ACKZIP,I)) Q:'I S ACKNU=ACKNU+1
  1. .S ACKCP=+$G(^TMP("ACKQWL",$J,4,ACKSTOP,ACKZIP))
  1. .S DIE="^ACK(509850.7,",DA=ACKDA,DR="3///"""_ACKZIP_""""
  1. .S DR(2,509850.73)=".01///"_ACKZIP_";.02////"_ACKCP_";.03////"_ACKNV_";.04////"_ACKNU_";.05////^S X=$S(ACKSTOP=""A"":203,1:204)"
  1. .D ^DIE K DIE,DA,DR
  1. ;Then by ICD.
  1. F ACKSTOP="A","S" S ACKZIP=-1 F S ACKZIP=$O(^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP)) Q:ACKZIP="" D
  1. .S ACKICP=0 F S ACKICP=$O(^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP,ACKICP)) Q:'ACKICP D
  1. ..S ACKICD=$$CODEC^ICDEX(80,ACKICP)
  1. ..S ACKNV=^TMP("ACKQWL",$J,1,ACKSTOP,ACKZIP,ACKICP)
  1. ..S (ACKNU,I)=0 F S I=$O(^TMP("ACKQWL",$J,"U",1,ACKSTOP,ACKZIP,ACKICP,I)) Q:'I S ACKNU=ACKNU+1
  1. ..S DIE="^ACK(509850.7,",DA=ACKDA,DR="1///"""_ACKICD_""""
  1. ..S DR(2,509850.71)=".01///"_ACKICD_";.02////"_ACKNV_";.03////"_ACKNU_";.04////^S X=$S(ACKSTOP=""A"":203,1:204);.05///"_ACKZIP
  1. ..D ^DIE K DIE,DA,DR
  1. ;Then by CPT.
  1. F ACKSTOP="A","S" S ACKZIP=-1 F S ACKZIP=$O(^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP)) Q:ACKZIP="" D
  1. .S ACKCPP=0 F S ACKCPP=$O(^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP,ACKCPP)) Q:'ACKCPP D
  1. ..S ACKCPT=$P($G(^ICPT(ACKCPP,0)),U)
  1. ..S ACKNV=^TMP("ACKQWL",$J,2,ACKSTOP,ACKZIP,ACKCPP)
  1. ..S (ACKNU,I)=0 F S I=$O(^TMP("ACKQWL",$J,"U",2,ACKSTOP,ACKZIP,ACKCPP,I)) Q:'I S ACKNU=ACKNU+1
  1. ..S DIE="^ACK(509850.7,",DA=ACKDA,DR="2///"""_ACKCPT_""""
  1. ..S DR(2,509850.72)=".01///"_ACKCPT_";.02////"_ACKNV_";.03////"_ACKNU_";.04////^S X=$S(ACKSTOP=""A"":203,1:204);.05///"_ACKZIP
  1. ..D ^DIE K DIE,DA,DR