- 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 Feb 19, 2025@00:00:08 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