- IBECPF ;ALB/RLW - IB FLAG/UNFLAG CONTINUOUS PATIENTS ; 1-JAN-92
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;
- ;***
- ;S XRTL=$ZU(0),XRTN="IBECPF-1" D T0^%ZOSV ;start rt clock
- D DT^DICRW S IBDATE=%
- S DIC="^IBE(351.1,",DIC(0)="AELMQZ",DLAYGO=351.1,DIC("A")="Select PATIENT: " D ^DIC K DIC
- G:+Y<0 ENQ
- I $P(Y,"^",3)=1 S DR=".02;.03////"_DUZ_";.04////"_IBDATE
- E S DR=".01;.02;.05////"_DUZ_";.06////"_IBDATE
- S DIE="^IBE(351.1,",DA=+Y,DIDEL=351.1 D ^DIE K DIE,DA,DR,Y,DIDEL
- ENQ ;
- K IBDATE
- ;***
- ;I $D(XRT0) S:'$D(XRTN) XRTN="IBECPF" D T1^%ZOSV ;stop rt clock
- Q
- IBECPF ;ALB/RLW - IB FLAG/UNFLAG CONTINUOUS PATIENTS ; 1-JAN-92
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- EN ;
- +1 ;***
- +2 ;S XRTL=$ZU(0),XRTN="IBECPF-1" D T0^%ZOSV ;start rt clock
- +3 DO DT^DICRW
- SET IBDATE=%
- +4 SET DIC="^IBE(351.1,"
- SET DIC(0)="AELMQZ"
- SET DLAYGO=351.1
- SET DIC("A")="Select PATIENT: "
- DO ^DIC
- KILL DIC
- +5 IF +Y<0
- GOTO ENQ
- +6 IF $PIECE(Y,"^",3)=1
- SET DR=".02;.03////"_DUZ_";.04////"_IBDATE
- +7 IF '$TEST
- SET DR=".01;.02;.05////"_DUZ_";.06////"_IBDATE
- +8 SET DIE="^IBE(351.1,"
- SET DA=+Y
- SET DIDEL=351.1
- DO ^DIE
- KILL DIE,DA,DR,Y,DIDEL
- ENQ ;
- +1 KILL IBDATE
- +2 ;***
- +3 ;I $D(XRT0) S:'$D(XRTN) XRTN="IBECPF" D T1^%ZOSV ;stop rt clock
- +4 QUIT