- 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 Feb 18, 2025@23:36:55 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 ;
