ABMRPVET ; IHS/SD/SDR - Vet w/Visit in Date Range Listing ;
;;2.6;IHS 3P BILLING SYSTEM;**12,21**;NOV 12, 2009;Build 379
;Original;SDR;
;IHS/SD/SDR - 2.6*21 - HEAT134720 - added total by visit location and how many registered patients for each
; visit location
;
K ABM,ABMY
S ABM("RTYP","NM")="Vets with Visits Report"
S ABM("PG")=0
;
SEL ;EP
D DTYP
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT)
S ABM("HD",0)="VET LISTING of VISITS"
S ABM("HD",1)="For VISIT DATES: "_$$SDT^ABMDUTL(ABMY("DT",1))_" thru "_$$SDT^ABMDUTL(ABMY("DT",2))
S $P(ABMLINE,"=",80)=""
S ABMQ("RC")="COMPUTE^ABMRPVET"
S ABMQ("RX")="POUT^ABMDRUTL"
S ABMQ("NS")="ABM"
S ABMQ("RP")="PRINT^ABMRPVET"
D ^ABMDRDBQ
Q
DTYP ;
W !!," ============ Entry of VISIT DATE Range =============",!
S DIR("A")="Enter STARTING VISIT DATE for the Report"
S DIR(0)="DO^::EP"
D ^DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(DIRUT)
S ABMY("DT",1)=Y
W !
S DIR("A")="Enter ENDING DATE for the Report"
D ^DIR
K DIR
G DTYP:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABMY("DT",2)=Y
I ABMY("DT",1)>ABMY("DT",2) W !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!! G DTYP
Q
COMPUTE ;EP - Entry Point for Setting up Data
S ABM("SUBR")="ABM-VET"
K ^TMP($J,"ABM-VET")
DATA ;EP
S ABMSTART=ABMY("DT",1)-.5
S ABMEND=ABMY("DT",2)+.999999
F S ABMSTART=$O(^AUPNVSIT("B",ABMSTART)) Q:'ABMSTART!(ABMSTART>ABMEND) D
.S ABMVIEN=0
.F S ABMVIEN=$O(^AUPNVSIT("B",ABMSTART,ABMVIEN)) Q:'ABMVIEN D
..S ABMPT=$$GET1^DIQ(9000010,ABMVIEN,".05","I")
..I $$GET1^DIQ(2,ABMPT,1901,"I")'="Y" Q ;not a Vet
..S ^TMP($J,"ABM-VET",ABMPT)=+$G(^TMP($J,"ABM-VET",ABMPT))+1 ;visit count
..S ABMNAME=$$GET1^DIQ(2,ABMPT,".01","E")
..S ^TMP($J,"ABM-VET","S",ABMNAME)=ABMPT
..;start new abm*2.6*21 IHS/SD/SDR HEAT134720
..S ABMVLOC=$$GET1^DIQ(9000010,ABMVIEN,".06","I")
..S ^TMP($J,"ABM-VET","VTOT",ABMVLOC)=+$G(^TMP($J,"ABM-VET","VTOT",ABMVLOC))+1 ;count visits by site
..Q:+$G(^TMP($J,"ABM-VET","UNQ PTS",ABMVLOC,ABMPT))=1 ;pt already counted for visit location
..Q:'$D(^AUPNPAT(ABMPT,41,ABMVLOC)) ;skip if pt isn't registered at location
..S ^TMP($J,"ABM-VET","UPTOT",ABMVLOC)=+$G(^TMP($J,"ABM-VET","UPTOT",ABMVLOC))+1 ;count how many unique registered pts
..S ^TMP($J,"ABM-VET","UNQ PTS",ABMVLOC,ABMPT)=1 ;track unique pts
;end new abm*2.6*21 IHS/SD/SDR HEAT134720
Q
PRINT ;
D HDR
S ABMN=""
S ABMQFLG=0
F S ABMN=$O(^TMP($J,"ABM-VET","S",ABMN)) Q:ABMN="" D Q:($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT))
.I $Y+5>IOSL D HDR Q:(IOST["C")&((+$G(Y)=0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)))
.S ABMPT=$G(^TMP($J,"ABM-VET","S",ABMN))
.S ABMVCNT=$G(^TMP($J,"ABM-VET",ABMPT))
.S ABMDOB=$$SDT^ABMDUTL($$GET1^DIQ(2,ABMPT,".03","I"))
.S ABMSSN=$$GET1^DIQ(2,ABMPT,".09")
.S ABMHRN=$P($G(^AUPNPAT(ABMPT,41,DUZ(2),0)),U,2)
.W !,ABMN,?40,ABMHRN,?48,ABMDOB,?59,ABMSSN,?76,ABMVCNT
;start new abm*2.6*21 IHS/SD/SDR HEAT134720
W !
S ABMVLOC=0
F S ABMVLOC=$O(^TMP($J,"ABM-VET","VTOT",ABMVLOC)) Q:'ABMVLOC D
.W !?5,$$GET1^DIQ(9999999.06,ABMVLOC,".02","E"),?20,+$G(^TMP($J,"ABM-VET","VTOT",ABMVLOC))_" "_$S(+$G(^TMP($J,"ABM-VET","VTOT",ABMVLOC))=1:"visit",1:"visits")
.W ?35,+$G(^TMP($J,"ABM-VET","UPTOT",ABMVLOC))_" registered"
K ^TMP($J,"ABM-VET")
;end new abm*2.6*21 IHS/SD/SDR HEAT134720
Q
HDR ;EP
I +$G(ABM("PG"))'=0,$E(IOST)="C" S DIR(0)="E" D ^DIR K DIR Q:(IOST["C")&($G(Y)<0)!($D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT))
S ABM("PG")=ABM("PG")+1
D WHD^ABMDRHD
W !,"PATIENT NAME",?40,"HRN",?48,"DOB",?59,"SSN",?69,"VISIT CNT"
W !,ABMLINE
Q
ABMRPVET ; IHS/SD/SDR - Vet w/Visit in Date Range Listing ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**12,21**;NOV 12, 2009;Build 379
+2 ;Original;SDR;
+3 ;IHS/SD/SDR - 2.6*21 - HEAT134720 - added total by visit location and how many registered patients for each
+4 ; visit location
+5 ;
+6 KILL ABM,ABMY
+7 SET ABM("RTYP","NM")="Vets with Visits Report"
+8 SET ABM("PG")=0
+9 ;
SEL ;EP
+1 DO DTYP
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!$DATA(DIRUT)
QUIT
+3 SET ABM("HD",0)="VET LISTING of VISITS"
+4 SET ABM("HD",1)="For VISIT DATES: "_$$SDT^ABMDUTL(ABMY("DT",1))_" thru "_$$SDT^ABMDUTL(ABMY("DT",2))
+5 SET $PIECE(ABMLINE,"=",80)=""
+6 SET ABMQ("RC")="COMPUTE^ABMRPVET"
+7 SET ABMQ("RX")="POUT^ABMDRUTL"
+8 SET ABMQ("NS")="ABM"
+9 SET ABMQ("RP")="PRINT^ABMRPVET"
+10 DO ^ABMDRDBQ
+11 QUIT
DTYP ;
+1 WRITE !!," ============ Entry of VISIT DATE Range =============",!
+2 SET DIR("A")="Enter STARTING VISIT DATE for the Report"
+3 SET DIR(0)="DO^::EP"
+4 DO ^DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!$DATA(DIRUT)
QUIT
+6 SET ABMY("DT",1)=Y
+7 WRITE !
+8 SET DIR("A")="Enter ENDING DATE for the Report"
+9 DO ^DIR
+10 KILL DIR
+11 IF $DATA(DIRUT)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO DTYP
+12 SET ABMY("DT",2)=Y
+13 IF ABMY("DT",1)>ABMY("DT",2)
WRITE !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!!
GOTO DTYP
+14 QUIT
COMPUTE ;EP - Entry Point for Setting up Data
+1 SET ABM("SUBR")="ABM-VET"
+2 KILL ^TMP($JOB,"ABM-VET")
DATA ;EP
+1 SET ABMSTART=ABMY("DT",1)-.5
+2 SET ABMEND=ABMY("DT",2)+.999999
+3 FOR
SET ABMSTART=$ORDER(^AUPNVSIT("B",ABMSTART))
IF 'ABMSTART!(ABMSTART>ABMEND)
QUIT
Begin DoDot:1
+4 SET ABMVIEN=0
+5 FOR
SET ABMVIEN=$ORDER(^AUPNVSIT("B",ABMSTART,ABMVIEN))
IF 'ABMVIEN
QUIT
Begin DoDot:2
+6 SET ABMPT=$$GET1^DIQ(9000010,ABMVIEN,".05","I")
+7 ;not a Vet
IF $$GET1^DIQ(2,ABMPT,1901,"I")'="Y"
QUIT
+8 ;visit count
SET ^TMP($JOB,"ABM-VET",ABMPT)=+$GET(^TMP($JOB,"ABM-VET",ABMPT))+1
+9 SET ABMNAME=$$GET1^DIQ(2,ABMPT,".01","E")
+10 SET ^TMP($JOB,"ABM-VET","S",ABMNAME)=ABMPT
+11 ;start new abm*2.6*21 IHS/SD/SDR HEAT134720
+12 SET ABMVLOC=$$GET1^DIQ(9000010,ABMVIEN,".06","I")
+13 ;count visits by site
SET ^TMP($JOB,"ABM-VET","VTOT",ABMVLOC)=+$GET(^TMP($JOB,"ABM-VET","VTOT",ABMVLOC))+1
+14 ;pt already counted for visit location
IF +$GET(^TMP($JOB,"ABM-VET","UNQ PTS",ABMVLOC,ABMPT))=1
QUIT
+15 ;skip if pt isn't registered at location
IF '$DATA(^AUPNPAT(ABMPT,41,ABMVLOC))
QUIT
+16 ;count how many unique registered pts
SET ^TMP($JOB,"ABM-VET","UPTOT",ABMVLOC)=+$GET(^TMP($JOB,"ABM-VET","UPTOT",ABMVLOC))+1
+17 ;track unique pts
SET ^TMP($JOB,"ABM-VET","UNQ PTS",ABMVLOC,ABMPT)=1
End DoDot:2
End DoDot:1
+18 ;end new abm*2.6*21 IHS/SD/SDR HEAT134720
+19 QUIT
PRINT ;
+1 DO HDR
+2 SET ABMN=""
+3 SET ABMQFLG=0
+4 FOR
SET ABMN=$ORDER(^TMP($JOB,"ABM-VET","S",ABMN))
IF ABMN=""
QUIT
Begin DoDot:1
+5 IF $Y+5>IOSL
DO HDR
IF (IOST["C")&((+$GET(Y)=0)!($DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)))
QUIT
+6 SET ABMPT=$GET(^TMP($JOB,"ABM-VET","S",ABMN))
+7 SET ABMVCNT=$GET(^TMP($JOB,"ABM-VET",ABMPT))
+8 SET ABMDOB=$$SDT^ABMDUTL($$GET1^DIQ(2,ABMPT,".03","I"))
+9 SET ABMSSN=$$GET1^DIQ(2,ABMPT,".09")
+10 SET ABMHRN=$PIECE($GET(^AUPNPAT(ABMPT,41,DUZ(2),0)),U,2)
+11 WRITE !,ABMN,?40,ABMHRN,?48,ABMDOB,?59,ABMSSN,?76,ABMVCNT
End DoDot:1
IF ($DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT))
QUIT
+12 ;start new abm*2.6*21 IHS/SD/SDR HEAT134720
+13 WRITE !
+14 SET ABMVLOC=0
+15 FOR
SET ABMVLOC=$ORDER(^TMP($JOB,"ABM-VET","VTOT",ABMVLOC))
IF 'ABMVLOC
QUIT
Begin DoDot:1
+16 WRITE !?5,$$GET1^DIQ(9999999.06,ABMVLOC,".02","E"),?20,+$GET(^TMP($JOB,"ABM-VET","VTOT",ABMVLOC))_" "_$SELECT(+$GET(^TMP($JOB,"ABM-VET","VTOT",ABMVLOC))=1:"visit",1:"visits")
+17 WRITE ?35,+$GET(^TMP($JOB,"ABM-VET","UPTOT",ABMVLOC))_" registered"
End DoDot:1
+18 KILL ^TMP($JOB,"ABM-VET")
+19 ;end new abm*2.6*21 IHS/SD/SDR HEAT134720
+20 QUIT
HDR ;EP
+1 IF +$GET(ABM("PG"))'=0
IF $EXTRACT(IOST)="C"
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF (IOST["C")&($GET(Y)<0)!($DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT))
QUIT
+2 SET ABM("PG")=ABM("PG")+1
+3 DO WHD^ABMDRHD
+4 WRITE !,"PATIENT NAME",?40,"HRN",?48,"DOB",?59,"SSN",?69,"VISIT CNT"
+5 WRITE !,ABMLINE
+6 QUIT
