IBUCMM1 ;WOIFO/AAT-IBUC VISIT SUMMARY/DETAIL REPORT;30-JUL-02
;;2.0;INTEGRATED BILLING;**663,671**;21-MAR-94;Build 13
;; Per VHA Directive 6402, this routine should not be modified
Q
;
; Prints report to the current device
;
; Input:
; IBBDT - Beginning date
; IBEDT - Ending date
; Output:
; IBQUIT = 1, if user entered "^" (Devices starting with "C-" only)
REPORT ;
;
;Clear the temp global in case the process didn't finish the last time it ran.
K ^TMP($J,"IBUCMMNM")
;
;Gather the data into the Temp global
D GETDATA(IBBDT,IBEDT)
;
;Print the report
D PRSUM
;
;Clean up and exit
K ^TMP($J,"IBUCMM") ; Kill the temporary global node
K ^TMP($J,"IBUCMMNM") ; Kill the temporary global node
S:$D(ZTQUEUED) ZTREQ="@" ; for Taskman
Q
;
GETDATA(IBBDT,IBEDT) ;Gather the data for the report
;
N IBNEW,IBLP,IBIEN,IBDATA,IBDFN,IBSITE,IBSTAT,IBYR,IBMN,IBCSITE,IBCTX
;
;Get the current site's ID, and then re-initializing IBSITE for future use.
D SITE^IBAUTL S IBCSITE=IBSITE,IBSITE=""
; Initialize loop to start date
S IBLP=0 ;initial starting value
S:+$G(IBBDT)>0 IBLP=+$G(IBBDT)-1 ; use beginning date if defined
;Loop through the "VD" index to gather
F S IBLP=$O(^IBUC(351.82,"VD",IBLP)) Q:'IBLP Q:IBLP>IBEDT D
. S IBIEN=0
. F S IBIEN=$O(^IBUC(351.82,"VD",IBLP,IBIEN)) Q:'IBIEN D
. . ;
. . S IBNEW=0
. . S IBDATA=$G(^IBUC(351.82,IBIEN,0)),IBYR=$E(IBLP,1,3)+1700,IBMN=$E(IBLP,1,5)
. . I (IBCA="C"),($P(IBDATA,U,2)'=IBCSITE) Q
. . S IBDFN=$P(IBDATA,U),IBSITE=$P(IBDATA,U,2),IBSTAT=$P(IBDATA,U,4),IBCTX=IBSTAT+1
. . S IBNM=$$GET1^DIQ(2,IBDFN_",",.01,"E")
. . Q:IBNM=""
. . ;# visits by a patient in a given month (for the total and the code)
. . S:'$D(^TMP($J,"IBUCMM",IBYR,IBMN,IBNM,IBDFN)) IBNEW=1
. . S $P(^TMP($J,"IBUCMM",IBYR,IBMN,IBNM,IBDFN),U)=+$P($G(^TMP($J,"IBUCMM",IBYR,IBMN,IBNM,IBDFN)),U)+1
. . S $P(^TMP($J,"IBUCMM",IBYR,IBMN,IBNM,IBDFN),U,IBCTX)=+$P($G(^TMP($J,"IBUCMM",IBYR,IBMN,IBNM,IBDFN)),U,IBCTX)+1
. . ;# visits in a given month
. . S $P(^TMP($J,"IBUCMM",IBYR,IBMN),U)=+$P($G(^TMP($J,"IBUCMM",IBYR,IBMN)),U)+1
. . S $P(^TMP($J,"IBUCMM",IBYR,IBMN),U,IBCTX)=+$P($G(^TMP($J,"IBUCMM",IBYR,IBMN)),U,IBCTX)+1
. . S:IBNEW $P(^TMP($J,"IBUCMM",IBYR,IBMN),U,6)=+$P($G(^TMP($J,"IBUCMM",IBYR,IBMN)),U,6)+1
. . ;# visits in a given year
. . S $P(^TMP($J,"IBUCMM",IBYR),U)=+$P($G(^TMP($J,"IBUCMM",IBYR)),U)+1
. . S $P(^TMP($J,"IBUCMM",IBYR),U,IBCTX)=+$P($G(^TMP($J,"IBUCMM",IBYR)),U,IBCTX)+1
. . I '$D(^TMP($J,"IBUCMMNM",IBDFN)) D
. . . S ^TMP($J,"IBUCMMNM",IBDFN)=""
. . . S ^TMP($J,"IBUCMMNM")=$G(^TMP($J,"IBUCMMNM"))+1
Q
;
PRSUM ; Print report from the temp. global
N IBLINE,IBPAG,IBTOT,IBD,IBTY,IBDA,IBY,IBCHG,IBSAV,IBSEQ,IBMON,X,X2,X3,Y,%,IBYR
N IBTOT,IBTOTF,IBTOTC,IBTOTN,IBTOTV
D NOW^%DTC S IBDTH=$$FMTE^XLFDT($E(%,1,12))
S IBLINE="",$P(IBLINE,"=",IOM+1)="",(IBPAG,IBTOT,IBTOTC,IBTOTF,IBTOTN,IBTOTV,IBQUIT,IBCHG)=0
D:'IBEXCEL HDR
D:IBEXCEL EXHDR
I '$D(^TMP($J,"IBUCMM")) W !!,"No Urgent Care Visits found within the specified period" D PAUSE(1) Q
; - first, print detail lines
F IBMON=$E(IBBDT,1,5):1:$E(IBEDT,1,5) D Q:IBQUIT
. D:'IBEXCEL CHKSTOP Q:IBQUIT
. S IBYR=$E(IBMON,1,3)+1700
. S IBY=$G(^TMP($J,"IBUCMM",IBYR,IBMON))
. ;
. Q:$G(IBY)=""
. ;If EXCEL Output, display with ^ delim
. I IBEXCEL D
. . W !,$$MON($E(IBMON,4,5))_" "_(1700+$E(IBMON,1,3)),U,+$P(IBY,U,1),U,+$P(IBY,U,2),U,+$P(IBY,U,3),U,+$P(IBY,U,4),U,+$P(IBY,U,5),U,+$P(IBY,U,6)
. ;
. ; Otherwise print in screen format
. I 'IBEXCEL D
. . W !,$$MON($E(IBMON,4,5)),?10,1700+$E(IBMON,1,3)
. . W ?34,$J(+$P(IBY,U,1),5) ;# visits
. . W ?43,$J(+$P(IBY,U,2),5) ;# free visits
. . W ?52,$J(+$P(IBY,U,3),5) ;# charged Visits
. . W ?62,$J(+$P(IBY,U,4),5) ;# not counted Visits
. . W ?72,$J(+$P(IBY,U,5),5) ;# visit only Visits
. . W ?83,$J(+$P(IBY,U,6),5) ;# # Unique Patients
. S IBTOT=IBTOT+$P(IBY,U,1),IBTOTF=IBTOTF+$P(IBY,U,2),IBTOTC=IBTOTC+$P(IBY,U,3),IBTOTN=IBTOTN+$P(IBY,U,4),IBTOTV=IBTOTV+$P(IBY,U,5)
. I IBSD="D" D PRDET(IBYR,IBMON)
Q:IBQUIT
D TOTALS
;
;Write Unique Patient Definition
W !!,"*The total unique patient number only counts a patient once for the period",!,"of the report."
D PAUSE(1)
Q
;
PRDET(IBYR,IBMON) ; Print the details of the summary
;
N IBDFN,IBNM
S IBNM=""
F S IBNM=$O(^TMP($J,"IBUCMM",IBYR,IBMON,IBNM)) Q:IBNM="" D
. S IBDFN=0
. F S IBDFN=$O(^TMP($J,"IBUCMM",IBYR,IBMON,IBNM,IBDFN)) Q:'IBDFN D
. .D CHKSTOP Q:IBQUIT
. .S IBDATA=$G(^TMP($J,"IBUCMM",IBYR,IBMON,IBNM,IBDFN))
. . ;
. . ;Excel Format
. . I IBEXCEL D Q
. . . W !,$$GET1^DIQ(2,IBDFN_",",.01,"E"),U,+$P(IBDATA,U,1),U,+$P(IBDATA,U,2),U,+$P(IBDATA,U,3),U,+$P(IBDATA,U,4),U,+$P(IBDATA,U,5)
. . ;
. . ;Screen format
. . W !?3,$$GET1^DIQ(2,IBDFN_",",.01,"E")
. . W ?34,$J(+$P(IBDATA,U,1),5)
. . W ?43,$J(+$P(IBDATA,U,2),5) ;# free visits
. . W ?52,$J(+$P(IBDATA,U,3),5) ;# charged Visits
. . W ?62,$J(+$P(IBDATA,U,4),5) ;# Removed Visits
. . W ?72,$J(+$P(IBDATA,U,5),5) ;# Visit On Visits
Q
TOTALS ; Print the totals.
N IBI,X
;
;MS Excel format
I IBEXCEL D Q
. W !,"REPORT TOTALS",U,IBTOT,U,IBTOTF,U,IBTOTC,U,IBTOTN,U,IBTOTV,U,$G(^TMP($J,"IBUCMMNM"))
;
; screen format
W ! F IBI=1:1:88 W "-"
W !,"REPORT TOTALS",?34,$J(IBTOT,5),?43,$J(IBTOTF,5),?52,$J(IBTOTC,5),?62,$J(IBTOTN,5),?72,$J(IBTOTV,5),?82,$J($G(^TMP($J,"IBUCMMNM")),6)
Q
;
;Number format
FORMAT(IBNUM,IBDIG,IBFRM) ; Comma format the number
N X,X1,X3
S X=IBNUM,X3=IBDIG
D COMMA^%DTC
Q X
;
CHKSTOP I $Y>(IOSL-5) D PAUSE(0) Q:IBQUIT D HDR
Q
;
HDR ; Print header.
N IBI,IBHDR,IBH,IBH1,IBFACNM,IBH2
I $E(IOST,1,2)["C-"!(IBPAG) W @IOF,*13
S IBHDR=$S(IBSD="S":"SUMMARY",1:"DETAIL")
S IBH="URGENT CARE VISIT TRACKING "_IBHDR_" REPORT"
S IBPAG=IBPAG+1 W ?(122-$L(IBH)\2),IBH
S IBH1="FOR ALL SITES"
I IBCA="C" D
. S IBFACNM=$$GET1^DIQ(4,IBFAC_",",.01,"E")
. S IBH1="FOR "_IBFACNM
W !,?(122-$L(IBH1)\2),IBH1
S IBH2="From "_$$DAT(IBBDT)_" through "_$$DAT(IBEDT)
W !,?(122-$L(IBH2)\2),IBH2
W ?IOM-36,IBDTH,?IOM-9,"Page: ",IBPAG
W !!,?33,"TOTAL",?60,"REMOVED",?71,"VISITS",?80,"UNIQUE"
W !," MONTH",?10,"YEAR",?33,"VISITS",?44,"FREE",?51,"BILLED",?60,"VISITS",?71,"ONLY",?80,"PATIENTS"
W ! F IBI=1:1:88 W "-"
Q
;
EXHDR ; Print Excel version of the header.
W !,"MONTH/YEAR",U,"TOTAL VISITS",U,"FREE",U,"BILLED",U,"REMOVED VISITS",U,"VISITS ONLY",U,"UNIQUE PATIENTS"
Q
;
STAT() ; Display bill number or status
N IBSTAT S IBSTAT=$G(^IBE(350.21,+$P(IBZ,U,5),0))
Q $S($P(IBSTAT,U,6):$$HLD(+$P(IBZ,U,5)),$P(IBZ,U,5)=99:"Converted",$P(IBZ,U,11)]"":$P($P(IBZ,U,11),"-",2),$P(IBSTAT,U,5):"Cancelled",1:"Pending")
;
HLD(STAT) ; Return an 'on hold' status string
Q "Hold "_$S(STAT=20:"Rate",STAT=21:"Rev",1:"Ins")
;
PAUSE(IBEND) ;
Q:$E(IOST,1,2)'["C-"
N IBJ,DIR,DIRUT,DTOUT,DUOUT,DIROUT,Y
W !! ;F IBJ=$Y:1:(IOSL-4) W !
S DIR(0)="E"
I $G(IBEND) S DIR("A")="End of the report. Enter RETURN to continue or '^' to exit"
D ^DIR K DIR I $G(DUOUT) S IBQUIT=1 W @IOF Q
I $G(IBEND) W @IOF
Q
;
DAT(IBDT) ; Convert FM date to (mm/dd/yy) format.
Q $$FMTE^XLFDT(IBDT,"2MZ")
;
MON(IBMON) I (IBMON<1)!(IBMON>12) Q ""
Q $P("JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER"," ",IBMON)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBUCMM1 7431 printed Apr 09, 2024@21:28:30 Page 2
IBUCMM1 ;WOIFO/AAT-IBUC VISIT SUMMARY/DETAIL REPORT;30-JUL-02
+1 ;;2.0;INTEGRATED BILLING;**663,671**;21-MAR-94;Build 13
+2 ;; Per VHA Directive 6402, this routine should not be modified
+3 QUIT
+4 ;
+5 ; Prints report to the current device
+6 ;
+7 ; Input:
+8 ; IBBDT - Beginning date
+9 ; IBEDT - Ending date
+10 ; Output:
+11 ; IBQUIT = 1, if user entered "^" (Devices starting with "C-" only)
REPORT ;
+1 ;
+2 ;Clear the temp global in case the process didn't finish the last time it ran.
+3 KILL ^TMP($JOB,"IBUCMMNM")
+4 ;
+5 ;Gather the data into the Temp global
+6 DO GETDATA(IBBDT,IBEDT)
+7 ;
+8 ;Print the report
+9 DO PRSUM
+10 ;
+11 ;Clean up and exit
+12 ; Kill the temporary global node
KILL ^TMP($JOB,"IBUCMM")
+13 ; Kill the temporary global node
KILL ^TMP($JOB,"IBUCMMNM")
+14 ; for Taskman
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+15 QUIT
+16 ;
GETDATA(IBBDT,IBEDT) ;Gather the data for the report
+1 ;
+2 NEW IBNEW,IBLP,IBIEN,IBDATA,IBDFN,IBSITE,IBSTAT,IBYR,IBMN,IBCSITE,IBCTX
+3 ;
+4 ;Get the current site's ID, and then re-initializing IBSITE for future use.
+5 DO SITE^IBAUTL
SET IBCSITE=IBSITE
SET IBSITE=""
+6 ; Initialize loop to start date
+7 ;initial starting value
SET IBLP=0
+8 ; use beginning date if defined
if +$GET(IBBDT)>0
SET IBLP=+$GET(IBBDT)-1
+9 ;Loop through the "VD" index to gather
+10 FOR
SET IBLP=$ORDER(^IBUC(351.82,"VD",IBLP))
if 'IBLP
QUIT
if IBLP>IBEDT
QUIT
Begin DoDot:1
+11 SET IBIEN=0
+12 FOR
SET IBIEN=$ORDER(^IBUC(351.82,"VD",IBLP,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:2
+13 ;
+14 SET IBNEW=0
+15 SET IBDATA=$GET(^IBUC(351.82,IBIEN,0))
SET IBYR=$EXTRACT(IBLP,1,3)+1700
SET IBMN=$EXTRACT(IBLP,1,5)
+16 IF (IBCA="C")
IF ($PIECE(IBDATA,U,2)'=IBCSITE)
QUIT
+17 SET IBDFN=$PIECE(IBDATA,U)
SET IBSITE=$PIECE(IBDATA,U,2)
SET IBSTAT=$PIECE(IBDATA,U,4)
SET IBCTX=IBSTAT+1
+18 SET IBNM=$$GET1^DIQ(2,IBDFN_",",.01,"E")
+19 if IBNM=""
QUIT
+20 ;# visits by a patient in a given month (for the total and the code)
+21 if '$DATA(^TMP($JOB,"IBUCMM",IBYR,IBMN,IBNM,IBDFN))
SET IBNEW=1
+22 SET $PIECE(^TMP($JOB,"IBUCMM",IBYR,IBMN,IBNM,IBDFN),U)=+$PIECE($GET(^TMP($JOB,"IBUCMM",IBYR,IBMN,IBNM,IBDFN)),U)+1
+23 SET $PIECE(^TMP($JOB,"IBUCMM",IBYR,IBMN,IBNM,IBDFN),U,IBCTX)=+$PIECE($GET(^TMP($JOB,"IBUCMM",IBYR,IBMN,IBNM,IBDFN)),U,IBCTX)+1
+24 ;# visits in a given month
+25 SET $PIECE(^TMP($JOB,"IBUCMM",IBYR,IBMN),U)=+$PIECE($GET(^TMP($JOB,"IBUCMM",IBYR,IBMN)),U)+1
+26 SET $PIECE(^TMP($JOB,"IBUCMM",IBYR,IBMN),U,IBCTX)=+$PIECE($GET(^TMP($JOB,"IBUCMM",IBYR,IBMN)),U,IBCTX)+1
+27 if IBNEW
SET $PIECE(^TMP($JOB,"IBUCMM",IBYR,IBMN),U,6)=+$PIECE($GET(^TMP($JOB,"IBUCMM",IBYR,IBMN)),U,6)+1
+28 ;# visits in a given year
+29 SET $PIECE(^TMP($JOB,"IBUCMM",IBYR),U)=+$PIECE($GET(^TMP($JOB,"IBUCMM",IBYR)),U)+1
+30 SET $PIECE(^TMP($JOB,"IBUCMM",IBYR),U,IBCTX)=+$PIECE($GET(^TMP($JOB,"IBUCMM",IBYR)),U,IBCTX)+1
+31 IF '$DATA(^TMP($JOB,"IBUCMMNM",IBDFN))
Begin DoDot:3
+32 SET ^TMP($JOB,"IBUCMMNM",IBDFN)=""
+33 SET ^TMP($JOB,"IBUCMMNM")=$GET(^TMP($JOB,"IBUCMMNM"))+1
End DoDot:3
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
PRSUM ; Print report from the temp. global
+1 NEW IBLINE,IBPAG,IBTOT,IBD,IBTY,IBDA,IBY,IBCHG,IBSAV,IBSEQ,IBMON,X,X2,X3,Y,%,IBYR
+2 NEW IBTOT,IBTOTF,IBTOTC,IBTOTN,IBTOTV
+3 DO NOW^%DTC
SET IBDTH=$$FMTE^XLFDT($EXTRACT(%,1,12))
+4 SET IBLINE=""
SET $PIECE(IBLINE,"=",IOM+1)=""
SET (IBPAG,IBTOT,IBTOTC,IBTOTF,IBTOTN,IBTOTV,IBQUIT,IBCHG)=0
+5 if 'IBEXCEL
DO HDR
+6 if IBEXCEL
DO EXHDR
+7 IF '$DATA(^TMP($JOB,"IBUCMM"))
WRITE !!,"No Urgent Care Visits found within the specified period"
DO PAUSE(1)
QUIT
+8 ; - first, print detail lines
+9 FOR IBMON=$EXTRACT(IBBDT,1,5):1:$EXTRACT(IBEDT,1,5)
Begin DoDot:1
+10 if 'IBEXCEL
DO CHKSTOP
if IBQUIT
QUIT
+11 SET IBYR=$EXTRACT(IBMON,1,3)+1700
+12 SET IBY=$GET(^TMP($JOB,"IBUCMM",IBYR,IBMON))
+13 ;
+14 if $GET(IBY)=""
QUIT
+15 ;If EXCEL Output, display with ^ delim
+16 IF IBEXCEL
Begin DoDot:2
+17 WRITE !,$$MON($EXTRACT(IBMON,4,5))_" "_(1700+$EXTRACT(IBMON,1,3)),U,+$PIECE(IBY,U,1),U,+$PIECE(IBY,U,2),U,+$PIECE(IBY,U,3),U,+$PIECE(IBY,U,4),U,+$PIECE(IBY,U,5),U,+$PIECE(IBY,U,6)
End DoDot:2
+18 ;
+19 ; Otherwise print in screen format
+20 IF 'IBEXCEL
Begin DoDot:2
+21 WRITE !,$$MON($EXTRACT(IBMON,4,5)),?10,1700+$EXTRACT(IBMON,1,3)
+22 ;# visits
WRITE ?34,$JUSTIFY(+$PIECE(IBY,U,1),5)
+23 ;# free visits
WRITE ?43,$JUSTIFY(+$PIECE(IBY,U,2),5)
+24 ;# charged Visits
WRITE ?52,$JUSTIFY(+$PIECE(IBY,U,3),5)
+25 ;# not counted Visits
WRITE ?62,$JUSTIFY(+$PIECE(IBY,U,4),5)
+26 ;# visit only Visits
WRITE ?72,$JUSTIFY(+$PIECE(IBY,U,5),5)
+27 ;# # Unique Patients
WRITE ?83,$JUSTIFY(+$PIECE(IBY,U,6),5)
End DoDot:2
+28 SET IBTOT=IBTOT+$PIECE(IBY,U,1)
SET IBTOTF=IBTOTF+$PIECE(IBY,U,2)
SET IBTOTC=IBTOTC+$PIECE(IBY,U,3)
SET IBTOTN=IBTOTN+$PIECE(IBY,U,4)
SET IBTOTV=IBTOTV+$PIECE(IBY,U,5)
+29 IF IBSD="D"
DO PRDET(IBYR,IBMON)
End DoDot:1
if IBQUIT
QUIT
+30 if IBQUIT
QUIT
+31 DO TOTALS
+32 ;
+33 ;Write Unique Patient Definition
+34 WRITE !!,"*The total unique patient number only counts a patient once for the period",!,"of the report."
+35 DO PAUSE(1)
+36 QUIT
+37 ;
PRDET(IBYR,IBMON) ; Print the details of the summary
+1 ;
+2 NEW IBDFN,IBNM
+3 SET IBNM=""
+4 FOR
SET IBNM=$ORDER(^TMP($JOB,"IBUCMM",IBYR,IBMON,IBNM))
if IBNM=""
QUIT
Begin DoDot:1
+5 SET IBDFN=0
+6 FOR
SET IBDFN=$ORDER(^TMP($JOB,"IBUCMM",IBYR,IBMON,IBNM,IBDFN))
if 'IBDFN
QUIT
Begin DoDot:2
+7 DO CHKSTOP
if IBQUIT
QUIT
+8 SET IBDATA=$GET(^TMP($JOB,"IBUCMM",IBYR,IBMON,IBNM,IBDFN))
+9 ;
+10 ;Excel Format
+11 IF IBEXCEL
Begin DoDot:3
+12 WRITE !,$$GET1^DIQ(2,IBDFN_",",.01,"E"),U,+$PIECE(IBDATA,U,1),U,+$PIECE(IBDATA,U,2),U,+$PIECE(IBDATA,U,3),U,+$PIECE(IBDATA,U,4),U,+$PIECE(IBDATA,U,5)
End DoDot:3
QUIT
+13 ;
+14 ;Screen format
+15 WRITE !?3,$$GET1^DIQ(2,IBDFN_",",.01,"E")
+16 WRITE ?34,$JUSTIFY(+$PIECE(IBDATA,U,1),5)
+17 ;# free visits
WRITE ?43,$JUSTIFY(+$PIECE(IBDATA,U,2),5)
+18 ;# charged Visits
WRITE ?52,$JUSTIFY(+$PIECE(IBDATA,U,3),5)
+19 ;# Removed Visits
WRITE ?62,$JUSTIFY(+$PIECE(IBDATA,U,4),5)
+20 ;# Visit On Visits
WRITE ?72,$JUSTIFY(+$PIECE(IBDATA,U,5),5)
End DoDot:2
End DoDot:1
+21 QUIT
TOTALS ; Print the totals.
+1 NEW IBI,X
+2 ;
+3 ;MS Excel format
+4 IF IBEXCEL
Begin DoDot:1
+5 WRITE !,"REPORT TOTALS",U,IBTOT,U,IBTOTF,U,IBTOTC,U,IBTOTN,U,IBTOTV,U,$GET(^TMP($JOB,"IBUCMMNM"))
End DoDot:1
QUIT
+6 ;
+7 ; screen format
+8 WRITE !
FOR IBI=1:1:88
WRITE "-"
+9 WRITE !,"REPORT TOTALS",?34,$JUSTIFY(IBTOT,5),?43,$JUSTIFY(IBTOTF,5),?52,$JUSTIFY(IBTOTC,5),?62,$JUSTIFY(IBTOTN,5),?72,$JUSTIFY(IBTOTV,5),?82,$JUSTIFY($GET(^TMP($JOB,"IBUCMMNM")),6)
+10 QUIT
+11 ;
+12 ;Number format
FORMAT(IBNUM,IBDIG,IBFRM) ; Comma format the number
+1 NEW X,X1,X3
+2 SET X=IBNUM
SET X3=IBDIG
+3 DO COMMA^%DTC
+4 QUIT X
+5 ;
CHKSTOP IF $Y>(IOSL-5)
DO PAUSE(0)
if IBQUIT
QUIT
DO HDR
+1 QUIT
+2 ;
HDR ; Print header.
+1 NEW IBI,IBHDR,IBH,IBH1,IBFACNM,IBH2
+2 IF $EXTRACT(IOST,1,2)["C-"!(IBPAG)
WRITE @IOF,*13
+3 SET IBHDR=$SELECT(IBSD="S":"SUMMARY",1:"DETAIL")
+4 SET IBH="URGENT CARE VISIT TRACKING "_IBHDR_" REPORT"
+5 SET IBPAG=IBPAG+1
WRITE ?(122-$LENGTH(IBH)\2),IBH
+6 SET IBH1="FOR ALL SITES"
+7 IF IBCA="C"
Begin DoDot:1
+8 SET IBFACNM=$$GET1^DIQ(4,IBFAC_",",.01,"E")
+9 SET IBH1="FOR "_IBFACNM
End DoDot:1
+10 WRITE !,?(122-$LENGTH(IBH1)\2),IBH1
+11 SET IBH2="From "_$$DAT(IBBDT)_" through "_$$DAT(IBEDT)
+12 WRITE !,?(122-$LENGTH(IBH2)\2),IBH2
+13 WRITE ?IOM-36,IBDTH,?IOM-9,"Page: ",IBPAG
+14 WRITE !!,?33,"TOTAL",?60,"REMOVED",?71,"VISITS",?80,"UNIQUE"
+15 WRITE !," MONTH",?10,"YEAR",?33,"VISITS",?44,"FREE",?51,"BILLED",?60,"VISITS",?71,"ONLY",?80,"PATIENTS"
+16 WRITE !
FOR IBI=1:1:88
WRITE "-"
+17 QUIT
+18 ;
EXHDR ; Print Excel version of the header.
+1 WRITE !,"MONTH/YEAR",U,"TOTAL VISITS",U,"FREE",U,"BILLED",U,"REMOVED VISITS",U,"VISITS ONLY",U,"UNIQUE PATIENTS"
+2 QUIT
+3 ;
STAT() ; Display bill number or status
+1 NEW IBSTAT
SET IBSTAT=$GET(^IBE(350.21,+$PIECE(IBZ,U,5),0))
+2 QUIT $SELECT($PIECE(IBSTAT,U,6):$$HLD(+$PIECE(IBZ,U,5)),$PIECE(IBZ,U,5)=99:"Converted",$PIECE(IBZ,U,11)]"":$PIECE($PIECE(IBZ,U,11),"-",2),$PIECE(IBSTAT,U,5):"Cancelled",1:"Pending")
+3 ;
HLD(STAT) ; Return an 'on hold' status string
+1 QUIT "Hold "_$SELECT(STAT=20:"Rate",STAT=21:"Rev",1:"Ins")
+2 ;
PAUSE(IBEND) ;
+1 if $EXTRACT(IOST,1,2)'["C-"
QUIT
+2 NEW IBJ,DIR,DIRUT,DTOUT,DUOUT,DIROUT,Y
+3 ;F IBJ=$Y:1:(IOSL-4) W !
WRITE !!
+4 SET DIR(0)="E"
+5 IF $GET(IBEND)
SET DIR("A")="End of the report. Enter RETURN to continue or '^' to exit"
+6 DO ^DIR
KILL DIR
IF $GET(DUOUT)
SET IBQUIT=1
WRITE @IOF
QUIT
+7 IF $GET(IBEND)
WRITE @IOF
+8 QUIT
+9 ;
DAT(IBDT) ; Convert FM date to (mm/dd/yy) format.
+1 QUIT $$FMTE^XLFDT(IBDT,"2MZ")
+2 ;
MON(IBMON) IF (IBMON<1)!(IBMON>12)
QUIT ""
+1 QUIT $PIECE("JANUARY FEBRUARY MARCH APRIL MAY JUNE JULY AUGUST SEPTEMBER OCTOBER NOVEMBER DECEMBER"," ",IBMON)
+2 ;
