- IBY280PO ;ALB/TMK - IB*2*280 POST-INSTALL ;17-AUG-04
- ;;2.0;INTEGRATED BILLING;**280**;21-MAR-94
- ;
- N A,DLAYGO,DIC,DIE,DIK,DA,DR,DO,DD,Y,X,Z,Z0,Z1,Z3
- D BMES^XPDUTL("Post-Installation Updates")
- ;
- D BMES^XPDUTL("Moving LINE ITEM REMARKS for EEOBs to new fields")
- EN 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
- . K A,DO,DD,DIC,DA,DLAYGO
- . S X=1,DA(2)=Z,DA(1)=Z0,DIC="^IBM(361.1,"_DA(2)_",15,"_DA(1)_",4,",DIC(0)="L"
- . S DIC("DR")="",DLAYGO=361.115
- . S DIC("DR")=$S($P(Z3,U)'="":".02////"_$P(Z3,U),1:"")
- . S DIC("DR")=DIC("DR")_$S($P(Z3,U,2)'="":$S(DIC("DR")'="":";",1:"")_".03////"_$P(Z3,U,2),1:"")
- . I '$D(^IBM(361.1,DA(2),15,DA(1),4,1,0)) D FILE^DICN Q:Y'>0
- . M A=DA K DA
- . S DA(1)=A(2),DA=A(1)
- . 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)
- D ENDST
- ;
- ; search for all records in file 355.3 that contain internal code
- ; TR in field .15 (Electronic Plan Type) and change it back to CH.
- D BMES^XPDUTL("Reconvert 'TR' code to 'CH' for ELECTRONIC PLAN TYPE in file 355.3")
- S DA=0
- F S DA=$O(^IBA(355.3,DA)) Q:'DA D
- . Q:$P($G(^IBA(355.3,DA,0)),U,15)'="TR"
- . S DIE="^IBA(355.3,",DR=".15////CH" D ^DIE
- ;
- D ENDST
- ;
- D END
- Q
- ;
- ENDST ; End step
- D BMES^XPDUTL("Step complete")
- Q
- ;
- END ; End
- D BMES^XPDUTL("Post-install complete")
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY280PO 1450 printed Mar 13, 2025@21:38:45 Page 2
- IBY280PO ;ALB/TMK - IB*2*280 POST-INSTALL ;17-AUG-04
- +1 ;;2.0;INTEGRATED BILLING;**280**;21-MAR-94
- +2 ;
- +3 NEW A,DLAYGO,DIC,DIE,DIK,DA,DR,DO,DD,Y,X,Z,Z0,Z1,Z3
- +4 DO BMES^XPDUTL("Post-Installation Updates")
- +5 ;
- +6 DO BMES^XPDUTL("Moving LINE ITEM REMARKS for EEOBs to new fields")
- EN SET Z=0
- FOR
- SET Z=$ORDER(^IBM(361.1,Z))
- if 'Z
- QUIT
- SET Z0=0
- FOR
- SET Z0=$ORDER(^IBM(361.1,Z,15,Z0))
- if 'Z0
- QUIT
- SET Z3=$GET(^(Z0,3))
- IF Z3'=""
- Begin DoDot:1
- +1 KILL A,DO,DD,DIC,DA,DLAYGO
- +2 SET X=1
- SET DA(2)=Z
- SET DA(1)=Z0
- SET DIC="^IBM(361.1,"_DA(2)_",15,"_DA(1)_",4,"
- SET DIC(0)="L"
- +3 SET DIC("DR")=""
- SET DLAYGO=361.115
- +4 SET DIC("DR")=$SELECT($PIECE(Z3,U)'="":".02////"_$PIECE(Z3,U),1:"")
- +5 SET DIC("DR")=DIC("DR")_$SELECT($PIECE(Z3,U,2)'="":$SELECT(DIC("DR")'="":";",1:"")_".03////"_$PIECE(Z3,U,2),1:"")
- +6 IF '$DATA(^IBM(361.1,DA(2),15,DA(1),4,1,0))
- DO FILE^DICN
- if Y'>0
- QUIT
- +7 MERGE A=DA
- KILL DA
- +8 SET DA(1)=A(2)
- SET DA=A(1)
- +9 IF Y>0
- SET DIE="^IBM(361.1,"_DA(1)_",15,"
- SET DR="3.01///@;3.02///@"
- DO ^DIE
- KILL ^IBM(361.1,DA(1),15,DA,3)
- End DoDot:1
- +10 DO ENDST
- +11 ;
- +12 ; search for all records in file 355.3 that contain internal code
- +13 ; TR in field .15 (Electronic Plan Type) and change it back to CH.
- +14 DO BMES^XPDUTL("Reconvert 'TR' code to 'CH' for ELECTRONIC PLAN TYPE in file 355.3")
- +15 SET DA=0
- +16 FOR
- SET DA=$ORDER(^IBA(355.3,DA))
- if 'DA
- QUIT
- Begin DoDot:1
- +17 if $PIECE($GET(^IBA(355.3,DA,0)),U,15)'="TR"
- QUIT
- +18 SET DIE="^IBA(355.3,"
- SET DR=".15////CH"
- DO ^DIE
- End DoDot:1
- +19 ;
- +20 DO ENDST
- +21 ;
- +22 DO END
- +23 QUIT
- +24 ;
- ENDST ; End step
- +1 DO BMES^XPDUTL("Step complete")
- +2 QUIT
- +3 ;
- END ; End
- +1 DO BMES^XPDUTL("Post-install complete")
- +2 QUIT
- +3 ;
