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

IBUCERP.m

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