- IB20POST ;ALB/MAF - Post-Init to correct EABD for entries in "ATOBIL" x-ref. - Aug 7, 1997
- ;;2.0; INTEGRATED BILLING ;**81**; 21-MAR-94
- ; -- Post init to correct the Earliest Auto Biller Date (EABD).
- ; The 17th piece ^ibt(356,ifn,0) gets reset to the date the entry
- ; was entered into Claims Tracking plus the Days Delay.
- ; This is only done for PRESCRIPTION REFILLS.
- D BMES^XPDUTL("*** Correcting the Earliest Auto Billing Date (EABD) for entries in the 'ATOBIL' cross reference in Claims Tracking - Only for Prescription Refills.")
- N IBDFN,IBTYPE,IBEABD,IBDT,IBDTCT,IBDFNODE,DIC,X,IBCTDA
- S (IBDFN,IBTYPE,IBDT,IBEABD,IBCTDA)=0
- F S IBDFN=$O(^IBT(356,"ATOBIL",IBDFN)) Q:'IBDFN S IBTYPE=$O(^IBE(356.6,"B","PRESCRIPTION REFILL",0)) D
- .F S IBDT=$O(^IBT(356,"ATOBIL",IBDFN,IBTYPE,IBDT)) Q:'IBDT F S IBCTDA=$O(^IBT(356,"ATOBIL",IBDFN,IBTYPE,IBDT,IBCTDA)) Q:'IBCTDA D
- ..S IBDFNODE=$G(^IBT(356,IBCTDA,0)),IBDTCT=$S(+$G(^IBT(356,IBCTDA,1))]"":+^IBT(356,IBCTDA,1),1:$P(IBDFNODE,"^",6))
- ..S IBEABD=$$EABD(IBTYPE,IBDTCT)
- ..S DIE="^IBT(356,",DA=IBCTDA,DR=".17////"_IBEABD
- ..D ^DIE K DA,DIE,DR
- ..Q
- I '$D(^IBT(356,"ATOBIL")) D BMES^XPDUTL("*** There are no EABD cross references to correct ***")
- D BMES^XPDUTL("DONE")
- Q
- EABD(IBETYP,IBTDT) ; -- compute earliest auto bill date: date entered plus days delay for event type
- ;the difference betwieen this and EABD^IBTUTL is that the autobill of the event type may be turned off
- ;and this procedure will still return a date
- ; -- input IBETYPE = pointer to type of entry file
- ; IBTDT = episode date, if not passed in uses DT
- ;
- N X,X1,X2,Y,IBETYPD S Y="" I '$G(IBETYP) G EABDQ
- S IBETYPD=$G(^IBE(356.6,+IBETYP,0)) I '$G(IBTDT) S IBTDT=DT
- S X2=+$P(IBETYPD,"^",6) ;set earliest autobill date to entered date plus days delay
- S X1=IBTDT D C^%DTC S Y=X\1
- EABDQ Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20POST 1875 printed Mar 13, 2025@21:09:54 Page 2
- IB20POST ;ALB/MAF - Post-Init to correct EABD for entries in "ATOBIL" x-ref. - Aug 7, 1997
- +1 ;;2.0; INTEGRATED BILLING ;**81**; 21-MAR-94
- +2 ; -- Post init to correct the Earliest Auto Biller Date (EABD).
- +3 ; The 17th piece ^ibt(356,ifn,0) gets reset to the date the entry
- +4 ; was entered into Claims Tracking plus the Days Delay.
- +5 ; This is only done for PRESCRIPTION REFILLS.
- +6 DO BMES^XPDUTL("*** Correcting the Earliest Auto Billing Date (EABD) for entries in the 'ATOBIL' cross reference in Claims Tracking - Only for Prescription Refills.")
- +7 NEW IBDFN,IBTYPE,IBEABD,IBDT,IBDTCT,IBDFNODE,DIC,X,IBCTDA
- +8 SET (IBDFN,IBTYPE,IBDT,IBEABD,IBCTDA)=0
- +9 FOR
- SET IBDFN=$ORDER(^IBT(356,"ATOBIL",IBDFN))
- if 'IBDFN
- QUIT
- SET IBTYPE=$ORDER(^IBE(356.6,"B","PRESCRIPTION REFILL",0))
- Begin DoDot:1
- +10 FOR
- SET IBDT=$ORDER(^IBT(356,"ATOBIL",IBDFN,IBTYPE,IBDT))
- if 'IBDT
- QUIT
- FOR
- SET IBCTDA=$ORDER(^IBT(356,"ATOBIL",IBDFN,IBTYPE,IBDT,IBCTDA))
- if 'IBCTDA
- QUIT
- Begin DoDot:2
- +11 SET IBDFNODE=$GET(^IBT(356,IBCTDA,0))
- SET IBDTCT=$SELECT(+$GET(^IBT(356,IBCTDA,1))]"":+^IBT(356,IBCTDA,1),1:$PIECE(IBDFNODE,"^",6))
- +12 SET IBEABD=$$EABD(IBTYPE,IBDTCT)
- +13 SET DIE="^IBT(356,"
- SET DA=IBCTDA
- SET DR=".17////"_IBEABD
- +14 DO ^DIE
- KILL DA,DIE,DR
- +15 QUIT
- End DoDot:2
- End DoDot:1
- +16 IF '$DATA(^IBT(356,"ATOBIL"))
- DO BMES^XPDUTL("*** There are no EABD cross references to correct ***")
- +17 DO BMES^XPDUTL("DONE")
- +18 QUIT
- EABD(IBETYP,IBTDT) ; -- compute earliest auto bill date: date entered plus days delay for event type
- +1 ;the difference betwieen this and EABD^IBTUTL is that the autobill of the event type may be turned off
- +2 ;and this procedure will still return a date
- +3 ; -- input IBETYPE = pointer to type of entry file
- +4 ; IBTDT = episode date, if not passed in uses DT
- +5 ;
- +6 NEW X,X1,X2,Y,IBETYPD
- SET Y=""
- IF '$GET(IBETYP)
- GOTO EABDQ
- +7 SET IBETYPD=$GET(^IBE(356.6,+IBETYP,0))
- IF '$GET(IBTDT)
- SET IBTDT=DT
- +8 ;set earliest autobill date to entered date plus days delay
- SET X2=+$PIECE(IBETYPD,"^",6)
- +9 SET X1=IBTDT
- DO C^%DTC
- SET Y=X\1
- EABDQ QUIT Y
