| 1 | IBCEFG60 ;ALB/TMP - OUTPUT FORMATTER-FORM FLD ACTION PROCESSING (CONT) ;28-JAN-96
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**52,51**;21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | DELETE ;
|
|---|
| 5 | N DIR,Y,IB,IBDA,IBDA1,IBDEL,IBAREC,Z,IB0,Q
|
|---|
| 6 | D FULL^VALM1
|
|---|
| 7 | S IBDEL=0
|
|---|
| 8 | D SEL^IBCEFG6(.IBDA)
|
|---|
| 9 | I $G(IBCEXDA) S IB=0 F S IB=$O(IBDA(IB)) Q:'IB W !! D
|
|---|
| 10 | .S IBDA=+IBDA(IB),IB0=$G(^IBA(364.6,IBDA,0))
|
|---|
| 11 | .I $P(IB0,U,2)="N" D NOEDIT^IBCEFG6("DELETE NATIONAL FIELDS FROM",IB) Q
|
|---|
| 12 | .S Q=$O(^IBA(364.6,"APAR",IBCEXDA,IBDA,""))
|
|---|
| 13 | . I Q,Q'=IBDA D Q
|
|---|
| 14 | ..W !,*7,"Can't delete this field until all fields associated with it are deleted" D PAUSE^VALM1
|
|---|
| 15 | .S Z=$S($P(IB0,U,10)'="":" ("_$P(IB0,U,10)_")",1:"")
|
|---|
| 16 | .K DIR
|
|---|
| 17 | .S DIR(0)="YA",DIR("A")="Are you sure you want to DELETE LOCAL FORM FIELD #"_IB_Z_": ",DIR("B")="NO",DIR("A",1)="If you delete this form field, its content definition will",DIR("A",2)=" also be deleted"
|
|---|
| 18 | .D ^DIR K DIR
|
|---|
| 19 | .Q:$D(DIRUT)!('Y) S IBDEL=1
|
|---|
| 20 | .S IBDA1=0 F S IBDA1=$O(^IBA(364.7,"B",IBDA,IBDA1)) D Q:'IBDA1
|
|---|
| 21 | ..I 'IBDA1 S DIK="^IBA(364.6,",DA=IBDA D ^DIK W "." Q
|
|---|
| 22 | ..S DIK="^IBA(364.7,",DA=IBDA1 W "." D ^DIK
|
|---|
| 23 | .W !!,"Form Field #",IB," Deleted"
|
|---|
| 24 | I IBDEL D PAUSE^VALM1,BLD^IBCEFG5
|
|---|
| 25 | S VALMBCK="R"
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | EDCHK(DA) ; Perform edit checks on content definition
|
|---|
| 29 | ; DA = ien of entry in file 364.7
|
|---|
| 30 | ; Returns 1 if user decides to re-edit due to warnings,
|
|---|
| 31 | ; 0 if no warnings or user does not want to re-edit
|
|---|
| 32 | N IBDA,IB0,IBINS,IBTYPE,WARN,IBX,REDO,IBDAP,IBFORM,IBFTYPE
|
|---|
| 33 | S (WARN,REDO)=0,IB0=$G(^IBA(364.7,DA,0)),IBDA=+IB0,IBDAP=$P($G(^IBA(364.6,+IB0,0)),U,3),IBINS=$P(IB0,U,5),IBTYPE=$P(IB0,U,6)
|
|---|
| 34 | S IBFORM=+$G(^IBA(364.6,IBDA,0)),IBFTYPE=$P($G(^IBE(353,IBFORM,2)),U,2)
|
|---|
| 35 | ;Check for missing data element/screen prompt
|
|---|
| 36 | I '$P(IB0,U,3),$P(IB0,U,4)="" S WARN(1)="",WARN=WARN+1
|
|---|
| 37 | G:'IBDAP ED1
|
|---|
| 38 | S IBX=0 F S IBX=$O(^IBA(364.6,"APAR",IBFORM,IBDAP,IBX)) Q:'IBX I IBX'=IBDA D
|
|---|
| 39 | .S IBX1=0 F S IBX1=$O(^IBA(364.7,"B",IBX,IBX1)) Q:'IBX1 S IBX(IBX1)=$G(^IBA(364.7,IBX1,0))
|
|---|
| 40 | G:$O(IBX(""))="" ED1 ;No other override flds for the parent field
|
|---|
| 41 | ;Check for 2 fields for same ins co/bill type
|
|---|
| 42 | ; for same ins co/both bill type
|
|---|
| 43 | ; for same bill type/all ins companies
|
|---|
| 44 | ; for both bill type/all ins companies
|
|---|
| 45 | S IBX=0 F S IBX=$O(IBX(IBX)) Q:'IBX I $P(IBX(IBX),U,5)=IBINS,$P(IBX(IBX),U,6)=IBTYPE D Q:$G(WARN(2))'=""
|
|---|
| 46 | . I 'IBINS,IBTYPE="",+IBX(IBX)=IBDAP Q ; O/RIDE of 'ALL' default
|
|---|
| 47 | . S WARN(2)=$S(IBINS:IBINS,1:"ALL")_U_$S(IBTYPE'="":IBTYPE,1:"BOTH"),WARN=WARN+1 Q
|
|---|
| 48 | ED1 I $O(WARN("")) D
|
|---|
| 49 | .W !!,*7,"The following problem",$S('WARN:"",1:"s")," exist for this definition:"
|
|---|
| 50 | .I $D(WARN(1)) W !," * DATA ELEMENT",$S(IBFTYPE'="S":" ",1:" OR SCREEN PROMPT "),"FOR FIELD IS MISSING - NO DATA WILL BE OUTPUT"
|
|---|
| 51 | .I $D(WARN(2)) W !," * MORE THAN ONE OVERRIDE FLD DEFINITION EXISTS FOR THE ASSOC FIELD FOR:",!,$J("",13),"INS CO: ",$$INS($P(WARN(2),U)),!,$J("",10),"BILL TYPE: ",$$BTYPE($P(WARN(2),U,2))
|
|---|
| 52 | .W !!,"WANT TO RE-EDIT THIS RECORD NOW?" S %=1 D YN^DICN S REDO=(%+1#3)
|
|---|
| 53 | Q REDO
|
|---|
| 54 | ;
|
|---|
| 55 | BTYPE(X) ;RETURN INPT/OUTPT/ALL FOR BILL TYPE CODE IN X
|
|---|
| 56 | Q $S(X="BOTH":X,X="I":"INPT",X="O":"OUTPT",1:"??")
|
|---|
| 57 | ;
|
|---|
| 58 | INS(X) ;RETURN NAME OF INSURANCE CO FOR CODE IN X
|
|---|
| 59 | Q $S(X="ALL":X,$P($G(^DIC(36,+X,0)),U)'="":$P(^(0),U),1:"??")
|
|---|
| 60 | ;
|
|---|
