Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEFG6

IBCEFG6.m

Go to the documentation of this file.
  1. IBCEFG6 ;ALB/TMP - OUTPUT FORMATTER MAINT-FORM FLD ACTION PROCESSING ;23-JAN-96
  1. ;;2.0;INTEGRATED BILLING;**52,51**;21-MAR-94
  1. ;
  1. ADD ; Add a new local form fld
  1. ; Assumes IBCEXDA defined
  1. N %,IB,IBASSOC,IBDA,IBSEL,IBCOPY,X,Y,DD,DO,DIC,DIE,DR,DA,DLAYGO,LDINUM,DINUM,IBSCREEN
  1. G:'$G(IBCEXDA) ADDQ
  1. D FULL^VALM1
  1. S IBASSOC=$P($G(^IBE(353,IBCEXDA,2)),U,5) S:IBASSOC=IBCEXDA IBASSOC="" S IBSEL=(IBASSOC'="")
  1. S IBSCREEN=$P($G(^IBE(353,IBCEXDA,2)),U,2)="S"
  1. I 'IBASSOC,$O(^IBA(364.6,"B",IBCEXDA,"")) D G:'IBSEL ADD1
  1. .W !,"OVERRIDE AN EXISTING FIELD" S %=2 D YN^DICN
  1. .I (%+1#3) S IBSEL=1
  1. G:'IBSEL ADD1
  1. D SEL(.IBDA,1)
  1. S IB=$O(IBDA("")) G:'IB ADDQ
  1. ; Associated form - only choose non-associated fld to override
  1. I IBASSOC,$S('IBSCREEN:$P($G(^IBA(364.6,+IBDA(IB),0)),U,2)'="N",1:0) W !!,"Can Only Over-ride a NATIONAL form field",! D PAUSE^VALM1 S IB=0 G ADDQ
  1. I 'IBASSOC,$S('IBSCREEN:$P($G(^IBA(364.6,+IBDA(IB),0)),U,3),1:+IBDA(IB)'=$P($G(^IBA(364.6,+IBDA(IB),0)),U,3)) W !!,"Can't Over-ride a form field that is an over-ride itself",! D PAUSE^VALM1 S IB=0 G ADDQ
  1. I $P($G(^IBA(364.6,+IBDA(IB),0)),U,7)=0 W !!,"Form field definition will not allow override",! D PAUSE^VALM1 S IB=0 G ADDQ
  1. W !!,"Over-riding Form Field # ",IB," - ",$P($G(^IBA(364.6,+IBDA(IB),0)),U,10)
  1. W !,"IS THIS OK" S %=2 D YN^DICN
  1. I '(%+1#3) S IB=0 G ADDQ
  1. W !,"COPY OVER THE DATA ELEMENT AND OUTPUT FORMAT FROM THE ORIGINAL FLD" S %=1 D YN^DICN
  1. G:%<0 ADDQ
  1. S IB=+IBDA(IB)
  1. S IBCOPY=$S(%+1#3:$O(^IBA(364.7,"B",IB,"")),1:"")
  1. ADD1 K DO,DD,DINUM
  1. S DIC="^IBA(364.6,",DIC(0)="L",DLAYGO=364.6,X=IBCEXDA
  1. S Z=$O(^IBA(364.6,"A"),-1) S:Z<10000 Z=9999
  1. F LDINUM=Z+1:1 L +^IBA(364.6,LDINUM):1 I $T S DINUM=LDINUM Q
  1. S DIC("DR")=".02///L;.07////1;I '$G(IB) S Y=""@10"";.03////"_$G(IB)_";S Y=""@99"""
  1. S DIC("DR")=DIC("DR")_";@10;.04;I X="""" W !,""MUST HAVE A PAGE/SEQ"" S Y=""@10"";@20;.05;I X="""" W !,""MUST HAVE A FIRST LINE #"" S Y=""@20"";@30;.08;I X="""" W !,""MUST HAVE A STARTING COLUMN"" S Y=""@30"";@99"
  1. D FILE^DICN
  1. K DLAYGO,DO,DD,DINUM
  1. S $P(^IBA(364.6,0),U,3)=$O(^IBA(364.6,9999),-1) L -^IBA(364.6,LDINUM)
  1. K DIC,DO,DD,DLAYGO
  1. G:Y<0 ADDQ
  1. S IBDA=+Y
  1. ADDQ I $G(IBDA) D EDITL(IBDA,"",1,$G(IBCOPY)),BLD^IBCEFG5
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EDIT ; Edit a local form fld
  1. N IBEDIT,IBDA,IB
  1. D FULL^VALM1
  1. S IBEDIT=0
  1. D SEL(.IBDA)
  1. S IB=0 F S IB=$O(IBDA(IB)) Q:'IB W !!,"Form field: (#",IB,")",$S($P($G(^IBA(364.6,+IBDA(IB),0)),U,10)'="":" - "_$P(^(0),U,10),1:"") D
  1. .I $P($G(^IBA(364.6,+IBDA(IB),0)),U,2)="N" W " is a NATIONAL form field",! D NOEDIT("EDIT A NATIONAL FIELD FROM") Q
  1. .D VIEW^IBCEFG61(+IBDA(IB),+$O(^IBA(364.7,"B",+IBDA(IB),""))),EDITL(+IBDA(IB),IB) S IBEDIT=1
  1. D:IBEDIT BLD^IBCEFG5
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. EDITL(DA,FLD,NOASK,IBCOPY) ; Edit a local form fld #FLD in display whose ien is DA
  1. ; NOASK = 1, don't ask, just do it
  1. ; IBCOPY = IFN of entry in file 364.7 whose data element and format code
  1. ; should be copied into this new entry
  1. S DIE="^IBA(364.6,",DR="[IBCE ADD/EDIT LOCAL FORM FIELD]" D ^DIE
  1. I '$G(NOASK) W !!,$S($D(^IBA(364.7,"B",DA)):"EDIT",1:"ADD")," FORM FIELD",$S($G(FLD):" #"_FLD,1:""),"'S CONTENT DEFINITION NOW" S %=2 D YN^DICN
  1. I $G(NOASK) W !!,"...Please define CONTENT of field...",! S %=1
  1. D:(%+1#3) CONTENT(DA,$G(IBCOPY))
  1. Q
  1. ;
  1. VIEWF(IBDA) ;
  1. D SEL(.IBDA)
  1. D FULL^VALM1
  1. S IBDA=0 F S IBDA=$O(IBDA(IBDA)) Q:'IBDA W !!,"Definition of Form Field: (#",IBDA,")",$S($P($G(^IBA(364.6,+IBDA(IBDA),0)),U,10)'="":" - "_$P(^(0),U,10),1:"") D
  1. .D VIEW^IBCEFG61(+IBDA(IBDA),+$O(^IBA(364.7,"B",+IBDA(IBDA),""))),PAUSE^VALM1
  1. ;I IBCONT D BLD^IBCEFG5
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CONTENT(IBDA,IBCOPY) ; Add/edit form fld definition content
  1. ; IBDA = corresponding entry in file 364.6 for definition being
  1. ; added/edited. If null, ask for selections from current screen
  1. ; IBCOPY = IFN of entry in file 364.7 whose data element and format code
  1. ; should be copied into this new entry
  1. N IBCONT,DIPA
  1. D FULL^VALM1
  1. S IBCONT=0
  1. I $G(IBDA) D CONTED(IBDA,.IBCONT,$G(IBCOPY)) G CONTQ
  1. D SEL(.IBDA)
  1. S IBDA=0 F S IBDA=$O(IBDA(IBDA)) Q:'IBDA W !!,"Defining content of form field: (#",IBDA,")",$S($P($G(^IBA(364.6,+IBDA(IBDA),0)),U,10)'="":" - "_$P(^(0),U,10),1:"") D
  1. .I $P($G(^IBA(364.6,+IBDA(IBDA),0)),U,2)="N" W " is a NATIONAL form field",! D NOEDIT("EDIT A NATIONAL FIELD FROM") Q
  1. .D VIEW^IBCEFG61(+IBDA(IBDA),+$O(^IBA(364.7,"B",+IBDA(IBDA),""))),CONTED(+IBDA(IBDA),.IBCONT)
  1. CONTQ I IBCONT D BLD^IBCEFG5
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. CONTED(IBDA,IBCONT,IBCOPY) ; Edit definition for ien IBDA
  1. ; IBDA = file 364.6 entry whose definition is being edited
  1. ; IBCONT = flag returned as 1 if a new associated form fld created,
  1. ; forcing a regeneration of the display
  1. ; IBCOPY = IFN of entry in file 364.7 whose data element and format code
  1. ; should be copied into this new entry
  1. N IBCECDA,DIC,DD,DO,DINUM,LDINUM,X,Y,Z
  1. S IBCECDA=$O(^IBA(364.7,"B",IBDA,""))
  1. I IBCECDA="" D S:IBCECDA IBCONT=1
  1. .K DO,DD,DINUM
  1. .S DIC="^IBA(364.7,",DIC(0)="L",DLAYGO=364.7,DIC("DR")=".02////L;.07////N",X=IBDA
  1. .I $G(IBCOPY) S DIC("DR")=DIC("DR")_";.03////"_$P($G(^IBA(364.7,IBCOPY,0)),U,3)
  1. .S Z=$O(^IBA(364.7,"A"),-1) S:Z<10000 Z=9999
  1. .F LDINUM=Z+1:1 L +^IBA(364.7,LDINUM):1 I $T S DINUM=LDINUM Q
  1. .D FILE^DICN
  1. .S $P(^IBA(364.7,0),U,3)=$O(^IBA(364.7,9999),-1) L -^IBA(364.7,LDINUM)
  1. .K DIC,DO,DD,DINUM,DLAYGO
  1. .S:Y>0 IBCECDA=+Y
  1. .I $G(IBCOPY) S ^IBA(364.7,+Y,1)=$G(^IBA(364.7,IBCOPY,1)) M ^IBA(364.7,+Y,3)=^IBA(364.7,IBCOPY,3)
  1. Q:'IBCECDA
  1. ED1 S DA=IBCECDA,DIE="^IBA(364.7,",DR="[IBCE EDIT FIELD CONTENT]" D ^DIE
  1. I $$EDCHK^IBCEFG60(IBCECDA) G ED1 ;Do edit checks,re-edit if indicated
  1. Q
  1. ;
  1. VIEWEL(IBBASE) ; View a data element
  1. ; IBBASE = ien of the base file for the element to be viewed
  1. ; if undef - any element can be selected
  1. N DIC,Y,IBBASE
  1. D FULL^VALM1
  1. W !!
  1. I $G(IBCEXDA) S IBBASE=+$G(^IBE(353,IBCEXDA,2))
  1. S:$G(IBBASE) DIC("S")="I $P(^(0),U,5)="_IBBASE S DIC="^IBA(364.5,",DIC(0)="AEMQ",DIC("A")="Select a DATA ELEMENT: " D ^DIC K DIC
  1. I Y>0 D VIEWE^IBCEFG61(+Y),PAUSE^VALM1
  1. VIEWELQ S VALMBCK="R"
  1. Q
  1. ;
  1. NOEDIT(FUNC,FLD) ; Write NO CHANGE msg for associated flds
  1. I $G(FLD) W !,"FORM FIELD #: ",FLD
  1. W !,*7,"YOU CANNOT ",FUNC," A NATIONALLY ASSOCIATED LOCAL FORM",!," - REDEFINE THE FIELD'S CONTENT BY USING A LOCAL FORM FIELD TO OVERRIDE"
  1. D PAUSE^VALM1
  1. Q
  1. ;
  1. FNL ; Clean up
  1. K ^TMP("IBCEDEFDX",$J)
  1. D CLEAN^VALM10
  1. Q
  1. ;
  1. SEL(IBDA,ONE) ; Select form fld entries from list
  1. D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
  1. S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IBDA(IBDA)=+$P($G(^TMP("IBCEFLDDX",$J,IBDA)),U,2)
  1. Q
  1. ;