- IB2P562A ;ALB/BG - SPECIAL INP BILLING MENU OPTION;3/21/16
- ;;2.0;INTEGRATED BILLING;**562**;21-MAR-94;Build 10
- ;;Per VA Directive 6402, this routine should not be modified
- ;
- Q
- ;
- ;updating discharge dates missing in file IBE(351.2)
- ;
- UPDATE ;file update
- N IBCT,IBPTF,IBDPTF,IBDDT
- S IBCT=0 F S IBCT=$O(^IBE(351.2,IBCT)) Q:'IBCT I $P($G(^IBE(351.2,IBCT,0)),"^",5)'=2 D
- .S IBPTF=$P($G(^IBE(351.2,IBCT,0)),"^",2) Q:'IBPTF
- .Q:$P($G(^DGPM(IBPTF,0)),"^",17)=""
- .S IBDPTF=$P($G(^DGPM(IBPTF,0)),"^",17),IBDDT=$P($G(^DGPM(IBDPTF,0)),"^")
- .N DA,DIE,DR
- .S DR=".05////2;.06////"_IBDDT_";2.03////"_DUZ_";2.04///NOW"
- .S DA=IBCT,DIE="^IBE(351.2," D ^DIE
- W !,"File Update Complete"
- W !,"Please review records using the List Special Inpatient Billing Cases Menu Option",!!
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB2P562A 801 printed Mar 13, 2025@21:10:32 Page 2
- IB2P562A ;ALB/BG - SPECIAL INP BILLING MENU OPTION;3/21/16
- +1 ;;2.0;INTEGRATED BILLING;**562**;21-MAR-94;Build 10
- +2 ;;Per VA Directive 6402, this routine should not be modified
- +3 ;
- +4 QUIT
- +5 ;
- +6 ;updating discharge dates missing in file IBE(351.2)
- +7 ;
- UPDATE ;file update
- +1 NEW IBCT,IBPTF,IBDPTF,IBDDT
- +2 SET IBCT=0
- FOR
- SET IBCT=$ORDER(^IBE(351.2,IBCT))
- if 'IBCT
- QUIT
- IF $PIECE($GET(^IBE(351.2,IBCT,0)),"^",5)'=2
- Begin DoDot:1
- +3 SET IBPTF=$PIECE($GET(^IBE(351.2,IBCT,0)),"^",2)
- if 'IBPTF
- QUIT
- +4 if $PIECE($GET(^DGPM(IBPTF,0)),"^",17)=""
- QUIT
- +5 SET IBDPTF=$PIECE($GET(^DGPM(IBPTF,0)),"^",17)
- SET IBDDT=$PIECE($GET(^DGPM(IBDPTF,0)),"^")
- +6 NEW DA,DIE,DR
- +7 SET DR=".05////2;.06////"_IBDDT_";2.03////"_DUZ_";2.04///NOW"
- +8 SET DA=IBCT
- SET DIE="^IBE(351.2,"
- DO ^DIE
- End DoDot:1
- +9 WRITE !,"File Update Complete"
- +10 WRITE !,"Please review records using the List Special Inpatient Billing Cases Menu Option",!!
- +11 QUIT
- +12 ;
