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

ABSPMHDR.m

Go to the documentation of this file. 
  1. ABSPMHDR ; IHS/FCS/DRS - MENUS HEADERS ; 
  1.  ;;1.0;PHARMACY POINT OF SALE;**18,22,23**;JUN 21, 2001;Build 38
  1.  ;
  1.  ;****** Send this routine with each new patch with **n** in piece
  1.  ;****** 3 so the patch level can be displayed as part of the
  1.  ;****** menu header.
  1.  ;IHS/SD/RLT - 8/24/06 - Patch 18
  1.  ;             New code to display patch number in header.
  1.  ;IHS/SD/RLT - 09/20/07 - Patch 22
  1.  ;             Added splash screent for held 3PB claims.
  1.  ;IHS/OIT/SCR - 9/16/08 - Patch 28
  1.  ;            Removed Patch 22 splash screen for held 3PB claims
  1. INIT ;EP -
  1.  I $G(XQY0)'="",$G(ABSPTOP)="" S ABSPTOP=XQY0
  1.  S ABSPY="",ABSPY=$O(^DIC(9.4,"C","ABSP",ABSPY))
  1.  S ABSPVER=^DIC(9.4,ABSPY,"VERSION"),ABSPVER="V"_ABSPVER K ABSPY
  1.  ;RLT - Patch 18
  1.  ;S X=$T(+2),X=$P(X,";;",2),X=$P(X,";",3),X=$P(X,"**",2),X=$P(X,",",$L(X,","))
  1.  S X=$P($$LAST^XPDUTL("PHARMACY POINT OF SALE"),U)
  1.  ;RLT - Patch 18
  1.  S:X]"" ABSPVER=ABSPVER_" P"_X
  1.  S ABSPPNM="PHARMACY POINT OF SALE"
  1.  I '$D(DUZ(2)) W !!,"Your SITE NAME is not set for the KERNEL.",!,"Please contact your System Support person.",!! S ABSPQUIT=1 Q
  1.  I '$D(DUZ(0)) W !!,"You do not have the DUZ(0) variable.",!,"Please contact your System Support person.",!! S ABSPQUIT=1 Q
  1.  I DUZ(0)'["M",DUZ(0)'["P",DUZ(0)'["p",DUZ(0)'["@" W !!,"You do not have the appropriate FileMan access.",!,"Please contact your System Support person.",!! S ABSPQUIT=1 Q
  1.  ;IHS/OIT/SCR - 09/16/08 - Patch 28 - START changes to Remove Patch 22 splash screen for held 3PB claims
  1.  ;IHS/SD/RLT - 09/20/07 - Patch 22
  1.  ; I $P(XQY0,U)="ABSPMENU" D
  1.  ;.N HOLDCHK
  1.  ;.S HOLDCHK=$O(^ABSPHOLD(0))
  1.  ;.I HOLDCHK D HOLDSCR^ABSPOSBH
  1.  ;IHS/OIT/SCR - 09/16/08 - Patch 28 - END changes Remove Patch 22 splash screen for held 3PB claims
  1.  S ABSPSITE=$P(^DIC(4,DUZ(2),0),"^")
  1.  I '$D(IORVON) S X="IORVON;IORVOFF" D ENDR^%ZISS
  1.  I $G(IO) S Y=$O(^%ZIS(1,"C",IO,0)) I Y S Y=$P($G(^%ZIS(1,Y,"SUBTYPE")),U) I Y S X=$G(^%ZIS(2,Y,5)),ABSPRVON=$P(X,U,4),ABSPRVOF=$P(X,U,5)
  1.  I $G(ABSPRVON)="" S ABSPRVON="""""",ABSPRVOF=""""""
  1.  Q
  1.  ;
  1. HDR ;EP - Screen header.
  1.  Q:$G(XQY0)=""
  1.  I $G(ABSPTOP)="" D INIT Q:$G(ABSPQUIT)
  1.  I '$D(IORVON) S X="IORVON;IORVOFF" D ENDR^%ZISS
  1.  S X=$P(XQY0,U,2),ABSPMT=$S($P(XQY0,U)="ABSPMENU":"Main Menu",1:X)
  1.  S ABSPPNV=ABSPPNM_" "_ABSPVER
  1.  NEW A,D,F,I,L,N,R,V
  1.  S F=0
  1.  W !
  1.  S A=$X W IORVON,IORVOFF S D=$X S:D>A F=D-A ;compute length of revvideo
  1.  S L=18,R=61,D=R-L+1,N=R-L-1
  1.  W @IOF,!,$$CTR($$REPEAT^XLFSTR("*",D)),!
  1.  W ?L,"*",$$CTR(ABSPPNV,N),?R,"*",!
  1.  W ?L,"*",$$CTR($$LOC(),N),?R,"*",!
  1.  W ?L,"*",?(L+(((R-L)-$L(ABSPMT))\2)),IORVON,ABSPMT,IORVOFF,?R+F,"*",!
  1.  W $$CTR($$REPEAT^XLFSTR("*",D)),!
  1.  K ABSPMT,ABSPPNV
  1.  Q
  1.  ;
  1.  ;----------
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. LJRF(X,Y,Z) ;EP - left justify X in a field Y wide, right filling with Z.
  1.  NEW L,M
  1.  I $L(X)'<Y Q $E(X,1,Y-1)_Z
  1.  S L=Y-$L(X)
  1.  S $P(M,Z,L)=Z
  1.  Q X_M
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")