ACGSMENU ;IHS/OIRM/DSD/THL,AEF - CONTROL CIS HEADINGS AND MENUS; [ 03/28/2000 8:45 AM ]
;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
;;ROUTINE TO CONTROL CIS HEADINGS AND MENUS
EN ;
TITLE ;EP;TO DISPLAY PACKAGE HEADER
D HOME
D HEAD
EXIT K ACGZ,ACGPREFX,ACGTRM
Q:'+$G(ACGSPARA)
I $D(ACGY),ACGY'="" W !!?80-$L(ACGY)/2,ACGY
Q
HEAD ;EP;TO DISPLAY THE PACKAGE HEADER
D HOME^%ZIS
W @IOF
;Q:$G(ACGPARA)="" ;*** TESTING - AEF ***
Q:$D(ACGQUIT)
I '$D(^ACGPARA(ACGPODA,0)) D EN1^ACGSPARA W:$D(IOF) @IOF
I '$P(^ACGPARA(ACGPODA,0),U) D EN1^ACGSPARA W:$D(IOF) @IOF
I '$D(^ACGPARA(ACGPODA,0)) W "You must select a primary PROCUREMENT OFFICE for this session",!
HEAD1 S ACGPARA=^ACGPARA(ACGPODA,0),ACG4=$P(ACGPARA,U,3)
N ACGX
D H1
D HDVS
I DUZ S ACGX=$P(^VA(200,DUZ,0),U),ACGX=$P($P(ACGX,",",2)," ")_" "_$P(ACGX,","),ACGX="CURRENT USER: "_ACGX W !?80-$L(ACGX)\2,ACGX K ACGX
Q
H1 F ACGJ=0:1:3 S ACGX=$T(TEXT+ACGJ),ACGX=$P(ACGX,";;",2) W !?80-$L(ACGX)\2,ACGX
Q
HDVS K ACGX
I $D(^ACGPARA(ACGPODA,0)) S ACGPARA=^(0),ACG4=$P(ACGPARA,U,3),ACGX="CONTRACTING OFFICE: "_$P(^ACGPO(+ACGPARA,0),U)_" ("_ACG4_")"
S:'$D(ACGPREFX) ACGPREFX="ACG"
I $D(ACGPREFX),$D(^DIC(9.4,"C",ACGPREFX)) S ACGZ=$O(^DIC(9.4,"C",ACGPREFX,0)),ACGZ=$P(^DIC(9.4,ACGZ,22,0),U,3),ACGZ="VERSION "_ACGZ
I IOST["C-" W:$D(ACGZ) !?80-$L(ACGZ)\2,ACGZ
W:$D(ACGX) !?80-$L(ACGX)\2,ACGX
Q
MM ;EP
S ACGY="MAIN MENU" G TITLE
RP S ACGY="REPORTS" G TITLE
CM S ACGY="CONTRACTS MANAGEMENT" G TITLE
SR S ACGY="SYSTEM REPORTS" G TITLE
SS ;EP
S ACGY="SYSTEM SETUP" G TITLE
NQ ;;
TEXT ;;*****************************************
;;** INDIAN HEALTH SERVICE **
;;** CONTRACTS INFORMATION SYSTEM **
;;*****************************************
HOME ;XEP;TO SET UP SCREEN HANDLING VARIABLES FOR CIS
;;THIS POINT IS CALLED BY ARMS DURING INTERFACE BETWEEN ARMS AND CIS
S IOP="HOME" D ^%ZIS
S ACGTRM=^%ZIS(2,IOST(0),5),ACGON=$P(ACGTRM,U,4),ACGOF=$P(ACGTRM,U,5),ACGEOP="W "_$P(ACGTRM,U,7),ACGEOL="W "_$P(ACGTRM,U,6),ACGXY=$P(^%ZIS(2,IOST(0),1),U,5),ACGXYWIN="S DX=0,DY=4 "_ACGXY,ACGW3="X ACGWIN2,ACGXYW2,ACGEOP"
S ACGDXY="S DX=0,DY=18 "_ACGXY,ACGDW="X ACGWIND,ACGDXY,ACGEOP,ACGM",ACGWIND="U 0:0 W *27,*91,19,*59,24,""r"""
S ACGREY="D:'$D(DISYS) OS^DII I $D(^DD(""OS"",DISYS,""XY"")) S DIZ=^(""XY"") I DIZ?1U.E S IOX=0,IOY=DY X DIZ K IOX,IOY"
S ACGXYW2="S DX=0,DY=19 "_ACGXY_" X ACGREY",ACGWIN="U 0:0 W *27,*91,4,*59,24,""r""",ACGWIN2="U 0:0 W *27,*91,20,*59,24,""r""",ACGCWIN="W *27,*91,1,*59,24,""r"" X ACGEOP K ACGMESS,ACGDDIE",ACGOWIN="X ACGWIN,ACGXYWIN,ACGEOP,ACGM"
S ACGW2="X ACGWIN2,ACGXYW2,ACGEOP,ACGM W !",ACGM="W:$D(ACGMESS) !,@ACGON,"" "",ACGMESS,?75,@ACGOF W:'$D(ACGMESS) !,@ACGON,"" "",?79,@ACGOF",ACGPAUSE="D HOLD^ACGSMENU"
S ACGRECNT="N ACGI S ACGI=0 F ACGJ=1:1 S ACGI=$O(ACGDA(ACGI)) Q:'ACGI I ACGI>ACGJ S ACG0(ACGJ)=ACG0(ACGI),ACGDA(ACGJ)=ACGDA(ACGI) K ACG0(ACGI),ACGDA(ACGI),@ACGGREC@(ACGI) S @ACGGREC@(ACGJ,ACGDA(ACGJ))="""",$P(^ACGREC(ACGDA(ACGJ),0),U,26)=ACGJ"
S ACGCHK="I '$D(^ACGREC(ACGDA,0)) S DA=ACGDA,DIK=""^ACGREC("" D ^DIK K DIK,@ACGGREC@(ACGJ) S ACGQUIT="""",ACGJ=ACGJ-1"
S ACGW="W ACGI F ACGJ=1:1:$L(ACGDR,"";"") S ACG=$P(ACGDR,"";"",ACGJ),ACGRDA=ACGI S ACGX=$P(ACGF(ACG),"";;"",3),ACGD=ACGFD(ACG),X="""" X ACGX W ?ACGD,X"
S ACGXEXP="S ACGDEXP=$T(@ACGDSCDA+2^ACGSDSC) X $P(ACGDEXP,"";;"",2) S:ACGDATA'="""" @ACGEXP@(ACGREC,ACGDA)=ACGDATA"
S ACGXEXPD="K @ACGEXP@(ACGREC,ACGDA)"
Q
HOLD ;EP;TO HOLD SCREEN
S DIR(0)="EOA",DIR("A")="Press RETURN to continue....." W ! D ^DIR S:$D(DUOUT) ACGQUIT="" K DIR,DIRUT,DUOUT,DQOUT
Q
ACGSMENU ;IHS/OIRM/DSD/THL,AEF - CONTROL CIS HEADINGS AND MENUS; [ 03/28/2000 8:45 AM ]
+1 ;;2.0t1;CONTRACT INFORMATION SYSTEM;;FEB 16, 2000
+2 ;;ROUTINE TO CONTROL CIS HEADINGS AND MENUS
EN ;
TITLE ;EP;TO DISPLAY PACKAGE HEADER
+1 DO HOME
+2 DO HEAD
EXIT KILL ACGZ,ACGPREFX,ACGTRM
+1 IF '+$GET(ACGSPARA)
QUIT
+2 IF $DATA(ACGY)
IF ACGY'=""
WRITE !!?80-$LENGTH(ACGY)/2,ACGY
+3 QUIT
HEAD ;EP;TO DISPLAY THE PACKAGE HEADER
+1 DO HOME^%ZIS
+2 WRITE @IOF
+3 ;Q:$G(ACGPARA)="" ;*** TESTING - AEF ***
+4 IF $DATA(ACGQUIT)
QUIT
+5 IF '$DATA(^ACGPARA(ACGPODA,0))
DO EN1^ACGSPARA
IF $DATA(IOF)
WRITE @IOF
+6 IF '$PIECE(^ACGPARA(ACGPODA,0),U)
DO EN1^ACGSPARA
IF $DATA(IOF)
WRITE @IOF
+7 IF '$DATA(^ACGPARA(ACGPODA,0))
WRITE "You must select a primary PROCUREMENT OFFICE for this session",!
HEAD1 SET ACGPARA=^ACGPARA(ACGPODA,0)
SET ACG4=$PIECE(ACGPARA,U,3)
+1 NEW ACGX
+2 DO H1
+3 DO HDVS
+4 IF DUZ
SET ACGX=$PIECE(^VA(200,DUZ,0),U)
SET ACGX=$PIECE($PIECE(ACGX,",",2)," ")_" "_$PIECE(ACGX,",")
SET ACGX="CURRENT USER: "_ACGX
WRITE !?80-$LENGTH(ACGX)\2,ACGX
KILL ACGX
+5 QUIT
H1 FOR ACGJ=0:1:3
SET ACGX=$TEXT(TEXT+ACGJ)
SET ACGX=$PIECE(ACGX,";;",2)
WRITE !?80-$LENGTH(ACGX)\2,ACGX
+1 QUIT
HDVS KILL ACGX
+1 IF $DATA(^ACGPARA(ACGPODA,0))
SET ACGPARA=^(0)
SET ACG4=$PIECE(ACGPARA,U,3)
SET ACGX="CONTRACTING OFFICE: "_$PIECE(^ACGPO(+ACGPARA,0),U)_" ("_ACG4_")"
+2 IF '$DATA(ACGPREFX)
SET ACGPREFX="ACG"
+3 IF $DATA(ACGPREFX)
IF $DATA(^DIC(9.4,"C",ACGPREFX))
SET ACGZ=$ORDER(^DIC(9.4,"C",ACGPREFX,0))
SET ACGZ=$PIECE(^DIC(9.4,ACGZ,22,0),U,3)
SET ACGZ="VERSION "_ACGZ
+4 IF IOST["C-"
IF $DATA(ACGZ)
WRITE !?80-$LENGTH(ACGZ)\2,ACGZ
+5 IF $DATA(ACGX)
WRITE !?80-$LENGTH(ACGX)\2,ACGX
+6 QUIT
MM ;EP
+1 SET ACGY="MAIN MENU"
GOTO TITLE
RP SET ACGY="REPORTS"
GOTO TITLE
CM SET ACGY="CONTRACTS MANAGEMENT"
GOTO TITLE
SR SET ACGY="SYSTEM REPORTS"
GOTO TITLE
SS ;EP
+1 SET ACGY="SYSTEM SETUP"
GOTO TITLE
NQ ;;
TEXT ;;*****************************************
+1 ;;** INDIAN HEALTH SERVICE **
+2 ;;** CONTRACTS INFORMATION SYSTEM **
+3 ;;*****************************************
HOME ;XEP;TO SET UP SCREEN HANDLING VARIABLES FOR CIS
+1 ;;THIS POINT IS CALLED BY ARMS DURING INTERFACE BETWEEN ARMS AND CIS
+2 SET IOP="HOME"
DO ^%ZIS
+3 SET ACGTRM=^%ZIS(2,IOST(0),5)
SET ACGON=$PIECE(ACGTRM,U,4)
SET ACGOF=$PIECE(ACGTRM,U,5)
SET ACGEOP="W "_$PIECE(ACGTRM,U,7)
SET ACGEOL="W "_$PIECE(ACGTRM,U,6)
SET ACGXY=$PIECE(^%ZIS(2,IOST(0),1),U,5)
SET ACGXYWIN="S DX=0,DY=4 "_ACGXY
SET ACGW3="X ACGWIN2,ACGXYW2,ACGEOP"
+4 SET ACGDXY="S DX=0,DY=18 "_ACGXY
SET ACGDW="X ACGWIND,ACGDXY,ACGEOP,ACGM"
SET ACGWIND="U 0:0 W *27,*91,19,*59,24,""r"""
+5 SET ACGREY="D:'$D(DISYS) OS^DII I $D(^DD(""OS"",DISYS,""XY"")) S DIZ=^(""XY"") I DIZ?1U.E S IOX=0,IOY=DY X DIZ K IOX,IOY"
+6 SET ACGXYW2="S DX=0,DY=19 "_ACGXY_" X ACGREY"
SET ACGWIN="U 0:0 W *27,*91,4,*59,24,""r"""
SET ACGWIN2="U 0:0 W *27,*91,20,*59,24,""r"""
SET ACGCWIN="W *27,*91,1,*59,24,""r"" X ACGEOP K ACGMESS,ACGDDIE"
SET ACGOWIN="X ACGWIN,ACGXYWIN,ACGEOP,ACGM"
+7 SET ACGW2="X ACGWIN2,ACGXYW2,ACGEOP,ACGM W !"
SET ACGM="W:$D(ACGMESS) !,@ACGON,"" "",ACGMESS,?75,@ACGOF W:'$D(ACGMESS) !,@ACGON,"" "",?79,@ACGOF"
SET ACGPAUSE="D HOLD^ACGSMENU"
+8 SET ACGRECNT="N ACGI S ACGI=0 F ACGJ=1:1 S ACGI=$O(ACGDA(ACGI)) Q:'ACGI I ACGI>ACGJ S ACG0(ACGJ)=ACG0(ACGI),ACGDA(ACGJ)=ACGDA(ACGI) K ACG0(ACGI),ACGDA(ACGI),@ACGGREC@(ACGI) S @ACGGREC@(ACGJ,ACGDA(ACGJ))="""",$P(^ACGREC(ACGDA(ACGJ),0),U,26)=ACG
J"
+9 SET ACGCHK="I '$D(^ACGREC(ACGDA,0)) S DA=ACGDA,DIK=""^ACGREC("" D ^DIK K DIK,@ACGGREC@(ACGJ) S ACGQUIT="""",ACGJ=ACGJ-1"
+10 SET ACGW="W ACGI F ACGJ=1:1:$L(ACGDR,"";"") S ACG=$P(ACGDR,"";"",ACGJ),ACGRDA=ACGI S ACGX=$P(ACGF(ACG),"";;"",3),ACGD=ACGFD(ACG),X="""" X ACGX W ?ACGD,X"
+11 SET ACGXEXP="S ACGDEXP=$T(@ACGDSCDA+2^ACGSDSC) X $P(ACGDEXP,"";;"",2) S:ACGDATA'="""" @ACGEXP@(ACGREC,ACGDA)=ACGDATA"
+12 SET ACGXEXPD="K @ACGEXP@(ACGREC,ACGDA)"
+13 QUIT
HOLD ;EP;TO HOLD SCREEN
+1 SET DIR(0)="EOA"
SET DIR("A")="Press RETURN to continue....."
WRITE !
DO ^DIR
IF $DATA(DUOUT)
SET ACGQUIT=""
KILL DIR,DIRUT,DUOUT,DQOUT
+2 QUIT
