Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSMHDR

BPSMHDR.m

Go to the documentation of this file.
  1. BPSMHDR ;BHAM ISC/FCS/DRS - MENUS HEADERS ;06/01/2004
  1. ;;1.0;E CLAIMS MGMT ENGINE;**1,5,10**;JUN 2004;Build 27
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ; reference to IX^DIC for PACKAGE file (#9.4) supported by DBIA 10048
  1. ; reference to $$GET1^DIQ for INSTITUTION file (#4) supported by DBIA 10090
  1. ; reference to $$SITE^VASITE supported by DBIA 10112
  1. ; reference to ENDR^%ZISS supported by DBIA 10088
  1. ;
  1. ; XQY0 from MenuMan in various BPS options
  1. HDR ;EP - Screen header
  1. N A,BPSMT,BPSPNV,BPSHDR,D,DIC,F,L,N,W,X,Y
  1. I '$D(IOM) S IOP="" D ^%ZIS
  1. I '$D(IORVON) S X="IORVON;IORVOFF" D ENDR^%ZISS
  1. ; PACKAGE file (#9.4) lookup
  1. S U="^",D="C",DIC="^DIC(9.4,",X="BPS",DIC(0)="" D IX^DIC
  1. S F=+Y,BPSPNV=$S(F>0:" v"_$$GET1^DIQ(9.4,F,13,1),1:"")
  1. ;
  1. S BPSPNV="Electronic Claims Management Engine (ECME)"_BPSPNV
  1. S A=$P($G(XQY0),U),BPSMT=$S(A="BPSMENU":"Main Menu",A]"":A,1:"BPS option")
  1. ; W is the width
  1. S W=51,BPSHDR(1)=$TR($J("",W)," ","*") ; row of asterisks
  1. S L=W-2-$L(BPSPNV)\2,X="*"_$J("",L)_BPSPNV,BPSHDR(2)=X_$J("",W-$L(X)-1)_"*" ; version
  1. S A=$$LOC,L=W-2-$L(A)\2,X="*"_$J("",L)_A,BPSHDR(3)=X_$J("",W-$L(X)-1)_"*" ; location
  1. S L=W-2-$L(BPSMT)\2,X="*"_$J("",L),L=$L(X)+$L(BPSMT)
  1. S BPSHDR(4)=X_$G(IORVON)_BPSMT_$G(IORVOFF)_$J("",W-L-1)_"*" ; menu option
  1. S L=IOM-W\2 W @IOF,!
  1. F N=1:1:4,1 W !,$J("",L)_BPSHDR(N) ; repeat 1st line at end
  1. W !
  1. Q
  1. ;
  1. ;
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1. N LOC S LOC=""
  1. S:$G(DUZ(2)) LOC=$$GET1^DIQ(4,DUZ(2),.01,"E")
  1. Q $S(LOC]"":LOC,1:$P($$SITE^VASITE,"^",2)) ; DBIA 10112
  1. ;