IBCNQ1 ;ALB/CPM - OUTPATIENT VISIT DATE INQUIRY ; 31-JUL-91
;;2.0; INTEGRATED BILLING ;**199**; 21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;MAP TO DGCRNQ1
;
D HOME^%ZIS
ASKPAT ;
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBCNQ1" D T1^%ZOSV ;stop rt clock
;S XRTL=$ZU(0),XRTN="IBCNQ1-1" D T0^%ZOSV ;start rt clock
N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
D END S DIC="^DPT(",DIC(0)="AEMQZ" W ! D ^DIC K DIC G:+Y<1 END
S DFN=+Y I '$O(^DGCR(399,"AOPV",DFN,"")) W !!,"This patient has no bills with OP visits. Please enter another patient." G ASKPAT
;
S IBQUIT=0,IBAC=78
ASKDAT S DIR("A")="Select OP Visit Date",DIR(0)="DO^::EX^K:'$D(^DGCR(399,""AOPV"",DFN,Y)) X"
S DIR("?",1)="Please enter a valid Outpatient Visit date for this patient.",DIR("?")="Enter '??' to list valid dates and bill numbers.",DIR("??")="^D HELP^IBCNQ1"
D ^DIR K DIR G:Y<1 END
S X=$O(^DGCR(399,"AOPV",DFN,Y,0)) I '$O(^DGCR(399,"AOPV",DFN,Y,X)) S IBIFN=X
I '$D(IBIFN) D LIST K IBARR G END:IBQUIT
I $D(IBIFN) D VIEW^IBCNQ ; Display bill record
G ASKPAT:'IBQUIT
;
END K DFN,IBQUIT,DGI,DGX,DGY,IBS,IBNUM,IBAC,IB,IBBNO,IBN,IBU,IBUK,IBUN,IBX,IBSTAT,IBAC1,IBIFN,IBOPD,IBNOW,IBPAGE,IBPT,J,X,X2,Y
;***
;I $D(XRT0) S:'$D(XRTN) XRTN="IBCNQ1" D T1^%ZOSV ;stop rt clock
Q
;
LIST ; If multiple bills for an OP visit date, list them.
W !!?5,"Select one of the following bills for this visit date:"
;
S DGI=0
F J=1:1 S DGI=$O(^DGCR(399,"AOPV",DFN,Y,DGI)) Q:'DGI S IBARR(J)=DGI W !?12,J D DISP,ASKNUM:'(J#5) G:IBQUIT!($D(IBIFN)) LQ
I '((J-1)#5) W !!?5,"End of list.",!
ASKNUM W !?5,"Select 1-"_$S(J#5:J-1,1:J)_", or type '^' to quit: " R DGX:DTIME S:'$T!(DGX["^") IBQUIT=1 Q:IBQUIT!(DGX="") I +DGX<1!(+DGX>$S(J#5:J-1,1:J)) W !!?5,*7,"Enter a NUMBER from 1 to "_$S(J#5:J-1,1:J)_".",! G ASKNUM
I $D(IBARR(DGX)) S IBIFN=IBARR(DGX)
LQ Q
;
HELP ; List all OP visit dates and bill numbers for patient.
W !!?5,"Enter one of the following OP visit dates: ",!
S (DGY,Y)="",J=0 F S Y=$O(^DGCR(399,"AOPV",DFN,Y)) Q:'Y!(DGY["^") S DGX="" F S DGX=$O(^DGCR(399,"AOPV",DFN,Y,DGX)) Q:'DGX S J=J+1 D:'(J#20) PAUSE Q:DGY["^" W !?5,$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_$E(Y,2,3) S DGI=DGX D DISP
Q
;
PAUSE W !!?5,"Enter '^' to stop or <CR> to continue: " R DGY:DTIME S:'$T DGY="^"
W:DGY'["^" ! Q
;
DISP ; Write the bill number, rate type, and bill status.
Q:'$D(^DGCR(399,DGI,0)) S IBS=$P(^(0),"^",13) W ?20,$P(^(0),"^"),?30,$P($G(^DGCR(399.3,+$P(^(0),"^",7),0)),"^")
W ?55,$S(IBS=1:"ENTERED/NOT REVIEWED",IBS=2:"REVIEWED",IBS=3:"AUTHORIZED",IBS=4:"PRINTED",IBS=7:"CANCELLED",IBS=0:"CLOSED",1:"")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNQ1 2674 printed Dec 13, 2024@02:16:09 Page 2
IBCNQ1 ;ALB/CPM - OUTPATIENT VISIT DATE INQUIRY ; 31-JUL-91
+1 ;;2.0; INTEGRATED BILLING ;**199**; 21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;MAP TO DGCRNQ1
+5 ;
+6 DO HOME^%ZIS
ASKPAT ;
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCNQ1" D T1^%ZOSV ;stop rt clock
+3 ;S XRTL=$ZU(0),XRTN="IBCNQ1-1" D T0^%ZOSV ;start rt clock
+4 ;Suppress PATIENT file fuzzy lookups
NEW DPTNOFZY
SET DPTNOFZY=1
+5 DO END
SET DIC="^DPT("
SET DIC(0)="AEMQZ"
WRITE !
DO ^DIC
KILL DIC
if +Y<1
GOTO END
+6 SET DFN=+Y
IF '$ORDER(^DGCR(399,"AOPV",DFN,""))
WRITE !!,"This patient has no bills with OP visits. Please enter another patient."
GOTO ASKPAT
+7 ;
+8 SET IBQUIT=0
SET IBAC=78
ASKDAT SET DIR("A")="Select OP Visit Date"
SET DIR(0)="DO^::EX^K:'$D(^DGCR(399,""AOPV"",DFN,Y)) X"
+1 SET DIR("?",1)="Please enter a valid Outpatient Visit date for this patient."
SET DIR("?")="Enter '??' to list valid dates and bill numbers."
SET DIR("??")="^D HELP^IBCNQ1"
+2 DO ^DIR
KILL DIR
if Y<1
GOTO END
+3 SET X=$ORDER(^DGCR(399,"AOPV",DFN,Y,0))
IF '$ORDER(^DGCR(399,"AOPV",DFN,Y,X))
SET IBIFN=X
+4 IF '$DATA(IBIFN)
DO LIST
KILL IBARR
if IBQUIT
GOTO END
+5 ; Display bill record
IF $DATA(IBIFN)
DO VIEW^IBCNQ
+6 if 'IBQUIT
GOTO ASKPAT
+7 ;
END KILL DFN,IBQUIT,DGI,DGX,DGY,IBS,IBNUM,IBAC,IB,IBBNO,IBN,IBU,IBUK,IBUN,IBX,IBSTAT,IBAC1,IBIFN,IBOPD,IBNOW,IBPAGE,IBPT,J,X,X2,Y
+1 ;***
+2 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBCNQ1" D T1^%ZOSV ;stop rt clock
+3 QUIT
+4 ;
LIST ; If multiple bills for an OP visit date, list them.
+1 WRITE !!?5,"Select one of the following bills for this visit date:"
+2 ;
+3 SET DGI=0
+4 FOR J=1:1
SET DGI=$ORDER(^DGCR(399,"AOPV",DFN,Y,DGI))
if 'DGI
QUIT
SET IBARR(J)=DGI
WRITE !?12,J
DO DISP
if '(J#5)
DO ASKNUM
if IBQUIT!($DATA(IBIFN))
GOTO LQ
+5 IF '((J-1)#5)
WRITE !!?5,"End of list.",!
ASKNUM WRITE !?5,"Select 1-"_$SELECT(J#5:J-1,1:J)_", or type '^' to quit: "
READ DGX:DTIME
if '$TEST!(DGX["^")
SET IBQUIT=1
if IBQUIT!(DGX="")
QUIT
IF +DGX<1!(+DGX>$SELECT(J#5:J-1,1:J))
WRITE !!?5,*7,"Enter a NUMBER from 1 to "_$SELECT(J#5:J-1,1:J)_".",!
GOTO ASKNUM
+1 IF $DATA(IBARR(DGX))
SET IBIFN=IBARR(DGX)
LQ QUIT
+1 ;
HELP ; List all OP visit dates and bill numbers for patient.
+1 WRITE !!?5,"Enter one of the following OP visit dates: ",!
+2 SET (DGY,Y)=""
SET J=0
FOR
SET Y=$ORDER(^DGCR(399,"AOPV",DFN,Y))
if 'Y!(DGY["^")
QUIT
SET DGX=""
FOR
SET DGX=$ORDER(^DGCR(399,"AOPV",DFN,Y,DGX))
if 'DGX
QUIT
SET J=J+1
if '(J#20)
DO PAUSE
if DGY["^"
QUIT
WRITE !?5,$EXTRACT(Y,4,5)_"-"_$EXTRACT(Y,6,7)_"-"_$EXTRACT(Y,2,3)
SET DGI=DGX
DO DISP
+3 QUIT
+4 ;
PAUSE WRITE !!?5,"Enter '^' to stop or <CR> to continue: "
READ DGY:DTIME
if '$TEST
SET DGY="^"
+1 if DGY'["^"
WRITE !
QUIT
+2 ;
DISP ; Write the bill number, rate type, and bill status.
+1 if '$DATA(^DGCR(399,DGI,0))
QUIT
SET IBS=$PIECE(^(0),"^",13)
WRITE ?20,$PIECE(^(0),"^"),?30,$PIECE($GET(^DGCR(399.3,+$PIECE(^(0),"^",7),0)),"^")
+2 WRITE ?55,$SELECT(IBS=1:"ENTERED/NOT REVIEWED",IBS=2:"REVIEWED",IBS=3:"AUTHORIZED",IBS=4:"PRINTED",IBS=7:"CANCELLED",IBS=0:"CLOSED",1:"")
+3 QUIT
