BPSMHDR ;BHAM ISC/FCS/DRS - MENUS HEADERS ;06/01/2004
;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; reference to IX^DIC for PACKAGE file (#9.4) supported by DBIA 10048
; reference to $$GET1^DIQ for INSTITUTION file (#4) supported by DBIA 10090
; reference to $$SITE^VASITE supported by DBIA 10112
; reference to ENDR^%ZISS supported by DBIA 10088
;
; XQY0 from MenuMan in various BPS options
HDR ;EP - Screen header
N A,BPSMT,BPSPNV,BPSHDR,D,DIC,F,L,N,W,X,Y
I '$D(IOM) S IOP="" D ^%ZIS
I '$D(IORVON) S X="IORVON;IORVOFF" D ENDR^%ZISS
; PACKAGE file (#9.4) lookup
S U="^",D="C",DIC="^DIC(9.4,",X="BPS",DIC(0)="" D IX^DIC
S F=+Y,BPSPNV=$S(F>0:" v"_$$GET1^DIQ(9.4,F,13,1),1:"")
;
S BPSPNV="Electronic Claims Management Engine (ECME)"_BPSPNV
S A=$P($G(XQY0),U),BPSMT=$S(A="BPSMENU":"Main Menu",A]"":A,1:"BPS option")
; W is the width
S W=51,BPSHDR(1)=$TR($J("",W)," ","*") ; row of asterisks
S L=W-2-$L(BPSPNV)\2,X="*"_$J("",L)_BPSPNV,BPSHDR(2)=X_$J("",W-$L(X)-1)_"*" ; version
S A=$$LOC,L=W-2-$L(A)\2,X="*"_$J("",L)_A,BPSHDR(3)=X_$J("",W-$L(X)-1)_"*" ; location
S L=W-2-$L(BPSMT)\2,X="*"_$J("",L),L=$L(X)+$L(BPSMT)
S BPSHDR(4)=X_$G(IORVON)_BPSMT_$G(IORVOFF)_$J("",W-L-1)_"*" ; menu option
S L=IOM-W\2 W @IOF,!
F N=1:1:4,1 W !,$J("",L)_BPSHDR(N) ; repeat 1st line at end
W !
Q
;
;
LOC() ;EP - Return location name from file 4 based on DUZ(2).
N LOC S LOC=""
S:$G(DUZ(2)) LOC=$$GET1^DIQ(4,DUZ(2),.01,"E")
Q $S(LOC]"":LOC,1:$P($$SITE^VASITE,"^",2)) ; DBIA 10112
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSMHDR 1616 printed Dec 13, 2024@01:51:13 Page 2
BPSMHDR ;BHAM ISC/FCS/DRS - MENUS HEADERS ;06/01/2004
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; reference to IX^DIC for PACKAGE file (#9.4) supported by DBIA 10048
+5 ; reference to $$GET1^DIQ for INSTITUTION file (#4) supported by DBIA 10090
+6 ; reference to $$SITE^VASITE supported by DBIA 10112
+7 ; reference to ENDR^%ZISS supported by DBIA 10088
+8 ;
+9 ; XQY0 from MenuMan in various BPS options
HDR ;EP - Screen header
+1 NEW A,BPSMT,BPSPNV,BPSHDR,D,DIC,F,L,N,W,X,Y
+2 IF '$DATA(IOM)
SET IOP=""
DO ^%ZIS
+3 IF '$DATA(IORVON)
SET X="IORVON;IORVOFF"
DO ENDR^%ZISS
+4 ; PACKAGE file (#9.4) lookup
+5 SET U="^"
SET D="C"
SET DIC="^DIC(9.4,"
SET X="BPS"
SET DIC(0)=""
DO IX^DIC
+6 SET F=+Y
SET BPSPNV=$SELECT(F>0:" v"_$$GET1^DIQ(9.4,F,13,1),1:"")
+7 ;
+8 SET BPSPNV="Electronic Claims Management Engine (ECME)"_BPSPNV
+9 SET A=$PIECE($GET(XQY0),U)
SET BPSMT=$SELECT(A="BPSMENU":"Main Menu",A]"":A,1:"BPS option")
+10 ; W is the width
+11 ; row of asterisks
SET W=51
SET BPSHDR(1)=$TRANSLATE($JUSTIFY("",W)," ","*")
+12 ; version
SET L=W-2-$LENGTH(BPSPNV)\2
SET X="*"_$JUSTIFY("",L)_BPSPNV
SET BPSHDR(2)=X_$JUSTIFY("",W-$LENGTH(X)-1)_"*"
+13 ; location
SET A=$$LOC
SET L=W-2-$LENGTH(A)\2
SET X="*"_$JUSTIFY("",L)_A
SET BPSHDR(3)=X_$JUSTIFY("",W-$LENGTH(X)-1)_"*"
+14 SET L=W-2-$LENGTH(BPSMT)\2
SET X="*"_$JUSTIFY("",L)
SET L=$LENGTH(X)+$LENGTH(BPSMT)
+15 ; menu option
SET BPSHDR(4)=X_$GET(IORVON)_BPSMT_$GET(IORVOFF)_$JUSTIFY("",W-L-1)_"*"
+16 SET L=IOM-W\2
WRITE @IOF,!
+17 ; repeat 1st line at end
FOR N=1:1:4,1
WRITE !,$JUSTIFY("",L)_BPSHDR(N)
+18 WRITE !
+19 QUIT
+20 ;
+21 ;
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 NEW LOC
SET LOC=""
+2 if $GET(DUZ(2))
SET LOC=$$GET1^DIQ(4,DUZ(2),.01,"E")
+3 ; DBIA 10112
QUIT $SELECT(LOC]"":LOC,1:$PIECE($$SITE^VASITE,"^",2))
+4 ;
