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 ---[H[J[2J[HIBECPF 723 printed Oct 16, 2024@18:22:20 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
