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