IBY316PS.m

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 ---IBY316PS   785     printed  Apr 09, 2024@21:08:05                                                                                                                                                                                                     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