IBCEFG41 ;ALB/TMP - OUTPUT FORMATTER MAINT - ACT PROC (CONT) ;22-JAN-96
;;2.0;INTEGRATED BILLING;**52,51**;21-MAR-94
;
ELEMENT ;Add/Edit Local Data Elements
D FULL^VALM1
N DIC,DIE,DR,DA,Y,Z,DINUM,LDINUM
S LDINUM=$O(^IBA(364.5,"A"),-1) S:LDINUM<100000 LDINUM=99999
F LDINUM=LDINUM+1:1 L +^IBA(364.5,LDINUM):1 I $T S DINUM=LDINUM Q
S DIC("A")="Select LOCAL DATA ELEMENT Name: ",DIC("S")="I $P($G(^(0)),U,2)=""L""",DIC="^IBA(364.5,",DIC(0)="AELMQ",DIC("DR")=".02////L",DLAYGO=364.5 D ^DIC K DIC,DLAYGO G:Y<0 ELEQ
I $P(Y,U,3),$E(^IBA(364.5,+Y,0),1,2)="N-" W !,"ONLY NATIONAL FIELDS CAN BEGIN WITH 'N-'" S DA=+Y,DIK="^IBA(364.5," D ^DIK G ELEMENT
S $P(^IBA(364.5,0),U,3)=$O(^IBA(364.5,9999),-1) L -^IBA(364.5,LDINUM)
K DINUM
S DIE="^IBA(364.5,",DR="[IBCE DEFINE LOCAL ELEMENT]",DA=+Y D ^DIE
ELEQ S VALMBCK="R"
Q
;
DELETE ; Delete form
N DIR,Y,IBDA,IBDA1,IBF
D FULL^VALM1
I $G(IBCEXDA) D
.S IBF=$P($G(^IBE(353,IBCEXDA,0)),U)
.K DIR S DIR(0)="YA",DIR("A")="Are you sure you want to DELETE LOCAL FORM - "_IBF_": ",DIR("B")="NO",DIR("A",1)="If you choose to delete this form, the form's field content definitions will also be deleted" D ^DIR K DIR
.Q:$D(DIRUT)!('Y)
.S IBDA=0 F S IBDA=$O(^IBA(364.6,"B",IBCEXDA,IBDA)) Q:'IBDA D
..S IBDA1=0 F S IBDA1=$O(^IBA(364.7,"B",IBDA,IBDA1)) D Q:'IBDA1
...I 'IBDA1 S DIK="^IBA(364.6,",DA=IBDA D ^DIK Q
...S DIK="^IBA(364.7,",DA=IBDA1 D ^DIK
.S DIK="^IBE(353,",DA=IBCEXDA D ^DIK
.W !!,"Form ",IBF," Deleted" D PAUSE^VALM1
S VALMBCK=$S($D(^IBE(353,+$G(IBCEXDA))):"R",1:"Q")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEFG41 1570 printed Oct 16, 2024@18:11:12 Page 2
IBCEFG41 ;ALB/TMP - OUTPUT FORMATTER MAINT - ACT PROC (CONT) ;22-JAN-96
+1 ;;2.0;INTEGRATED BILLING;**52,51**;21-MAR-94
+2 ;
ELEMENT ;Add/Edit Local Data Elements
+1 DO FULL^VALM1
+2 NEW DIC,DIE,DR,DA,Y,Z,DINUM,LDINUM
+3 SET LDINUM=$ORDER(^IBA(364.5,"A"),-1)
if LDINUM<100000
SET LDINUM=99999
+4 FOR LDINUM=LDINUM+1:1
LOCK +^IBA(364.5,LDINUM):1
IF $TEST
SET DINUM=LDINUM
QUIT
+5 SET DIC("A")="Select LOCAL DATA ELEMENT Name: "
SET DIC("S")="I $P($G(^(0)),U,2)=""L"""
SET DIC="^IBA(364.5,"
SET DIC(0)="AELMQ"
SET DIC("DR")=".02////L"
SET DLAYGO=364.5
DO ^DIC
KILL DIC,DLAYGO
if Y<0
GOTO ELEQ
+6 IF $PIECE(Y,U,3)
IF $EXTRACT(^IBA(364.5,+Y,0),1,2)="N-"
WRITE !,"ONLY NATIONAL FIELDS CAN BEGIN WITH 'N-'"
SET DA=+Y
SET DIK="^IBA(364.5,"
DO ^DIK
GOTO ELEMENT
+7 SET $PIECE(^IBA(364.5,0),U,3)=$ORDER(^IBA(364.5,9999),-1)
LOCK -^IBA(364.5,LDINUM)
+8 KILL DINUM
+9 SET DIE="^IBA(364.5,"
SET DR="[IBCE DEFINE LOCAL ELEMENT]"
SET DA=+Y
DO ^DIE
ELEQ SET VALMBCK="R"
+1 QUIT
+2 ;
DELETE ; Delete form
+1 NEW DIR,Y,IBDA,IBDA1,IBF
+2 DO FULL^VALM1
+3 IF $GET(IBCEXDA)
Begin DoDot:1
+4 SET IBF=$PIECE($GET(^IBE(353,IBCEXDA,0)),U)
+5 KILL DIR
SET DIR(0)="YA"
SET DIR("A")="Are you sure you want to DELETE LOCAL FORM - "_IBF_": "
SET DIR("B")="NO"
SET DIR("A",1)="If you choose to delete this form, the form's field content definitions will also be deleted"
DO ^DIR
KILL DIR
+6 if $DATA(DIRUT)!('Y)
QUIT
+7 SET IBDA=0
FOR
SET IBDA=$ORDER(^IBA(364.6,"B",IBCEXDA,IBDA))
if 'IBDA
QUIT
Begin DoDot:2
+8 SET IBDA1=0
FOR
SET IBDA1=$ORDER(^IBA(364.7,"B",IBDA,IBDA1))
Begin DoDot:3
+9 IF 'IBDA1
SET DIK="^IBA(364.6,"
SET DA=IBDA
DO ^DIK
QUIT
+10 SET DIK="^IBA(364.7,"
SET DA=IBDA1
DO ^DIK
End DoDot:3
if 'IBDA1
QUIT
End DoDot:2
+11 SET DIK="^IBE(353,"
SET DA=IBCEXDA
DO ^DIK
+12 WRITE !!,"Form ",IBF," Deleted"
DO PAUSE^VALM1
End DoDot:1
+13 SET VALMBCK=$SELECT($DATA(^IBE(353,+$GET(IBCEXDA))):"R",1:"Q")
+14 QUIT
+15 ;
