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 Dec 13, 2024@02:33:34 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 ;
