source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IB20P142.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1IB20P142 ;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 ;
15NEWAT ; 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 ;
27NEW ; Action Types to add into file #351.51
28 ;;UNIVERSAL^M6^Out of Region
29 ;;QUIT
30 ;
31EDIT ; 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 ;
46MOD ; 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 ;
51LAST ;
52 D BMES^XPDUTL(">>>ALL POST-INIT Activities have been completed. <<<")
53 Q
Note: See TracBrowser for help on using the repository browser.