IBYRPOST ;ALB/EMG - IB*2*70 POST-INIT ; 21-MAY-97
;;2.0; INTEGRATED BILLING ;**70**; 21-MAR-94
;
EN ; Patch IB*2*70 post initialization.
;
D OGEN ; output generator for post init
Q
;
OGEN ; set up check points for post init
N %,Z
S %=$$NEWCP^XPDUTL("HOLD","HOLD^IBYRPOST")
S %=$$NEWCP^XPDUTL("DAYS","DAYS^IBYRPOST")
S %=$$NEWCP^XPDUTL("DATE","DATE^IBYRPOST")
S %=$$NEWCP^XPDUTL("REL","REL^IBYRPOST")
Q
;
HOLD ; modify IB ACTION TYPE entries - place on hold
N DONE,S1,Z,Z1
S DONE=" >>> Step complete <<<"
D BMES^XPDUTL(" <<< Updating IB Action Type file (350.1) >>>")
S S1=0 F S S1=$O(^IBE(350.1,S1)) Q:'S1 S Z=$G(^IBE(350.1,S1,0)),Z1=$P(Z,U,11) D
.I Z1'=""&(Z1<6) S $P(^IBE(350.1,S1,0),U,10)=1 Q
D MES^XPDUTL(DONE)
Q
;
DAYS ; set NUMBER OF DAYS PT CHARGES HELD field (#7.04) in file #350.9
N DONE,S1,Z,Z1
S DONE=" >>> Step complete <<<"
D BMES^XPDUTL(" <<< Setting Number of Days Pt Charges Held in file (350.9) >>>")
S $P(^IBE(350.9,1,7),U,4)=90
D MES^XPDUTL(DONE)
Q
;
DATE ; find charges on hold & related 3rd party bills
; set ON HOLD DATE to either:
; - date entry added to file #350
; - authorization date of 3rd party bill
;
N DONE,IBDEA,IBADT,IBOHDT,IBNAME,IBN,DFN,IBNUM,FDA,DIERR
S DONE=" >>> Step complete <<<"
D BMES^XPDUTL(" <<< Setting ON HOLD DATE field in IB ACTION (#350) file >>>")
D CHRGS^IBOHLD1 ; find charges on hold
;
; set ON HOLD DATE
S (IBDEA,IBADT,IBOHDT)=0
S IBNAME="" F S IBNAME=$O(^TMP($J,"HOLD",IBNAME)) Q:IBNAME="" S DFN=0 F S DFN=$O(^TMP($J,"HOLD",IBNAME,DFN)) Q:'DFN S IBN=0 F S IBN=$O(^TMP($J,"HOLD",IBNAME,DFN,IBN)) Q:'IBN D
.S IBNUM=$P($G(^IB(IBN,0)),"^")
.S IBDEA=$P($P($G(^IB(IBN,1)),"^",2),"."),IBOHDT=IBDEA
.D BILLDT
.S FDA(350,IBN_",",16)=$S(IBOHDT:IBOHDT,1:"")
.D FILE^DIE("K","FDA")
.I $G(DIERR) D BMES^XPDUTL(" >>> Check IB Action # '"_IBNUM_". ON HOLD DATE was not set. <<<")
.Q
D MES^XPDUTL(DONE)
Q
;
BILLDT ; find authorization date for 3rd party bills
N IBADT,IBBILL
S IBBILL="" F S IBBILL=$O(^TMP($J,"HOLD",IBNAME,DFN,IBN,IBBILL)) Q:IBBILL="" D
.S IBADT=$P($G(^DGCR(399,IBBILL,"S")),"^",10)
.S IBOHDT=$S(IBADT>IBDEA:IBADT,1:IBDEA) Q:IBADT=""
.Q
Q
;
;
REL ; Auto-release entries on hold for more than 90 days
N DONE
S DONE=" >>> Step Complete <<<."
D BMES^XPDUTL(" ")
D BMES^XPDUTL(" <<< Releasing IB charges ON HOLD longer than 90 days >>>.")
;
D EN^IBOHRL
D MES^XPDUTL(DONE)
D MES^XPDUTL(" ** Use 'On Hold Charges Released to AR' option to see detailed **")
D MES^XPDUTL(" ** list of charges released during post-init. **")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYRPOST 2679 printed Nov 22, 2024@17:46:56 Page 2
IBYRPOST ;ALB/EMG - IB*2*70 POST-INIT ; 21-MAY-97
+1 ;;2.0; INTEGRATED BILLING ;**70**; 21-MAR-94
+2 ;
EN ; Patch IB*2*70 post initialization.
+1 ;
+2 ; output generator for post init
DO OGEN
+3 QUIT
+4 ;
OGEN ; set up check points for post init
+1 NEW %,Z
+2 SET %=$$NEWCP^XPDUTL("HOLD","HOLD^IBYRPOST")
+3 SET %=$$NEWCP^XPDUTL("DAYS","DAYS^IBYRPOST")
+4 SET %=$$NEWCP^XPDUTL("DATE","DATE^IBYRPOST")
+5 SET %=$$NEWCP^XPDUTL("REL","REL^IBYRPOST")
+6 QUIT
+7 ;
HOLD ; modify IB ACTION TYPE entries - place on hold
+1 NEW DONE,S1,Z,Z1
+2 SET DONE=" >>> Step complete <<<"
+3 DO BMES^XPDUTL(" <<< Updating IB Action Type file (350.1) >>>")
+4 SET S1=0
FOR
SET S1=$ORDER(^IBE(350.1,S1))
if 'S1
QUIT
SET Z=$GET(^IBE(350.1,S1,0))
SET Z1=$PIECE(Z,U,11)
Begin DoDot:1
+5 IF Z1'=""&(Z1<6)
SET $PIECE(^IBE(350.1,S1,0),U,10)=1
QUIT
End DoDot:1
+6 DO MES^XPDUTL(DONE)
+7 QUIT
+8 ;
DAYS ; set NUMBER OF DAYS PT CHARGES HELD field (#7.04) in file #350.9
+1 NEW DONE,S1,Z,Z1
+2 SET DONE=" >>> Step complete <<<"
+3 DO BMES^XPDUTL(" <<< Setting Number of Days Pt Charges Held in file (350.9) >>>")
+4 SET $PIECE(^IBE(350.9,1,7),U,4)=90
+5 DO MES^XPDUTL(DONE)
+6 QUIT
+7 ;
DATE ; find charges on hold & related 3rd party bills
+1 ; set ON HOLD DATE to either:
+2 ; - date entry added to file #350
+3 ; - authorization date of 3rd party bill
+4 ;
+5 NEW DONE,IBDEA,IBADT,IBOHDT,IBNAME,IBN,DFN,IBNUM,FDA,DIERR
+6 SET DONE=" >>> Step complete <<<"
+7 DO BMES^XPDUTL(" <<< Setting ON HOLD DATE field in IB ACTION (#350) file >>>")
+8 ; find charges on hold
DO CHRGS^IBOHLD1
+9 ;
+10 ; set ON HOLD DATE
+11 SET (IBDEA,IBADT,IBOHDT)=0
+12 SET IBNAME=""
FOR
SET IBNAME=$ORDER(^TMP($JOB,"HOLD",IBNAME))
if IBNAME=""
QUIT
SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN))
if 'DFN
QUIT
SET IBN=0
FOR
SET IBN=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN,IBN))
if 'IBN
QUIT
Begin DoDot:1
+13 SET IBNUM=$PIECE($GET(^IB(IBN,0)),"^")
+14 SET IBDEA=$PIECE($PIECE($GET(^IB(IBN,1)),"^",2),".")
SET IBOHDT=IBDEA
+15 DO BILLDT
+16 SET FDA(350,IBN_",",16)=$SELECT(IBOHDT:IBOHDT,1:"")
+17 DO FILE^DIE("K","FDA")
+18 IF $GET(DIERR)
DO BMES^XPDUTL(" >>> Check IB Action # '"_IBNUM_". ON HOLD DATE was not set. <<<")
+19 QUIT
End DoDot:1
+20 DO MES^XPDUTL(DONE)
+21 QUIT
+22 ;
BILLDT ; find authorization date for 3rd party bills
+1 NEW IBADT,IBBILL
+2 SET IBBILL=""
FOR
SET IBBILL=$ORDER(^TMP($JOB,"HOLD",IBNAME,DFN,IBN,IBBILL))
if IBBILL=""
QUIT
Begin DoDot:1
+3 SET IBADT=$PIECE($GET(^DGCR(399,IBBILL,"S")),"^",10)
+4 SET IBOHDT=$SELECT(IBADT>IBDEA:IBADT,1:IBDEA)
if IBADT=""
QUIT
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
+8 ;
REL ; Auto-release entries on hold for more than 90 days
+1 NEW DONE
+2 SET DONE=" >>> Step Complete <<<."
+3 DO BMES^XPDUTL(" ")
+4 DO BMES^XPDUTL(" <<< Releasing IB charges ON HOLD longer than 90 days >>>.")
+5 ;
+6 DO EN^IBOHRL
+7 DO MES^XPDUTL(DONE)
+8 DO MES^XPDUTL(" ** Use 'On Hold Charges Released to AR' option to see detailed **")
+9 DO MES^XPDUTL(" ** list of charges released during post-init. **")
+10 QUIT
+11 ;
