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

ACKQWLD.m

Go to the documentation of this file.
  1. ACKQWLD ;AUG/JLTP BIR/PTD-Print A&SP Capitation Report ; [ 03/28/96 10:45 AM ]
  1. ;;3.0;QUASAR;;Feb 11, 2000
  1. ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
  1. OPTN ;Introduce option.
  1. W @IOF,!,"This option produces a four-part capitation report.",!,"It includes demographic, diagnostic, procedure, and CDR data.",!
  1. D GETDT^ACKQWL G:$D(DIRUT) EXIT D INIT^ACKQWL
  1. DEV W !!,"The right margin for this report is 80.",!,"You can queue it to run at a later time.",!
  1. K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G EXIT
  1. I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^ACKQWLD",ZTDESC="QUASAR - Print A&SP Capitation Report",ZTSAVE("ACK*")="" D ^%ZTLOAD D HOME^%ZIS K ZTSK G EXIT
  1. DQ ;Entry point when queued.
  1. U IO
  1. D NOW^%DTC S ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%),ACKPG=0 K ^TMP("ACKQWLD",$J)
  1. D COMPILE,PRINT
  1. EXIT ;ALWAYS EXIT HERE
  1. K %I,ACKBFY,ACKCDT,ACKDA,ACKEM,ACKM,ACKPG,AS,CDR,CPT,DIR,DIRUT,DTOUT,DUOUT,I,ICD,LN,T,X,XAS,Y,ZIP,^TMP("ACKQWLD",$J)
  1. W:$E(IOST)'="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
  1. Q
  1. ;
  1. COMPILE ;Compile properly sorted data in ^TMP global.
  1. N AS,CPT,ICD,XAS,ZIP
  1. ;For all visits.
  1. S I=0 F S I=$O(^ACK(509850.7,ACKDA,3,I)) Q:'I D
  1. .S X=^ACK(509850.7,ACKDA,3,I,0)
  1. .S ^TMP("ACKQWLD",$J,1,$P(X,U,5),$P(X,U))=$P(X,U,2,4)
  1. .Q
  1. ;For ICD statistics.
  1. S I=0 F S I=$O(^ACK(509850.7,ACKDA,1,I)) Q:'I D
  1. .S X=^ACK(509850.7,ACKDA,1,I,0)
  1. .S ^TMP("ACKQWLD",$J,2,$P(X,U,4),$P(X,U),$P(X,U,5))=$P(X,U,2,3)
  1. .Q
  1. ;For CPT statistics.
  1. S I=0 F S I=$O(^ACK(509850.7,ACKDA,2,I)) Q:'I D
  1. .S X=^ACK(509850.7,ACKDA,2,I,0)
  1. .S ^TMP("ACKQWLD",$J,3,$P(X,U,4),+X,$P(X,U,5))=$P(X,U,2,3)
  1. .Q
  1. Q
  1. PRINT ;Print/display results.
  1. D DHD I '$O(^TMP("ACKQWLD",$J,0)) D LINE W !!,"No data found for report specifications." Q
  1. D HD1
  1. ZIP ;For all visits.
  1. S AS=0 F S AS=$O(^TMP("ACKQWLD",$J,1,AS)) Q:'AS!($D(DIRUT)) D
  1. .I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D DHD,HD1
  1. .S XAS=$S(AS=203:"Audiology",1:"Speech")
  1. .W !!,XAS,":"
  1. .S (ZIP,T)="" F S ZIP=$O(^TMP("ACKQWLD",$J,1,AS,ZIP)) Q:ZIP=""!($D(DIRUT)) D
  1. ..I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D DHD,HD1
  1. ..S X=^TMP("ACKQWLD",$J,1,AS,ZIP)
  1. ..W !,ZIP,?20,$J($P(X,U,2),5),?30,$J($P(X,U,3),5),?40,$J($P(X,U),5)
  1. ..S $P(T,U)=T+X,$P(T,U,2)=$P(T,U,2)+$P(X,U,2),$P(T,U,3)=$P(T,U,3)+$P(X,U,3)
  1. .Q:$D(DIRUT)
  1. .S $P(LN,"-",48)="" W !,LN
  1. .W !,XAS," Total: ",?20,$J($P(T,U,2),5),?30,$J($P(T,U,3),5),?40,$J(+T,5)
  1. Q:$D(DIRUT)
  1. ICD ;For ICD statistics.
  1. D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D DHD,HD2
  1. S AS=0 F S AS=$O(^TMP("ACKQWLD",$J,2,AS)) Q:'AS!($D(DIRUT)) D
  1. .I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D DHD,HD2
  1. .S XAS=$S(AS=203:"Audiology",1:"Speech")
  1. .W !!,XAS,":"
  1. .S ICD="" F S ICD=$O(^TMP("ACKQWLD",$J,2,AS,ICD)) Q:ICD=""!($D(DIRUT)) D
  1. ..S (ZIP,X)="" F S ZIP=$O(^TMP("ACKQWLD",$J,2,AS,ICD,ZIP)) Q:ZIP=""!($D(DIRUT)) D
  1. ...I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D DHD,HD2
  1. ...S Y=^TMP("ACKQWLD",$J,2,AS,ICD,ZIP) F I=1,2 S $P(X,U,I)=$P(X,U,I)+$P(Y,U,I)
  1. ..Q:$D(DIRUT)
  1. ..W !,ICD,?20,$J($P(X,U),5),?30,$J($P(X,U,2),5)
  1. .Q:$D(DIRUT)
  1. Q:$D(DIRUT)
  1. CPT ;For CPT statistics.
  1. D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D DHD,HD3
  1. S AS=0 F S AS=$O(^TMP("ACKQWLD",$J,3,AS)) Q:'AS!($D(DIRUT)) D
  1. .I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D DHD,HD3
  1. .S XAS=$S(AS=203:"Audiology",1:"Speech")
  1. .W !!,XAS,":"
  1. .S CPT=0 F S CPT=$O(^TMP("ACKQWLD",$J,3,AS,CPT)) Q:'CPT!($D(DIRUT)) D
  1. ..S (ZIP,X)="" F S ZIP=$O(^TMP("ACKQWLD",$J,3,AS,CPT,ZIP)) Q:ZIP=""!($D(DIRUT)) D
  1. ...I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D DHD,HD3
  1. ...S Y=^TMP("ACKQWLD",$J,3,AS,CPT,ZIP) F I=1,2 S $P(X,U,I)=$P(X,U,I)+$P(Y,U,I)
  1. ..Q:$D(DIRUT)
  1. ..W !,CPT,?20,$J($P(X,U),5),?30,$J($P(X,U,2),5)
  1. .Q:$D(DIRUT)
  1. Q:$D(DIRUT)
  1. CDR ;For CDR information.
  1. D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D DHD,HD4
  1. S (CDR,T)=0 F S CDR=$O(^ACK(509850.7,ACKDA,4,CDR)) Q:'CDR!($D(DIRUT)) D
  1. .I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D DHD,HD4
  1. .S X=^ACK(509850.7,ACKDA,4,CDR,0)
  1. .S Y=$O(^ACK(509850,"B",$P(X,U),0))
  1. .S Y=$P($G(^ACK(509850,+Y,0)),U,2)
  1. .W !,$P(X,U),?10,Y,?60,$J($P(X,U,2),6,2)
  1. .S T=T+$P(X,U,2)
  1. Q:$D(DIRUT)
  1. W !,"Total:",?60,$J(T,6,2),!!
  1. Q
  1. DHD ;
  1. N X
  1. S ACKPG=ACKPG+1 W @IOF,"Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
  1. F X="Audiology & Speech Pathology","Capitation Report","for",$$XDAT^ACKQUTL(ACKM) W ! D CNTR^ACKQUTL(X)
  1. W ! Q
  1. HD1 ;Header for all visits.
  1. N X
  1. W !,"ZIP CODE",?21,"VISITS",?31,"UNIQUE",?42,"C&P"
  1. D LINE
  1. Q
  1. HD2 ;Header for ICD statistics.
  1. N X
  1. W !,"ICD",?21,"VISITS",?31,"UNIQUE"
  1. D LINE
  1. Q
  1. HD3 ;Header for CPT statistics.
  1. N X
  1. W !,"CPT",?21,"VISITS",?31,"UNIQUE"
  1. D LINE
  1. Q
  1. HD4 ;Header for CDR statistics.
  1. N X
  1. W !,"CDR ACCOUNT",?58,"% WORKLOAD"
  1. D LINE
  1. Q
  1. LINE S X="",$P(X,"-",IOM)="-" W !,X Q