IBECPF.m

IBECPF ;ALB/RLW - IB FLAG/UNFLAG CONTINUOUS PATIENTS ; 1-JAN-92

 ;;2.0;INTEGRATED BILLING;**199,662**;21-MAR-94;Build 8

 ;Per VA Directive 6402, 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=DT

 N DPTNOFZY S DPTNOFZY=1  ;Suppress PATIENT file fuzzy lookups

 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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBECPF   723     printed  Apr 09, 2024@21:31:50                                                                                                                                                                                                       Page 2

IBECPF    ;ALB/RLW - IB FLAG/UNFLAG CONTINUOUS PATIENTS ; 1-JAN-92

 +1       ;;2.0;INTEGRATED BILLING;**199,662**;21-MAR-94;Build 8

 +2       ;Per VA Directive 6402, 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=DT

 +4       ;Suppress PATIENT file fuzzy lookups

           NEW DPTNOFZY

           SET DPTNOFZY=1

 +5        SET DIC="^IBE(351.1,"

           SET DIC(0)="AELMQZ"

           SET DLAYGO=351.1

           SET DIC("A")="Select PATIENT: "

           DO ^DIC

           KILL DIC

 +6        if +Y<0

               GOTO ENQ

 +7        IF $PIECE(Y,"^",3)=1

               SET DR=".02;.03////"_DUZ_";.04////"_IBDATE

 +8       IF '$TEST

               SET DR=".01;.02;.05////"_DUZ_";.06////"_IBDATE

 +9        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