IBUCERP ;EDE/LLB - IBUC VISIT EXCEPTION REPORT;09-MAR-23
;;2.0;INTEGRATED BILLING;**761**;21-MAR-94;Build 27
;; Per VHA Directive 6402, this routine should not be modified
;
; IBQUIT = 1, if user entered "^" (Devices starting with "C-" only)
REPORT ;
N SORT,IBFLTR,IBFLTRBY,IBQUIT,IBNAME,IBLSITNM,IBLSITNB,IBEXCEL
S IBQUIT=0
W @IOF
W !,"Integrated Billing Urgent Care Exception Report"
D ASKFLTR I $G(IBQUIT)=1 Q
D ASKSORT I $G(SORT)<0!($G(IBQUIT)=1) Q
S IBEXCEL=$$EXCEL^IBJD ; Asks if output is EXCEL format
I IBEXCEL D EXCMSG ;Display EXCEL device recommendations
D ASKDEV
Q
;
REPORT1 ; Entry point for Report Generation
D COLLECT
D PRTRPT
Q
;
ASKFLTR ; Ask what to filter by
; Use index on field 3.03 to display a list of sites that can be selected
; to filter by
; Loop asking for filter values until user <ENTER> with no value
; store values in temporary array to test against in the report.
N CNT,Y,ARRAY
N X,Y,IBJ,DIR,DA,DIRUT,DTOUT,DUOUT,DIROUT,IBCNTIT
S IBFLTRBY="/"
S IBFLTR=""
K DIR
S DIR("A")="Filter by Remote Site/Division (Y/N): "
S DIR(0)="Y"
S DIR("B")="NO"
D ^DIR
K DIR
I $D(DUOUT) S IBQUIT=1 Q
S IBFLTR=Y
I '$G(Y) S IBFLTRBY="" Q
;ASK FOR INSTITUTION TO FILTER BY
S CNT=0
D DISPLST
W !,"Select Site/Division from list above",!
S IBCNTIT=0
F D GETINST Q:Y=""!($G(DUOUT))!($G(DTOUT))
Q
;
DISPLST ;
K ARRAY,IBNAME
S IBNAME="" F S IBNAME=$O(^IBUC(351.82,"ARS",IBNAME)) Q:IBNAME="" D
. S CNT=CNT+1
. D GETS^DIQ(4,IBNAME_",",".01","EI","ARRAY")
. S IBNAME(CNT)=IBNAME_"-"_ARRAY(4,IBNAME_",",.01,"E") W !,IBNAME,?6,ARRAY(4,IBNAME_",",.01,"E")
Q
;
GETINST ;
N X,IBJ,DIR,DA,VALID
K DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
S DIR(0)="FOU"
S DIR("A")="Enter Site/Division to filter by, <ENTER> for all, or ^ to exit"
I IBCNTIT>0 S DIR("A")="Enter another Site/Division or <ENTER> to continue, or ^ to Exit report."
RPTASK ;
D ^DIR
; Test for user entered nothing i.e. Y="" or timeout
I $G(DUOUT) S IBQUIT=1 Q
I $G(DTOUT)!(Y="") Q
S Y=$$UP^XLFSTR(Y) ;Convert user response to upper case
S VALID=$$TSTVALID() ; Test if the entry is in the list to select from
I 'VALID W !,"INVALID SELECTION try again" G RPTASK
S IBCNTIT=IBCNTIT+1
S IBFLTRBY=IBFLTRBY_Y_"/"
Q
;
TSTVALID() ; Checks if the enty is in the list of sites with exceptions
N IBSTOP,IBCNT S IBSTOP=50000
S IBSTOP=$O(IBNAME(IBSTOP),-1)
S VALID=0
F IBCNT=1:1:IBSTOP Q:VALID=1 I IBNAME(IBCNT)[Y S VALID=1,Y=IBNAME(IBCNT) Q
Q VALID
;
ASKSORT ; Ask for sorting preferences
N X,Y,IBJ,DIR,DA,DIRUT,DTOUT,DUOUT,DIROUT
K DIR,Y(0)
W ! S DIR(0)="SA^P:Patient;E:Exception Site;B:Bill Number"
S DIR("A")="Sort by: (P)atient,(E)xception Site,(B)ill Number (P/E/B) "
S DIR("B")="P"
D ^DIR
K DIR
I $G(DUOUT) S IBQUIT=1 Q
S SORT=$S(Y="P":"PAT",Y="B":"BN",Y="E":"ES",1:"PAT")
I $G(DTOUT) K DIRUT,DUOUT,DTOUT S SORT="PAT"
Q
;
COLLECT ;Collect data into ^TMP($J,"UCEXRPT",CNT)
N EIN,CNT,IBES,IBBN,IBPAT,IBPATNM,IBESITE,IBRSN,IBESITEN,IBTES
N ARRAY,IBRESN,IBTSITE,IBLSITE,IBVSTDT,IBLSTNUM,PH
S CNT=0,EIN=""
K ^TMP($J,"IBEXRPT")
F S EIN=$O(^IBUC(351.82,"AT",1,EIN)) Q:'EIN D
. S CNT=CNT+1
. K ARRAY
. D GETS^DIQ(351.82,EIN_",",".01;.02;.03;.05;.06;3.01;3.02;3.03","EI","ARRAY")
. S IBPAT=ARRAY(351.82,EIN_",",.01,"I")
. S IBPATNM=ARRAY(351.82,EIN_",",.01,"E")
. I $E(IBPATNM,1,2)="ZZ" Q
. S IBLSITE=ARRAY(351.82,EIN_",",.02,"E")
. S IBLSTNUM=ARRAY(351.82,EIN_",",.02,"I")
. S IBVSTDT=ARRAY(351.82,EIN_",",.03,"I") ;Visit Date
. S IBBN=ARRAY(351.82,EIN_",",.05,"E")
. I IBBN="" S IBBN=" "
. S IBRESN=ARRAY(351.82,EIN_",",3.02,"E")
. S IBESITE=ARRAY(351.82,EIN_",",3.03,"I")
. S IBESITEN=ARRAY(351.82,EIN_",",3.03,"E")
. I IBFLTRBY'="",(IBFLTRBY'="/"),(IBFLTRBY'="//") S IBTSITE="/"_IBESITE_"-" I IBFLTRBY'[IBTSITE Q
. S IBES="" ;Using Institution as Division since remote site Divison is unavailable
. S IBES=$$GET1^DIQ(351.82,EIN,3.03) ;Pointer to site
. S ^TMP($J,"IBEXRPT",CNT)=IBPAT_"/"_IBPATNM_U_$G(IBBN)_U_IBVSTDT_U_IBESITEN_U_IBRESN_U_IBESITE_U_IBLSTNUM_"-"_IBLSITE
. ; Build index to ^TMP($J,"IBEXRPT" based on Sort Criteria
. S PH="BLANK"
. I SORT="PAT" S ^TMP($J,"IBEXRPT","INDX",PH,IBPATNM,CNT)=""
. I SORT="BN" S ^TMP($J,"IBEXRPT","INDX",PH,IBBN,CNT)=""
. I SORT="ES" D
. . S IBTES=$S(IBESITEN'="":IBESITEN,1:" ")
. . S ^TMP($J,"IBEXRPT","INDX",IBTES,IBPATNM,CNT)=""
Q
;
PRTRPT ; Output report to screen
N IBREC,LOOP1,LOOP2,LOOP3,TEMP,PG,IBQUIT,IBSL,CNT,IBSITE,IBFAC,IBFACNM
S (IBQUIT,PG,CNT)=0,IBSL=IOSL
D SITE^IBAUTL
S IBFACNM=$$GET1^DIQ(4,IBFAC_",",.01,"E")
W !
D RPTHDR
D COLHDR
; Loop through Temporary index to print report using selected sort.
S LOOP1=""
F S LOOP1=$O(^TMP($J,"IBEXRPT","INDX",LOOP1)) Q:LOOP1=""!IBQUIT D
. S LOOP2=""
. F S LOOP2=$O(^TMP($J,"IBEXRPT","INDX",LOOP1,LOOP2)) Q:LOOP2=""!IBQUIT D
. . S LOOP3=""
. . F S LOOP3=$O(^TMP($J,"IBEXRPT","INDX",LOOP1,LOOP2,LOOP3)) Q:LOOP3=""!IBQUIT D
. . . S CNT=CNT+1
. . . S IBREC=^TMP($J,"IBEXRPT",LOOP3)
. . . I 'IBEXCEL W !,$E($P(IBREC,U,7),1,25),?27,$E($P($P(IBREC,U,1),"/",2),1,20),?50,$$FMTE^XLFDT($P(IBREC,U,3),"5DZ"),?62,$P(IBREC,U,2),?76,$P(IBREC,U,6)_"-"_$P(IBREC,U,4),?103,$E($P(IBREC,U,5),1,20)
. . . I IBEXCEL W !,$E($P(IBREC,U,7),1,25),"^",$E($P($P(IBREC,U,1),"/",2),1,20),"^",$$FMTE^XLFDT($P(IBREC,U,3),"5DZ"),"^",$P(IBREC,U,2),"^",$P(IBREC,U,6)_"-"_$P(IBREC,U,4),"^",$E($P(IBREC,U,5),1,20)
. . . I $O(^TMP($J,"IBEXRPT","INDX",LOOP1,LOOP2,LOOP3)) D CHKSTOP
I IBQUIT Q
I '$D(ZTQUEUED) D PAUSE(1) ;Only do PAUSE if not queued
Q
;
RPTHDR ; Prints the report header
N PRTFLTBY,FBCNT,TEMP,ITEM,MAX
S PG=PG+1
I 'IBEXCEL W !,"Urgent Care Exception Report ",$$FMTE^XLFDT(DT,"5DZ"),?72,"Page "_PG
I IBEXCEL W !,"Urgent Care Exception Report ","^",$$FMTE^XLFDT(DT,"5DZ")
I 'IBEXCEL W !,"For Site: ",IBSITE," ",IBFACNM
I IBEXCEL W !,"For Site: ","^",IBSITE," ",IBFACNM
I IBFLTRBY'="" S PRTFLTBY="",TEMP=$E(IBFLTRBY,2,$L(IBFLTRBY)-1),MAX=$L(TEMP,"/") F FBCNT=1:1:MAX D
. S ITEM=$P(TEMP,"/",FBCNT) S ITEM=$P(ITEM,"-",2)
. S PRTFLTBY=PRTFLTBY_ITEM I FBCNT<MAX S PRTFLTBY=PRTFLTBY_"/"
I 'IBEXCEL D
. W !,"Filtered by: " I IBFLTRBY'="",(IBFLTRBY'="/"),(IBFLTRBY'="//") W PRTFLTBY
. W " ","Sorted by: ",$S(SORT="BN":"Bill Number",SORT="ES":"Exception Site/Division",1:"Patient"),!
I IBEXCEL D
. W !,"Filtered by:^" I IBFLTRBY'="",(IBFLTRBY'="/"),(IBFLTRBY'="//") W PRTFLTBY
. W "^Sorted by:^",$S(SORT="BN":"Bill Number",SORT="ES":"Exception Site/Division",1:"Patient"),!
Q
;
COLHDR ; Prints the header for the colums in the report. Report is 115 characters wide
N S,V,IBI,DASH
I 'IBEXCEL W !,"Division",?27,"Patient Name",?50,"Visit Dt",?62,"Bill Number",?76,"Exception Site",?103,"Reason"
I IBEXCEL W !,"Division","^","Patient Name","^","Visit Dt","^","Bill Number","^","Exception Site","^","Reason"
I 'IBEXCEL S DASH="",$P(DASH,"-",124)="" W !,DASH
Q
;
ASKDEV ; Ask about output device and print the report (or run task)
N %ZIS,POP
W !!,"The report requires 132 columns."
S %ZIS="QM"
D ^%ZIS Q:POP ; Quit and ask for device again if invalid entry.
I IOSL<7 W !,"Screen length set to ",IOSL," cannot be less than 7." G ASKDEV
; If it was queued
I $G(IO)="" S IBQUIT=1 Q
I $D(IO("Q")) D RUNTASK Q
U IO D REPORT1^IBUCERP ; Generate report directly
D ^%ZISC ; Close the device
Q
;
RUNTASK ; Start Taskman job
N ZTRTN,ZTSK,IBVAR,ZTSAVE,ZTDESC
S ZTRTN="REPORT1^IBUCERP",ZTDESC="IB Urgent Care Exception Report"
F IBVAR="IBFLTRBY","SORT","ZTQUEUED" S ZTSAVE(IBVAR)=""
D ^%ZTLOAD
I $G(ZTSK) W !!,"This request has been queued. The task number is "_ZTSK_"."
E W !!,"Unable to queue this job."
K ZTQUEUED
D HOME^%ZIS W !
Q
;
CHKSTOP ;
I CNT>=(IBSL-8) D
. I '$D(ZTQUEUED) D PAUSE(0)
. S CNT=0 ;Reset CNT if header prints
. D RPTHDR
. D COLHDR
Q
;
PAUSE(IBEND) ;
Q:$E(IOST,1,2)'["C-"
N X,Y,IBJ,DIR,DA,DIRUT,DTOUT,DUOUT,DIROUT
S $Y=0
I $G(IBEND) W !,"End of the report."
S DIR(0)="E"
S DIR("A")="Type <Enter> to continue or '^' to exit"
D ^DIR K DIR I $G(DUOUT) S IBQUIT=1 W @IOF Q
W @IOF
Q
;
EXCMSG ; - Displays the message about capturing to an Excel file format
;
W !!?5,"To capture as an Excel format, it is recommended that you queue this"
W !?5,"report to a spool device with margins of 256 and page length of 99999"
W !?5,"(e.g. 0;256;99999). This should help avoid wrapping problems."
W !!?5,"Another method would be to set up your terminal to capture the detail"
W !?5,"report data. On some terminals, this can be done by invoking 'Logging'"
W !?5,"or clicking on the 'Tools' menu above, then click on 'Capture Incoming "
W !?5,"Data' to save to Desktop. To avoid undesired wrapping of the data saved"
W !?5,"to the file, change the DISPLAY screen width size to 132 and you can"
W !?5,"enter '0;256;99999' at the 'DEVICE:' prompt.",!
Q
; ========================================================================
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBUCERP 9089 printed Aug 26, 2025@22:45:22 Page 2
IBUCERP ;EDE/LLB - IBUC VISIT EXCEPTION REPORT;09-MAR-23
+1 ;;2.0;INTEGRATED BILLING;**761**;21-MAR-94;Build 27
+2 ;; Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; IBQUIT = 1, if user entered "^" (Devices starting with "C-" only)
REPORT ;
+1 NEW SORT,IBFLTR,IBFLTRBY,IBQUIT,IBNAME,IBLSITNM,IBLSITNB,IBEXCEL
+2 SET IBQUIT=0
+3 WRITE @IOF
+4 WRITE !,"Integrated Billing Urgent Care Exception Report"
+5 DO ASKFLTR
IF $GET(IBQUIT)=1
QUIT
+6 DO ASKSORT
IF $GET(SORT)<0!($GET(IBQUIT)=1)
QUIT
+7 ; Asks if output is EXCEL format
SET IBEXCEL=$$EXCEL^IBJD
+8 ;Display EXCEL device recommendations
IF IBEXCEL
DO EXCMSG
+9 DO ASKDEV
+10 QUIT
+11 ;
REPORT1 ; Entry point for Report Generation
+1 DO COLLECT
+2 DO PRTRPT
+3 QUIT
+4 ;
ASKFLTR ; Ask what to filter by
+1 ; Use index on field 3.03 to display a list of sites that can be selected
+2 ; to filter by
+3 ; Loop asking for filter values until user <ENTER> with no value
+4 ; store values in temporary array to test against in the report.
+5 NEW CNT,Y,ARRAY
+6 NEW X,Y,IBJ,DIR,DA,DIRUT,DTOUT,DUOUT,DIROUT,IBCNTIT
+7 SET IBFLTRBY="/"
+8 SET IBFLTR=""
+9 KILL DIR
+10 SET DIR("A")="Filter by Remote Site/Division (Y/N): "
+11 SET DIR(0)="Y"
+12 SET DIR("B")="NO"
+13 DO ^DIR
+14 KILL DIR
+15 IF $DATA(DUOUT)
SET IBQUIT=1
QUIT
+16 SET IBFLTR=Y
+17 IF '$GET(Y)
SET IBFLTRBY=""
QUIT
+18 ;ASK FOR INSTITUTION TO FILTER BY
+19 SET CNT=0
+20 DO DISPLST
+21 WRITE !,"Select Site/Division from list above",!
+22 SET IBCNTIT=0
+23 FOR
DO GETINST
if Y=""!($GET(DUOUT))!($GET(DTOUT))
QUIT
+24 QUIT
+25 ;
DISPLST ;
+1 KILL ARRAY,IBNAME
+2 SET IBNAME=""
FOR
SET IBNAME=$ORDER(^IBUC(351.82,"ARS",IBNAME))
if IBNAME=""
QUIT
Begin DoDot:1
+3 SET CNT=CNT+1
+4 DO GETS^DIQ(4,IBNAME_",",".01","EI","ARRAY")
+5 SET IBNAME(CNT)=IBNAME_"-"_ARRAY(4,IBNAME_",",.01,"E")
WRITE !,IBNAME,?6,ARRAY(4,IBNAME_",",.01,"E")
End DoDot:1
+6 QUIT
+7 ;
GETINST ;
+1 NEW X,IBJ,DIR,DA,VALID
+2 KILL DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
+3 SET DIR(0)="FOU"
+4 SET DIR("A")="Enter Site/Division to filter by, <ENTER> for all, or ^ to exit"
+5 IF IBCNTIT>0
SET DIR("A")="Enter another Site/Division or <ENTER> to continue, or ^ to Exit report."
RPTASK ;
+1 DO ^DIR
+2 ; Test for user entered nothing i.e. Y="" or timeout
+3 IF $GET(DUOUT)
SET IBQUIT=1
QUIT
+4 IF $GET(DTOUT)!(Y="")
QUIT
+5 ;Convert user response to upper case
SET Y=$$UP^XLFSTR(Y)
+6 ; Test if the entry is in the list to select from
SET VALID=$$TSTVALID()
+7 IF 'VALID
WRITE !,"INVALID SELECTION try again"
GOTO RPTASK
+8 SET IBCNTIT=IBCNTIT+1
+9 SET IBFLTRBY=IBFLTRBY_Y_"/"
+10 QUIT
+11 ;
TSTVALID() ; Checks if the enty is in the list of sites with exceptions
+1 NEW IBSTOP,IBCNT
SET IBSTOP=50000
+2 SET IBSTOP=$ORDER(IBNAME(IBSTOP),-1)
+3 SET VALID=0
+4 FOR IBCNT=1:1:IBSTOP
if VALID=1
QUIT
IF IBNAME(IBCNT)[Y
SET VALID=1
SET Y=IBNAME(IBCNT)
QUIT
+5 QUIT VALID
+6 ;
ASKSORT ; Ask for sorting preferences
+1 NEW X,Y,IBJ,DIR,DA,DIRUT,DTOUT,DUOUT,DIROUT
+2 KILL DIR,Y(0)
+3 WRITE !
SET DIR(0)="SA^P:Patient;E:Exception Site;B:Bill Number"
+4 SET DIR("A")="Sort by: (P)atient,(E)xception Site,(B)ill Number (P/E/B) "
+5 SET DIR("B")="P"
+6 DO ^DIR
+7 KILL DIR
+8 IF $GET(DUOUT)
SET IBQUIT=1
QUIT
+9 SET SORT=$SELECT(Y="P":"PAT",Y="B":"BN",Y="E":"ES",1:"PAT")
+10 IF $GET(DTOUT)
KILL DIRUT,DUOUT,DTOUT
SET SORT="PAT"
+11 QUIT
+12 ;
COLLECT ;Collect data into ^TMP($J,"UCEXRPT",CNT)
+1 NEW EIN,CNT,IBES,IBBN,IBPAT,IBPATNM,IBESITE,IBRSN,IBESITEN,IBTES
+2 NEW ARRAY,IBRESN,IBTSITE,IBLSITE,IBVSTDT,IBLSTNUM,PH
+3 SET CNT=0
SET EIN=""
+4 KILL ^TMP($JOB,"IBEXRPT")
+5 FOR
SET EIN=$ORDER(^IBUC(351.82,"AT",1,EIN))
if 'EIN
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
+7 KILL ARRAY
+8 DO GETS^DIQ(351.82,EIN_",",".01;.02;.03;.05;.06;3.01;3.02;3.03","EI","ARRAY")
+9 SET IBPAT=ARRAY(351.82,EIN_",",.01,"I")
+10 SET IBPATNM=ARRAY(351.82,EIN_",",.01,"E")
+11 IF $EXTRACT(IBPATNM,1,2)="ZZ"
QUIT
+12 SET IBLSITE=ARRAY(351.82,EIN_",",.02,"E")
+13 SET IBLSTNUM=ARRAY(351.82,EIN_",",.02,"I")
+14 ;Visit Date
SET IBVSTDT=ARRAY(351.82,EIN_",",.03,"I")
+15 SET IBBN=ARRAY(351.82,EIN_",",.05,"E")
+16 IF IBBN=""
SET IBBN=" "
+17 SET IBRESN=ARRAY(351.82,EIN_",",3.02,"E")
+18 SET IBESITE=ARRAY(351.82,EIN_",",3.03,"I")
+19 SET IBESITEN=ARRAY(351.82,EIN_",",3.03,"E")
+20 IF IBFLTRBY'=""
IF (IBFLTRBY'="/")
IF (IBFLTRBY'="//")
SET IBTSITE="/"_IBESITE_"-"
IF IBFLTRBY'[IBTSITE
QUIT
+21 ;Using Institution as Division since remote site Divison is unavailable
SET IBES=""
+22 ;Pointer to site
SET IBES=$$GET1^DIQ(351.82,EIN,3.03)
+23 SET ^TMP($JOB,"IBEXRPT",CNT)=IBPAT_"/"_IBPATNM_U_$GET(IBBN)_U_IBVSTDT_U_IBESITEN_U_IBRESN_U_IBESITE_U_IBLSTNUM_"-"_IBLSITE
+24 ; Build index to ^TMP($J,"IBEXRPT" based on Sort Criteria
+25 SET PH="BLANK"
+26 IF SORT="PAT"
SET ^TMP($JOB,"IBEXRPT","INDX",PH,IBPATNM,CNT)=""
+27 IF SORT="BN"
SET ^TMP($JOB,"IBEXRPT","INDX",PH,IBBN,CNT)=""
+28 IF SORT="ES"
Begin DoDot:2
+29 SET IBTES=$SELECT(IBESITEN'="":IBESITEN,1:" ")
+30 SET ^TMP($JOB,"IBEXRPT","INDX",IBTES,IBPATNM,CNT)=""
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
PRTRPT ; Output report to screen
+1 NEW IBREC,LOOP1,LOOP2,LOOP3,TEMP,PG,IBQUIT,IBSL,CNT,IBSITE,IBFAC,IBFACNM
+2 SET (IBQUIT,PG,CNT)=0
SET IBSL=IOSL
+3 DO SITE^IBAUTL
+4 SET IBFACNM=$$GET1^DIQ(4,IBFAC_",",.01,"E")
+5 WRITE !
+6 DO RPTHDR
+7 DO COLHDR
+8 ; Loop through Temporary index to print report using selected sort.
+9 SET LOOP1=""
+10 FOR
SET LOOP1=$ORDER(^TMP($JOB,"IBEXRPT","INDX",LOOP1))
if LOOP1=""!IBQUIT
QUIT
Begin DoDot:1
+11 SET LOOP2=""
+12 FOR
SET LOOP2=$ORDER(^TMP($JOB,"IBEXRPT","INDX",LOOP1,LOOP2))
if LOOP2=""!IBQUIT
QUIT
Begin DoDot:2
+13 SET LOOP3=""
+14 FOR
SET LOOP3=$ORDER(^TMP($JOB,"IBEXRPT","INDX",LOOP1,LOOP2,LOOP3))
if LOOP3=""!IBQUIT
QUIT
Begin DoDot:3
+15 SET CNT=CNT+1
+16 SET IBREC=^TMP($JOB,"IBEXRPT",LOOP3)
+17 IF 'IBEXCEL
WRITE !,$EXTRACT($PIECE(IBREC,U,7),1,25),?27,$EXTRACT($PIECE($PIECE(IBREC,U,1),"/",2),1,20),?50,$$FMTE^XLFDT($PIECE(IBREC,U,3),"5DZ"),?62,$PIECE(IBREC,U,2),?76,$PIECE(IBREC,U,6)_"-"_$PIECE(IBREC,U,4),?103,$EXTRACT($P
IECE(IBREC,U,5),1,20)
+18 IF IBEXCEL
WRITE !,$EXTRACT($PIECE(IBREC,U,7),1,25),"^",$EXTRACT($PIECE($PIECE(IBREC,U,1),"/",2),1,20),"^",$$FMTE^XLFDT($PIECE(IBREC,U,3),"5DZ"),"^",$PIECE(IBREC,U,2),"^",$PIECE(IBREC,U,6)_"-"_$PIECE(IBREC,U,4),"^",$EXTRACT($PI
ECE(IBREC,U,5),1,20)
+19 IF $ORDER(^TMP($JOB,"IBEXRPT","INDX",LOOP1,LOOP2,LOOP3))
DO CHKSTOP
End DoDot:3
End DoDot:2
End DoDot:1
+20 IF IBQUIT
QUIT
+21 ;Only do PAUSE if not queued
IF '$DATA(ZTQUEUED)
DO PAUSE(1)
+22 QUIT
+23 ;
RPTHDR ; Prints the report header
+1 NEW PRTFLTBY,FBCNT,TEMP,ITEM,MAX
+2 SET PG=PG+1
+3 IF 'IBEXCEL
WRITE !,"Urgent Care Exception Report ",$$FMTE^XLFDT(DT,"5DZ"),?72,"Page "_PG
+4 IF IBEXCEL
WRITE !,"Urgent Care Exception Report ","^",$$FMTE^XLFDT(DT,"5DZ")
+5 IF 'IBEXCEL
WRITE !,"For Site: ",IBSITE," ",IBFACNM
+6 IF IBEXCEL
WRITE !,"For Site: ","^",IBSITE," ",IBFACNM
+7 IF IBFLTRBY'=""
SET PRTFLTBY=""
SET TEMP=$EXTRACT(IBFLTRBY,2,$LENGTH(IBFLTRBY)-1)
SET MAX=$LENGTH(TEMP,"/")
FOR FBCNT=1:1:MAX
Begin DoDot:1
+8 SET ITEM=$PIECE(TEMP,"/",FBCNT)
SET ITEM=$PIECE(ITEM,"-",2)
+9 SET PRTFLTBY=PRTFLTBY_ITEM
IF FBCNT<MAX
SET PRTFLTBY=PRTFLTBY_"/"
End DoDot:1
+10 IF 'IBEXCEL
Begin DoDot:1
+11 WRITE !,"Filtered by: "
IF IBFLTRBY'=""
IF (IBFLTRBY'="/")
IF (IBFLTRBY'="//")
WRITE PRTFLTBY
+12 WRITE " ","Sorted by: ",$SELECT(SORT="BN":"Bill Number",SORT="ES":"Exception Site/Division",1:"Patient"),!
End DoDot:1
+13 IF IBEXCEL
Begin DoDot:1
+14 WRITE !,"Filtered by:^"
IF IBFLTRBY'=""
IF (IBFLTRBY'="/")
IF (IBFLTRBY'="//")
WRITE PRTFLTBY
+15 WRITE "^Sorted by:^",$SELECT(SORT="BN":"Bill Number",SORT="ES":"Exception Site/Division",1:"Patient"),!
End DoDot:1
+16 QUIT
+17 ;
COLHDR ; Prints the header for the colums in the report. Report is 115 characters wide
+1 NEW S,V,IBI,DASH
+2 IF 'IBEXCEL
WRITE !,"Division",?27,"Patient Name",?50,"Visit Dt",?62,"Bill Number",?76,"Exception Site",?103,"Reason"
+3 IF IBEXCEL
WRITE !,"Division","^","Patient Name","^","Visit Dt","^","Bill Number","^","Exception Site","^","Reason"
+4 IF 'IBEXCEL
SET DASH=""
SET $PIECE(DASH,"-",124)=""
WRITE !,DASH
+5 QUIT
+6 ;
ASKDEV ; Ask about output device and print the report (or run task)
+1 NEW %ZIS,POP
+2 WRITE !!,"The report requires 132 columns."
+3 SET %ZIS="QM"
+4 ; Quit and ask for device again if invalid entry.
DO ^%ZIS
if POP
QUIT
+5 IF IOSL<7
WRITE !,"Screen length set to ",IOSL," cannot be less than 7."
GOTO ASKDEV
+6 ; If it was queued
+7 IF $GET(IO)=""
SET IBQUIT=1
QUIT
+8 IF $DATA(IO("Q"))
DO RUNTASK
QUIT
+9 ; Generate report directly
USE IO
DO REPORT1^IBUCERP
+10 ; Close the device
DO ^%ZISC
+11 QUIT
+12 ;
RUNTASK ; Start Taskman job
+1 NEW ZTRTN,ZTSK,IBVAR,ZTSAVE,ZTDESC
+2 SET ZTRTN="REPORT1^IBUCERP"
SET ZTDESC="IB Urgent Care Exception Report"
+3 FOR IBVAR="IBFLTRBY","SORT","ZTQUEUED"
SET ZTSAVE(IBVAR)=""
+4 DO ^%ZTLOAD
+5 IF $GET(ZTSK)
WRITE !!,"This request has been queued. The task number is "_ZTSK_"."
+6 IF '$TEST
WRITE !!,"Unable to queue this job."
+7 KILL ZTQUEUED
+8 DO HOME^%ZIS
WRITE !
+9 QUIT
+10 ;
CHKSTOP ;
+1 IF CNT>=(IBSL-8)
Begin DoDot:1
+2 IF '$DATA(ZTQUEUED)
DO PAUSE(0)
+3 ;Reset CNT if header prints
SET CNT=0
+4 DO RPTHDR
+5 DO COLHDR
End DoDot:1
+6 QUIT
+7 ;
PAUSE(IBEND) ;
+1 if $EXTRACT(IOST,1,2)'["C-"
QUIT
+2 NEW X,Y,IBJ,DIR,DA,DIRUT,DTOUT,DUOUT,DIROUT
+3 SET $Y=0
+4 IF $GET(IBEND)
WRITE !,"End of the report."
+5 SET DIR(0)="E"
+6 SET DIR("A")="Type <Enter> to continue or '^' to exit"
+7 DO ^DIR
KILL DIR
IF $GET(DUOUT)
SET IBQUIT=1
WRITE @IOF
QUIT
+8 WRITE @IOF
+9 QUIT
+10 ;
EXCMSG ; - Displays the message about capturing to an Excel file format
+1 ;
+2 WRITE !!?5,"To capture as an Excel format, it is recommended that you queue this"
+3 WRITE !?5,"report to a spool device with margins of 256 and page length of 99999"
+4 WRITE !?5,"(e.g. 0;256;99999). This should help avoid wrapping problems."
+5 WRITE !!?5,"Another method would be to set up your terminal to capture the detail"
+6 WRITE !?5,"report data. On some terminals, this can be done by invoking 'Logging'"
+7 WRITE !?5,"or clicking on the 'Tools' menu above, then click on 'Capture Incoming "
+8 WRITE !?5,"Data' to save to Desktop. To avoid undesired wrapping of the data saved"
+9 WRITE !?5,"to the file, change the DISPLAY screen width size to 132 and you can"
+10 WRITE !?5,"enter '0;256;99999' at the 'DEVICE:' prompt.",!
+11 QUIT
+12 ; ========================================================================
