IBY316PS ;;DAOU/DJW - Post Installation Program ;13-September-2005
;;2.0;INTEGRATED BILLING;**316**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
;Program Description: This is the post install routine for IB*2.0*316
;
; Set 'INQUIRE POPULAR PAYERS'='NO'(#51.09) and 'NO. POPULAR PAYERS'=1 (#51.1)
;
; Remove data from the following fields:
; - 'MOST POPULAR LAST SAVE DATE' (#51.21)
; - list of 'POPULAR PAYERS' (#51.18)
;
N DA,DIK,DIE,DR,D,D0,DIC,DQ,X,DI,%
S DIK="^IBE(350.9,1,51.18,",DA(1)=1,DA=0
F S DA=$O(^IBE(350.9,1,51.18,DA)) Q:'DA D ^DIK
;
S DA=1,DIE="^IBE(350.9,",DR="51.21///@" D ^DIE
S DA=1,DIE="^IBE(350.9,",DR="51.1///^S X=1" D ^DIE
S DA=1,DIE="^IBE(350.9,",DR="51.09///^S X=0" D ^DIE
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY316PS 785 printed Dec 13, 2024@02:33:39 Page 2
IBY316PS ;;DAOU/DJW - Post Installation Program ;13-September-2005
+1 ;;2.0;INTEGRATED BILLING;**316**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ;
+5 ;Program Description: This is the post install routine for IB*2.0*316
+6 ;
+7 ; Set 'INQUIRE POPULAR PAYERS'='NO'(#51.09) and 'NO. POPULAR PAYERS'=1 (#51.1)
+8 ;
+9 ; Remove data from the following fields:
+10 ; - 'MOST POPULAR LAST SAVE DATE' (#51.21)
+11 ; - list of 'POPULAR PAYERS' (#51.18)
+12 ;
+13 NEW DA,DIK,DIE,DR,D,D0,DIC,DQ,X,DI,%
+14 SET DIK="^IBE(350.9,1,51.18,"
SET DA(1)=1
SET DA=0
+15 FOR
SET DA=$ORDER(^IBE(350.9,1,51.18,DA))
if 'DA
QUIT
DO ^DIK
+16 ;
+17 SET DA=1
SET DIE="^IBE(350.9,"
SET DR="51.21///@"
DO ^DIE
+18 SET DA=1
SET DIE="^IBE(350.9,"
SET DR="51.1///^S X=1"
DO ^DIE
+19 SET DA=1
SET DIE="^IBE(350.9,"
SET DR="51.09///^S X=0"
DO ^DIE
+20 ;
+21 QUIT
