- 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 Jan 18, 2025@02:52:26 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 ;