source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBY280PO.m@ 1581

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

initial load of WorldVistAEHR

File size: 1.4 KB
RevLine 
[613]1IBY280PO ;ALB/TMK - IB*2*280 POST-INSTALL ;17-AUG-04
2 ;;2.0;INTEGRATED BILLING;**280**;21-MAR-94
3 ;
4 N A,DLAYGO,DIC,DIE,DIK,DA,DR,DO,DD,Y,X,Z,Z0,Z1,Z3
5 D BMES^XPDUTL("Post-Installation Updates")
6 ;
7 D BMES^XPDUTL("Moving LINE ITEM REMARKS for EEOBs to new fields")
8EN S Z=0 F S Z=$O(^IBM(361.1,Z)) Q:'Z S Z0=0 F S Z0=$O(^IBM(361.1,Z,15,Z0)) Q:'Z0 S Z3=$G(^(Z0,3)) I Z3'="" D
9 . K A,DO,DD,DIC,DA,DLAYGO
10 . S X=1,DA(2)=Z,DA(1)=Z0,DIC="^IBM(361.1,"_DA(2)_",15,"_DA(1)_",4,",DIC(0)="L"
11 . S DIC("DR")="",DLAYGO=361.115
12 . S DIC("DR")=$S($P(Z3,U)'="":".02////"_$P(Z3,U),1:"")
13 . S DIC("DR")=DIC("DR")_$S($P(Z3,U,2)'="":$S(DIC("DR")'="":";",1:"")_".03////"_$P(Z3,U,2),1:"")
14 . I '$D(^IBM(361.1,DA(2),15,DA(1),4,1,0)) D FILE^DICN Q:Y'>0
15 . M A=DA K DA
16 . S DA(1)=A(2),DA=A(1)
17 . I Y>0 S DIE="^IBM(361.1,"_DA(1)_",15,",DR="3.01///@;3.02///@" D ^DIE K ^IBM(361.1,DA(1),15,DA,3)
18 D ENDST
19 ;
20 ; search for all records in file 355.3 that contain internal code
21 ; TR in field .15 (Electronic Plan Type) and change it back to CH.
22 D BMES^XPDUTL("Reconvert 'TR' code to 'CH' for ELECTRONIC PLAN TYPE in file 355.3")
23 S DA=0
24 F S DA=$O(^IBA(355.3,DA)) Q:'DA D
25 . Q:$P($G(^IBA(355.3,DA,0)),U,15)'="TR"
26 . S DIE="^IBA(355.3,",DR=".15////CH" D ^DIE
27 ;
28 D ENDST
29 ;
30 D END
31 Q
32 ;
33ENDST ; End step
34 D BMES^XPDUTL("Step complete")
35 Q
36 ;
37END ; End
38 D BMES^XPDUTL("Post-install complete")
39 Q
40 ;
Note: See TracBrowser for help on using the repository browser.