| 1 | IBJU1 ;ALB/ARH - JBI UTILITIES ; 2/14/95
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**39**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | DATE(X) ; return date in external format
|
|---|
| 6 | N Y S Y="" I $G(X)?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
|
|---|
| 7 | Q Y
|
|---|
| 8 | ;
|
|---|
| 9 | CMPFLD(FILE,FLD,REC) ; return value of computed field
|
|---|
| 10 | N D0,IBX,X,Y S X="",D0=REC,IBX=$P($G(^DD(+FILE,+FLD,0)),U,5,999) I IBX'="" X IBX
|
|---|
| 11 | Q X
|
|---|
| 12 | ;
|
|---|
| 13 | EXSET(X,D0,D1) ; returns external form of data, given file and field
|
|---|
| 14 | N Y,C S Y=X,C=$P(^DD(+D0,+D1,0),"^",2) D Y^DIQ K C
|
|---|
| 15 | Q Y
|
|---|
| 16 | ;
|
|---|
| 17 | ;
|
|---|
| 18 | FASTEXIT ; -- IBJ EXIT ACTION: sets flag signaling system should be exited
|
|---|
| 19 | S VALMBCK="Q"
|
|---|
| 20 | D FULL^VALM1
|
|---|
| 21 | K DIR S DIR(0)="Y",DIR("A")="Exit option entirely",DIR("B")="NO" D ^DIR
|
|---|
| 22 | I $D(DIRUT)!(Y) S IBFASTXT=5
|
|---|
| 23 | K DIR,DIRUT
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | BM(LONG,SHORT) ; called as part of MENU PROTOCOLS HEADER code so display is set up with/without actions listed
|
|---|
| 27 | ; turn on/off display of actions, extends/contracts bottom margin and number of lines of data display
|
|---|
| 28 | N BM S BM=$S(VALMMENU:SHORT,1:LONG)
|
|---|
| 29 | I VALM("BM")'=BM S VALMBCK="R",VALM("BM")=BM,VALM("LINES")=(VALM("BM")-VALM("TM"))+1
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | PRTCL(X) ; resets menu protocol to one passed in
|
|---|
| 33 | N DIC,Y I $G(X)'="" S DIC=101,DIC(0)="N" D ^DIC I +Y S VALM("PROTOCOL")=+Y_";ORD(101,"
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | FSTRNG(STR,WD,ARRAY) ; returns ARRAY(X) with STR parsed into lines of length WD
|
|---|
| 37 | N X,IBI,IBCNT,DIWL,DIWR,DIWF K ARRAY,^UTILITY($J,"W") S IBCNT=0
|
|---|
| 38 | S X=$G(STR) I X'="" S DIWL=1,DIWR=WD,DIWF="" D ^DIWP
|
|---|
| 39 | I $D(^UTILITY($J,"W")) S (IBI,IBCNT)=0 F S IBI=$O(^UTILITY($J,"W",1,IBI)) Q:'IBI D
|
|---|
| 40 | . S IBCNT=IBCNT+1,ARRAY(IBCNT)=$G(^UTILITY($J,"W",1,IBI,0))
|
|---|
| 41 | K ^UTILITY($J,"W") S ARRAY=IBCNT
|
|---|
| 42 | Q
|
|---|
