source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEFG6.m@ 868

Last change on this file since 868 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1IBCEFG6 ;ALB/TMP - OUTPUT FORMATTER MAINT-FORM FLD ACTION PROCESSING ;23-JAN-96
2 ;;2.0;INTEGRATED BILLING;**52,51**;21-MAR-94
3 ;
4ADD ; Add a new local form fld
5 ; Assumes IBCEXDA defined
6 N %,IB,IBASSOC,IBDA,IBSEL,IBCOPY,X,Y,DD,DO,DIC,DIE,DR,DA,DLAYGO,LDINUM,DINUM,IBSCREEN
7 G:'$G(IBCEXDA) ADDQ
8 D FULL^VALM1
9 S IBASSOC=$P($G(^IBE(353,IBCEXDA,2)),U,5) S:IBASSOC=IBCEXDA IBASSOC="" S IBSEL=(IBASSOC'="")
10 S IBSCREEN=$P($G(^IBE(353,IBCEXDA,2)),U,2)="S"
11 I 'IBASSOC,$O(^IBA(364.6,"B",IBCEXDA,"")) D G:'IBSEL ADD1
12 .W !,"OVERRIDE AN EXISTING FIELD" S %=2 D YN^DICN
13 .I (%+1#3) S IBSEL=1
14 G:'IBSEL ADD1
15 D SEL(.IBDA,1)
16 S IB=$O(IBDA("")) G:'IB ADDQ
17 ; Associated form - only choose non-associated fld to override
18 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
19 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
20 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
21 W !!,"Over-riding Form Field # ",IB," - ",$P($G(^IBA(364.6,+IBDA(IB),0)),U,10)
22 W !,"IS THIS OK" S %=2 D YN^DICN
23 I '(%+1#3) S IB=0 G ADDQ
24 W !,"COPY OVER THE DATA ELEMENT AND OUTPUT FORMAT FROM THE ORIGINAL FLD" S %=1 D YN^DICN
25 G:%<0 ADDQ
26 S IB=+IBDA(IB)
27 S IBCOPY=$S(%+1#3:$O(^IBA(364.7,"B",IB,"")),1:"")
28ADD1 K DO,DD,DINUM
29 S DIC="^IBA(364.6,",DIC(0)="L",DLAYGO=364.6,X=IBCEXDA
30 S Z=$O(^IBA(364.6,"A"),-1) S:Z<10000 Z=9999
31 F LDINUM=Z+1:1 L +^IBA(364.6,LDINUM):1 I $T S DINUM=LDINUM Q
32 S DIC("DR")=".02///L;.07////1;I '$G(IB) S Y=""@10"";.03////"_$G(IB)_";S Y=""@99"""
33 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"
34 D FILE^DICN
35 K DLAYGO,DO,DD,DINUM
36 S $P(^IBA(364.6,0),U,3)=$O(^IBA(364.6,9999),-1) L -^IBA(364.6,LDINUM)
37 K DIC,DO,DD,DLAYGO
38 G:Y<0 ADDQ
39 S IBDA=+Y
40ADDQ I $G(IBDA) D EDITL(IBDA,"",1,$G(IBCOPY)),BLD^IBCEFG5
41 S VALMBCK="R"
42 Q
43 ;
44EDIT ; Edit a local form fld
45 N IBEDIT,IBDA,IB
46 D FULL^VALM1
47 S IBEDIT=0
48 D SEL(.IBDA)
49 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
50 .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
51 .D VIEW^IBCEFG61(+IBDA(IB),+$O(^IBA(364.7,"B",+IBDA(IB),""))),EDITL(+IBDA(IB),IB) S IBEDIT=1
52 D:IBEDIT BLD^IBCEFG5
53 S VALMBCK="R"
54 Q
55 ;
56EDITL(DA,FLD,NOASK,IBCOPY) ; Edit a local form fld #FLD in display whose ien is DA
57 ; NOASK = 1, don't ask, just do it
58 ; IBCOPY = IFN of entry in file 364.7 whose data element and format code
59 ; should be copied into this new entry
60 S DIE="^IBA(364.6,",DR="[IBCE ADD/EDIT LOCAL FORM FIELD]" D ^DIE
61 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
62 I $G(NOASK) W !!,"...Please define CONTENT of field...",! S %=1
63 D:(%+1#3) CONTENT(DA,$G(IBCOPY))
64 Q
65 ;
66VIEWF(IBDA) ;
67 D SEL(.IBDA)
68 D FULL^VALM1
69 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
70 .D VIEW^IBCEFG61(+IBDA(IBDA),+$O(^IBA(364.7,"B",+IBDA(IBDA),""))),PAUSE^VALM1
71 ;I IBCONT D BLD^IBCEFG5
72 S VALMBCK="R"
73 Q
74 ;
75CONTENT(IBDA,IBCOPY) ; Add/edit form fld definition content
76 ; IBDA = corresponding entry in file 364.6 for definition being
77 ; added/edited. If null, ask for selections from current screen
78 ; IBCOPY = IFN of entry in file 364.7 whose data element and format code
79 ; should be copied into this new entry
80 N IBCONT,DIPA
81 D FULL^VALM1
82 S IBCONT=0
83 I $G(IBDA) D CONTED(IBDA,.IBCONT,$G(IBCOPY)) G CONTQ
84 D SEL(.IBDA)
85 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
86 .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
87 .D VIEW^IBCEFG61(+IBDA(IBDA),+$O(^IBA(364.7,"B",+IBDA(IBDA),""))),CONTED(+IBDA(IBDA),.IBCONT)
88CONTQ I IBCONT D BLD^IBCEFG5
89 S VALMBCK="R"
90 Q
91 ;
92CONTED(IBDA,IBCONT,IBCOPY) ; Edit definition for ien IBDA
93 ; IBDA = file 364.6 entry whose definition is being edited
94 ; IBCONT = flag returned as 1 if a new associated form fld created,
95 ; forcing a regeneration of the display
96 ; IBCOPY = IFN of entry in file 364.7 whose data element and format code
97 ; should be copied into this new entry
98 N IBCECDA,DIC,DD,DO,DINUM,LDINUM,X,Y,Z
99 S IBCECDA=$O(^IBA(364.7,"B",IBDA,""))
100 I IBCECDA="" D S:IBCECDA IBCONT=1
101 .K DO,DD,DINUM
102 .S DIC="^IBA(364.7,",DIC(0)="L",DLAYGO=364.7,DIC("DR")=".02////L;.07////N",X=IBDA
103 .I $G(IBCOPY) S DIC("DR")=DIC("DR")_";.03////"_$P($G(^IBA(364.7,IBCOPY,0)),U,3)
104 .S Z=$O(^IBA(364.7,"A"),-1) S:Z<10000 Z=9999
105 .F LDINUM=Z+1:1 L +^IBA(364.7,LDINUM):1 I $T S DINUM=LDINUM Q
106 .D FILE^DICN
107 .S $P(^IBA(364.7,0),U,3)=$O(^IBA(364.7,9999),-1) L -^IBA(364.7,LDINUM)
108 .K DIC,DO,DD,DINUM,DLAYGO
109 .S:Y>0 IBCECDA=+Y
110 .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)
111 Q:'IBCECDA
112ED1 S DA=IBCECDA,DIE="^IBA(364.7,",DR="[IBCE EDIT FIELD CONTENT]" D ^DIE
113 I $$EDCHK^IBCEFG60(IBCECDA) G ED1 ;Do edit checks,re-edit if indicated
114 Q
115 ;
116VIEWEL(IBBASE) ; View a data element
117 ; IBBASE = ien of the base file for the element to be viewed
118 ; if undef - any element can be selected
119 N DIC,Y,IBBASE
120 D FULL^VALM1
121 W !!
122 I $G(IBCEXDA) S IBBASE=+$G(^IBE(353,IBCEXDA,2))
123 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
124 I Y>0 D VIEWE^IBCEFG61(+Y),PAUSE^VALM1
125VIEWELQ S VALMBCK="R"
126 Q
127 ;
128NOEDIT(FUNC,FLD) ; Write NO CHANGE msg for associated flds
129 I $G(FLD) W !,"FORM FIELD #: ",FLD
130 W !,*7,"YOU CANNOT ",FUNC," A NATIONALLY ASSOCIATED LOCAL FORM",!," - REDEFINE THE FIELD'S CONTENT BY USING A LOCAL FORM FIELD TO OVERRIDE"
131 D PAUSE^VALM1
132 Q
133 ;
134FNL ; Clean up
135 K ^TMP("IBCEDEFDX",$J)
136 D CLEAN^VALM10
137 Q
138 ;
139SEL(IBDA,ONE) ; Select form fld entries from list
140 D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
141 S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IBDA(IBDA)=+$P($G(^TMP("IBCEFLDDX",$J,IBDA)),U,2)
142 Q
143 ;
Note: See TracBrowser for help on using the repository browser.