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

IBUCSP1.m

Go to the documentation of this file. 
  1. IBUCSP1 ;ALB/SAB-URGENT CARE SINGLE PATIENT PROFILE ; 29-NOV-19
  1.  ;;2.0;INTEGRATED BILLING;**663,671**;21-MAR-94;Build 13
  1.  ;; Per VHA Directive 6402, this routine should not be modified
  1.  ;
  1.  Q
  1.  ;
  1.  ; Prints report to the current device
  1.  ;
  1.  ; Input:
  1.  ;   IBDFN - Patient IEN
  1.  ;   IBCLK - LTC Copay Billing Clock IEN
  1.  ;   IBDT1 - Beginning date
  1.  ;   IBDT2 - Ending date
  1.  ; Output:
  1.  ;   IBQUIT = 1, if user entered "^" (Devices starting with "C-" only)
  1. REPORT ;
  1.  N IBDT,IBVSIEN,IBDATA,IBYR,IBSQNO,IBI
  1.  N IBSITE,IBSTAT,IBBLNO,IBREAS
  1.  S IBQUIT=0
  1.  ;
  1.  ;Gather the visits within the year range into to a sorted temporary array
  1.  S IBVSIEN=0
  1.  F  S IBVSIEN=$O(^IBUC(351.82,"B",IBDFN,IBVSIEN)) Q:'IBVSIEN  D
  1.  . S IBDATA=$G(^IBUC(351.82,IBVSIEN,0)),IBDT=$P(IBDATA,U,3)
  1.  . ;convert date to year format for comparison.
  1.  . S IBYR=$E(IBDT,1,3)+1700
  1.  . Q:IBYR<IBDT1    ; Visit date before year range start
  1.  . Q:IBYR>IBDT2    ; Visit date after year range end
  1.  . ; find visit number so we don't overwrite multiple visits on same day
  1.  . S (IBSQNO,IBI)=0 F  S IBI=$O(^TMP($J,"IBUCSP",IBYR,IBDT,IBI)) Q:'IBI  Q:'$D(^TMP($J,"IBUCSP",IBYR,IBDT,IBI))  S (IBI,IBSQNO)=IBSQNO+1
  1.  . S IBSQNO=IBSQNO+1
  1.  . ;CONVERT THE POINTER AND CODES TO TEXTINFO TO TEXT.
  1.  . S IBSITE=$$GET1^DIQ(351.82,IBVSIEN_",",.02,"E")
  1.  . S IBSTAT=$$GET1^DIQ(351.82,IBVSIEN_",",.04,"E")
  1.  . S IBBLNO=$P(IBDATA,U,5)
  1.  . S IBREAS=$$GET1^DIQ(351.82,IBVSIEN_",",.06,"E")
  1.  . S ^TMP($J,"IBUCSP",IBYR,IBDT,IBSQNO)=IBDT_U_$E(IBSITE,1,18)_U_IBSTAT_U_IBBLNO_U_IBREAS
  1.  ;
  1.  D PRINT
  1.  K ^TMP($J,"IBUCSP")
  1.  S:$D(ZTQUEUED) ZTREQ="@" ; for Taskman
  1.  Q
  1.  ;
  1. PRINT ; Print report from the temp. global  (cONVERT TO EXTERNAL DATA)
  1.  N IBDTH,IBLINE,IBPAG,IBYR,IBDT,IBSQNO,IBDATA,IBH,IBPT
  1.  D NOW^%DTC S IBDTH=$$FMTE^XLFDT($E(%,1,12))
  1.  S IBLINE="",$P(IBLINE,"=",IOM+1)="",(IBPAG,IBQUIT)=0
  1.  S IBPT=$$PT^IBEFUNC(IBDFN)
  1.  S IBH="Urgent Care Visit Profile for "_$P(IBPT,U) D HDR
  1.  I '$D(^TMP($J,"IBUCSP")) W !!,"The patient has no Urgent Care Visits within the specified period" D PAUSE(1) Q
  1.  S IBYR=0
  1.  F  S IBYR=$O(^TMP($J,"IBUCSP",IBYR)) Q:'IBYR  D  Q:IBQUIT
  1.  . S IBDT=0
  1.  . W !,IBYR,!,"----"
  1.  . F  S IBDT=$O(^TMP($J,"IBUCSP",IBYR,IBDT)) Q:IBDT=""  D  Q:IBQUIT
  1.  . . D CHKSTOP    ; Pause at the end of each screen page.  Allow user to exit.  Returns IBQUIT
  1.  . . Q:IBQUIT
  1.  . . S IBSQNO=0
  1.  . . F  S IBSQNO=$O(^TMP($J,"IBUCSP",IBYR,IBDT,IBSQNO)) Q:IBSQNO=""  D  Q:IBQUIT
  1.  . . . D CHKSTOP    ; Pause at the end of each screen page.  Allow user to exit.  Returns IBQUIT
  1.  . . . Q:IBQUIT
  1.  . . . S IBDATA=$G(^TMP($J,"IBUCSP",IBYR,IBDT,IBSQNO))
  1.  . . . Q:$G(IBDATA)=""
  1.  . . . W !,$$FMTE^XLFDT($P(IBDATA,U,1)),?15,$P(IBDATA,U,2),?35,$P(IBDATA,U,3),?47,$P(IBDATA,U,4),?60,$P(IBDATA,U,5)
  1.  . ; print a separator between years.
  1.  . W !
  1.  Q:IBQUIT
  1.  D PAUSE(1)
  1.  Q
  1. CHKSTOP I $Y>(IOSL-5) D PAUSE(0) Q:IBQUIT  D HDR
  1.  Q
  1.  ;
  1. HDR ; Print header.
  1.  N IBI
  1.  I $E(IOST,1,2)["C-"!(IBPAG) W @IOF,*13
  1.  S IBPAG=IBPAG+1 W ?(80-$L(IBH)\2),IBH
  1.  W !,"From ",IBDT1," through ",IBDT2
  1.  W ?IOM-36,IBDTH,?IOM-9,"Page: ",IBPAG
  1.  W !,"VISIT DATE",?15,"SITE",?35,"STATUS",?47,"BILL NO.",?60,"REASON"
  1.  W ! F IBI=1:1:80 W "-"
  1.  Q
  1.  ;
  1. PAUSE(IBEND) ;
  1.  Q:$E(IOST,1,2)'["C-"
  1.  N IBJ,DIR,DIRUT,DTOUT,DUOUT,DIROUT,Y
  1.  W !! ;F IBJ=$Y:1:(IOSL-4) W !
  1.  S DIR(0)="E"
  1.  I $G(IBEND) S DIR("A")="End of the report. Enter RETURN to continue or '^' to exit"
  1.  D ^DIR K DIR I $G(DUOUT) S IBQUIT=1 W @IOF Q
  1.  I $G(IBEND) W @IOF
  1.  Q
  1.  ;