IB20P387.m

IB20P387 ;DAY/RRA - DSS CLINIC STOP CODES IB*2.0*378 PRE-INIT ; 3/13/07 12:55pm

 ;;2.0;INTEGRATED BILLING;**387**;21-MAR-94;Build 3

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

 Q

EN ;

 N U

 S U="^"

 D START,UPDATE,FINISH

 Q

 ;

START D BMES^XPDUTL("DSS Clinic Stop Codes, Post-Install Starting")

 Q

 ;

FINISH D BMES^XPDUTL("DSS Clinic Stop Codes, Post-Install Complete")

 Q

 ;

 ;

UPDATE ;update an old code

 N IB1,IBT,IBX,IBCODE,IBY

 D BMES^XPDUTL(" Updating Stop Code entries 695 and 696 in file 352.5")

 F IBX=1:1 S IBT=$P($T(OCODE+IBX),";",3) Q:'$L(IBT)  D

 . S IBCODE=+$P(IBT,U)

 . S IBY=3071001

 . S IB1=$O(^IBE(352.5,"AEFFDT",IBCODE,-IBY,0))

 . I 'IB1 D BMES^XPDUTL("No Stop Code Entry found for "_IBCODE_" with an efective date of 10/01/07") Q

 . S DIE="^IBE(352.5,",DA=IB1,DR=".05///1" D ^DIE K DA,DR,DIE

 . D BMES^XPDUTL("     "_IBCODE_" updated in file 352.5")

 Q

 ;

OCODE ;;code^billable type^description^override flag

 ;;695

 ;;696

 ;

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IB20P387   1012     printed  Mar 13, 2025@21:07:18                                                                                                                                                                                                    Page 2

IB20P387  ;DAY/RRA - DSS CLINIC STOP CODES IB*2.0*378 PRE-INIT ; 3/13/07 12:55pm

 +1       ;;2.0;INTEGRATED BILLING;**387**;21-MAR-94;Build 3

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4        QUIT 

EN        ;

 +1        NEW U

 +2        SET U="^"

 +3        DO START

           DO UPDATE

           DO FINISH

 +4        QUIT 

 +5       ;

START      DO BMES^XPDUTL("DSS Clinic Stop Codes, Post-Install Starting")

 +1        QUIT 

 +2       ;

FINISH     DO BMES^XPDUTL("DSS Clinic Stop Codes, Post-Install Complete")

 +1        QUIT 

 +2       ;

 +3       ;

UPDATE    ;update an old code

 +1        NEW IB1,IBT,IBX,IBCODE,IBY

 +2        DO BMES^XPDUTL(" Updating Stop Code entries 695 and 696 in file 352.5")

 +3        FOR IBX=1:1

               SET IBT=$PIECE($TEXT(OCODE+IBX),";",3)

               if '$LENGTH(IBT)

                   QUIT 

               Begin DoDot:1

 +4                SET IBCODE=+$PIECE(IBT,U)

 +5                SET IBY=3071001

 +6                SET IB1=$ORDER(^IBE(352.5,"AEFFDT",IBCODE,-IBY,0))

 +7                IF 'IB1

                       DO BMES^XPDUTL("No Stop Code Entry found for "_IBCODE_" with an efective date of 10/01/07")

                       QUIT 

 +8                SET DIE="^IBE(352.5,"

                   SET DA=IB1

                   SET DR=".05///1"

                   DO ^DIE

                   KILL DA,DR,DIE

 +9                DO BMES^XPDUTL("     "_IBCODE_" updated in file 352.5")

               End DoDot:1

 +10       QUIT 

 +11      ;

OCODE     ;;code^billable type^description^override flag

 +1       ;;695

 +2       ;;696

 +3       ;

 +4        QUIT