Routine: IBOHCR

IBOHCR ;ALB/ARH - RELEASE/UPDATE A PATIENTS CHARGES ON HOLD ; MAY 2 1997

 ;;2.0;INTEGRATED BILLING;**82**;21-MAR-94

PTHLD(DFN,IBACT,IBTALK) ; search for all charges on hold due to insurance for a specific patient then update the On Hold Date or release charges

 ;  Input:   DFN:    pointer to the patient in file #2

 ;           IBACT:  1 if ON HOLD DATE should be updated with todays date

 ;                   2 if charges should be immediately released

 ;           IBTALK: true if error message can be printed to screen

 ;  Returns: 1 if On Hold charges were found and processed

 N X,Y,IBPFN,IBX,IBRTN S IBRTN=""

 I '$G(DFN)!('$G(IBACT)) G EXIT

 ; find all charges on hold for patient then complete action

 S IBPFN=0 F  S IBPFN=$O(^IB("AH",DFN,IBPFN)) Q:'IBPFN  D

 . S IBX=$G(^IB(IBPFN,0)) I $P(IBX,U,5)'=8 Q

 . I IBACT=1 D HLDDT(IBPFN)

 . I IBACT=2 D RELEASE(IBPFN)

 . S IBRTN=1

EXIT Q IBRTN

HLDDT(IBPFN) ; update a charge's on hold date to today

 N IBX,IBY,IBERR

 S IBX=$G(^IB(IBPFN,0)) I $P(IBX,U,5)'=8 Q

 I $P($G(^IB(IBPFN,1)),U,6)>DT Q

 S IBY(350,IBPFN_",",16)=DT D FILE^DIE("K","IBY")

RELEASE(IBPFN) ; release a charge on hold

 N IBX,IBSEQNO,IBDUZ,IBNOS,DFN,Y

 S IBX=$G(^IB(IBPFN,0)) I $P(IBX,U,5)'=8 Q

 S IBSEQNO=1,IBDUZ=DUZ,IBNOS=IBPFN,DFN=+$P(IBX,U,2) D ^IBR

 I $G(Y)<1,+$G(IBTALK),'$D(ZTQUEUED) W !,?5,"Error encountered - a separate bulletin has been posted."

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOHCR   1449     printed  Apr 09, 2024@21:21:25                                                                                                                                                                                                      Page 2

IBOHCR    ;ALB/ARH - RELEASE/UPDATE A PATIENTS CHARGES ON HOLD ; MAY 2 1997

 +1       ;;2.0;INTEGRATED BILLING;**82**;21-MAR-94

 +2       ;

PTHLD(DFN,IBACT,IBTALK) ; search for all charges on hold due to insurance for a specific patient then update the On Hold Date or release charges

 +1       ;

 +2       ;  Input:   DFN:    pointer to the patient in file #2

 +3       ;           IBACT:  1 if ON HOLD DATE should be updated with todays date

 +4       ;                   2 if charges should be immediately released

 +5       ;           IBTALK: true if error message can be printed to screen

 +6       ;

 +7       ;  Returns: 1 if On Hold charges were found and processed

 +8       ;

 +9        NEW X,Y,IBPFN,IBX,IBRTN

           SET IBRTN=""

 +10       IF '$GET(DFN)!('$GET(IBACT))

               GOTO EXIT

 +11      ;

 +12      ; find all charges on hold for patient then complete action

 +13       SET IBPFN=0

FOR

               SET IBPFN=$ORDER(^IB("AH",DFN,IBPFN))

               if 'IBPFN

                   QUIT

               Begin DoDot:1

 +14               SET IBX=$GET(^IB(IBPFN,0))

                   IF $PIECE(IBX,U,5)'=8

                       QUIT

 +15               IF IBACT=1

                       DO HLDDT(IBPFN)

 +16               IF IBACT=2

                       DO RELEASE(IBPFN)

 +17               SET IBRTN=1

               End DoDot:1

 +18      ;

EXIT       QUIT IBRTN

 +1       ;

HLDDT(IBPFN) ; update a charge's on hold date to today

 +1        NEW IBX,IBY,IBERR

 +2        SET IBX=$GET(^IB(IBPFN,0))

           IF $PIECE(IBX,U,5)'=8

               QUIT

 +3        IF $PIECE($GET(^IB(IBPFN,1)),U,6)>DT

               QUIT

 +4       ;

 +5        SET IBY(350,IBPFN_",",16)=DT

           DO FILE^DIE("K","IBY")

 +6        QUIT

 +7       ;

RELEASE(IBPFN) ; release a charge on hold

 +1        NEW IBX,IBSEQNO,IBDUZ,IBNOS,DFN,Y

 +2        SET IBX=$GET(^IB(IBPFN,0))

           IF $PIECE(IBX,U,5)'=8

               QUIT

 +3       ;

 +4        SET IBSEQNO=1

           SET IBDUZ=DUZ

           SET IBNOS=IBPFN

           SET DFN=+$PIECE(IBX,U,2)

           DO ^IBR

 +5        IF $GET(Y)<1

               IF +$GET(IBTALK)

                   IF '$DATA(ZTQUEUED)

                       WRITE !,?5,"Error encountered - a separate bulletin has been posted."

 +6        QUIT

IBOHCR.m