- 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
