| 1 | IB20P142 ;ALB/BGA - IB V2.0 POST INIT,ADD/EDIT ENTRIES #351.51 ; 3-8-2001
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**142**;21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | ; Post Init Description: This init will UPDATE two existing entries
|
|---|
| 5 | ; in file #351.51 and also add one new entry to the same file.
|
|---|
| 6 | ; file 399.1. This post init is associated with path *142*.
|
|---|
| 7 | ;
|
|---|
| 8 | ; Control Logic
|
|---|
| 9 | D NEWAT ; Added new entry to #351.51
|
|---|
| 10 | D EDIT ; Edit entries in #351.51
|
|---|
| 11 | D LAST ; End Task
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | ;
|
|---|
| 15 | NEWAT ; Add new IB CHAMPUS Error Codes into file #351.51
|
|---|
| 16 | D BMES^XPDUTL(">>>Adding new IB CHAMPUS error codes into file #351.51")
|
|---|
| 17 | F IBI=1:1 S IBCR=$P($T(NEW+IBI),";;",2) Q:IBCR="QUIT" D
|
|---|
| 18 | .S (X,IBSYS)=$P(IBCR,"^"),IBCODE=$P(IBCR,"^",2)
|
|---|
| 19 | .I $D(^IBE(351.51,"AD",IBSYS,IBCODE)) D Q
|
|---|
| 20 | . . D BMES^XPDUTL(" >>Error Code '"_IBCODE_"' is already on file for the "_IBSYS_" system.")
|
|---|
| 21 | .K DD,DO S DIC="^IBE(351.51,",DIC(0)="" D FILE^DICN Q:Y<0
|
|---|
| 22 | .S ^(0)=^IBE(351.51,+Y,0)_"^"_$P(IBCR,U,2,3) S DIK=DIC,DA=+Y D IX1^DIK
|
|---|
| 23 | .D BMES^XPDUTL(" >>Error Code '"_IBCODE_"' for the '"_IBSYS_"' System has been filed.")
|
|---|
| 24 | K DA,DIC,DIE,DIK,DR,IBI,IBCR,IBCODE,IBSYS,X,Y,Z
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | NEW ; Action Types to add into file #351.51
|
|---|
| 28 | ;;UNIVERSAL^M6^Out of Region
|
|---|
| 29 | ;;QUIT
|
|---|
| 30 | ;
|
|---|
| 31 | EDIT ; Edit entries in IB CHAMPUS Error Codes
|
|---|
| 32 | N I,IBC51,IBIT,IBROW,IBSYSE,IBUP
|
|---|
| 33 | D BMES^XPDUTL(">>>Searching for IB CHAMPUS ERROR Codes to UPDATE")
|
|---|
| 34 | F IBIT=1:1 S IBROW=$P($T(MOD+IBIT),";;",2) Q:IBROW="QUIT" D
|
|---|
| 35 | . S IBC51=$P(IBROW,U,2),IBSYSE=$P(IBROW,U)
|
|---|
| 36 | . I (IBC51="O5")!(IBC51="O6") D
|
|---|
| 37 | . . I $D(^IBE(351.51,"AD",IBSYSE,IBC51)) D
|
|---|
| 38 | . . . S DA=$O(^IBE(351.51,"AD",IBSYSE,IBC51,0)) Q:'DA
|
|---|
| 39 | . . . S IBUP="0"_$E(IBC51,2),DIE="^IBE(351.51,",DR=".02////"_IBUP
|
|---|
| 40 | . . . D ^DIE K DIE,DA,DR
|
|---|
| 41 | . . . D BMES^XPDUTL(" >> "_IBSYSE_" Error Code '"_IBC51_"' has been UPDATED to '"_IBUP_"'")
|
|---|
| 42 | ;
|
|---|
| 43 | I '$D(IBUP) D BMES^XPDUTL(" >>Codes are CORRECT no MODIFICATIONS required.")
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | MOD ; Edit entries that are currently incorrect in file #351.51
|
|---|
| 47 | ;;MLINK^O5^Bad Invalid Data bits Setting
|
|---|
| 48 | ;;UNIVERSAL^O6^Out of Region
|
|---|
| 49 | ;;QUIT
|
|---|
| 50 | ;
|
|---|
| 51 | LAST ;
|
|---|
| 52 | D BMES^XPDUTL(">>>ALL POST-INIT Activities have been completed. <<<")
|
|---|
| 53 | Q
|
|---|
