Routine: IB20P496

IB20P496 ;ALB/CXW - Source of Information Update ; 15-JAN-2013

 ;;2.0;INTEGRATED BILLING;**496**;21-MAR-94;Build 23

 ;;Per VHA Directive 2004-038, this routine should not be modified.

POST ; Post-install of patch installation

 N DA,DIC,DO,X,Y,IBI,IBX,IBCT S U="^",IBCT=0

 D MES^XPDUTL("Patch Post-Install starts...")

 D MES^XPDUTL("Add a new Source of Information for Insurance ...")

 F IBI=1:1 S IBX=$P($T(SOI+IBI),";;",2) Q:IBX=""  D

 . S X=$P(IBX,U,1)

 . ; quit if it exists

 . I $D(^IBE(355.12,"B",X)) Q

 . S DIC="^IBE(355.12,",DIC(0)="F"

 . S DIC("DR")=".02///"_$P(IBX,U,2)_";.03///"_$P(IBX,U,3)

 . D FILE^DICN

 . I Y=-1 D MES^XPDUTL("ERROR when adding a new Source of Information.  Log a Remedy ticket!") Q

 . D MES^XPDUTL("Source of Information: "_$P(IBX,U,2)_" added successfully")

 . S IBCT=IBCT+1

 D MES^XPDUTL("Total "_IBCT_" code"_$S(IBCT'=1:"s",1:"")_" updated in the Source of Information file (#355.12)")

 D MES^XPDUTL("Patch Post-Install is complete.")

SOI ; code^description^ib buffer acronym

 ;;11^KIOSK^KSK

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P496   1069     printed  Mar 13, 2025@21:08:02                                                                                                                                                                                                    Page 2

IB20P496  ;ALB/CXW - Source of Information Update ; 15-JAN-2013

 +1       ;;2.0;INTEGRATED BILLING;**496**;21-MAR-94;Build 23

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

 +3        QUIT

 +4       ;

POST      ; Post-install of patch installation

 +1        NEW DA,DIC,DO,X,Y,IBI,IBX,IBCT

           SET U="^"

           SET IBCT=0

 +2        DO MES^XPDUTL("Patch Post-Install starts...")

 +3        DO MES^XPDUTL("Add a new Source of Information for Insurance ...")

 +4        FOR IBI=1:1

               SET IBX=$PIECE($TEXT(SOI+IBI),";;",2)

               if IBX=""

                   QUIT

               Begin DoDot:1

 +5                SET X=$PIECE(IBX,U,1)

 +6       ; quit if it exists

 +7                IF $DATA(^IBE(355.12,"B",X))

                       QUIT

 +8                SET DIC="^IBE(355.12,"

                   SET DIC(0)="F"

 +9                SET DIC("DR")=".02///"_$PIECE(IBX,U,2)_";.03///"_$PIECE(IBX,U,3)

 +10               DO FILE^DICN

 +11               IF Y=-1

                       DO MES^XPDUTL("ERROR when adding a new Source of Information.  Log a Remedy ticket!")

                       QUIT

 +12               DO MES^XPDUTL("Source of Information: "_$PIECE(IBX,U,2)_" added successfully")

 +13               SET IBCT=IBCT+1

               End DoDot:1

 +14       DO MES^XPDUTL("Total "_IBCT_" code"_$SELECT(IBCT'=1:"s",1:"")_" updated in the Source of Information file (#355.12)")

 +15      ;

 +16       DO MES^XPDUTL("Patch Post-Install is complete.")

 +17       QUIT

SOI       ; code^description^ib buffer acronym

 +1       ;;11^KIOSK^KSK

 +2       ;

IB20P496.m