| [613] | 1 | BPSMHDR ;BHAM ISC/FCS/DRS - MENUS HEADERS ;06/01/2004
|
|---|
| 2 | ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; XQSAV,XQY0 passed in from various BPS options
|
|---|
| 6 | HDR ;EP - Screen header
|
|---|
| 7 | N BPSMT,BPSPNV,D,DIC,X,Y
|
|---|
| 8 | Q:$G(XQY0)=""
|
|---|
| 9 | I $D(XQSAV),XQY0'=XQSAV Q
|
|---|
| 10 | I '$D(IORVON) S X="IORVON;IORVOFF" D ENDR^%ZISS
|
|---|
| 11 | S D="C",DIC="^DIC(9.4,",X="BPS",DIC(0)="" D IX^DIC
|
|---|
| 12 | S BPSPNV=+Y
|
|---|
| 13 | I $G(BPSPNV) S BPSPNV="V"_$$GET1^DIQ(9.4,BPSPNV,13,1)
|
|---|
| 14 | S BPSPNV="Electronic Claims Management Engine (ECME) "_BPSPNV
|
|---|
| 15 | S BPSMT=$S($P(XQY0,U)="BPSMENU":"Main Menu",1:$P(XQY0,U,2))
|
|---|
| 16 | N A,D,F,L,N,R
|
|---|
| 17 | S F=0
|
|---|
| 18 | W !
|
|---|
| 19 | S A=$X W IORVON,IORVOFF S D=$X S:D>A F=D-A ;compute length of revvideo
|
|---|
| 20 | S L=(80-$L(BPSPNV))\2-1,R=L+$L(BPSPNV)+1
|
|---|
| 21 | S D=$L(BPSPNV)+2,N=$L(BPSPNV)-1
|
|---|
| 22 | W @IOF,!,$$CTR($$REPEAT^XLFSTR("*",D)),!
|
|---|
| 23 | W ?L,"*",$$CTR(BPSPNV,N),?R,"*",!
|
|---|
| 24 | W ?L,"*",$$CTR($$LOC(),N),?R,"*",!
|
|---|
| 25 | W ?L,"*",?(L+(((R-L)-$L(BPSMT))\2)),IORVON,BPSMT,IORVOFF,?R+F,"*",!
|
|---|
| 26 | W $$CTR($$REPEAT^XLFSTR("*",D)),!
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | ;----------
|
|---|
| 30 | CTR(X,Y) ;EP - Center X in a field Y wide.
|
|---|
| 31 | Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
|
|---|
| 32 | ;----------
|
|---|
| 33 | ;EP
|
|---|
| 34 | LOC() ;EP - Return location name from file 4 based on DUZ(2).
|
|---|
| 35 | N LOC
|
|---|
| 36 | I '$G(DUZ(2)) Q "DUZ(2) UNDEFINED OR 0"
|
|---|
| 37 | S LOC=$$GET1^DIQ(4,DUZ(2),.01,"E")
|
|---|
| 38 | I LOC'="" Q LOC
|
|---|
| 39 | Q "UNKNOWN"
|
|---|
