ASUUHDG ; IHS/ITSC/LMH - SAMS MENU HEADINGS ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;;Y2K/OK AEF/2980414
;;
EN ;EP
; ----- ENTRY POINT CALLED BY ENTRY ACTION FIELD -----
K XQUIT
D ^XBKVAR,^ASUVAR I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) Q
S ASUUOUT=0
D HOME^ASUUHDG,AC^ASUUHDG,RV^ASUUHDG
I ASUUOUT S XQUIT=1
D KILL^ASUUHDG
Q
HOME ;EP ; ----- SETS HOME DEVICE IO VARIABLES -----
D HOME^%ZIS,ENS^%ZISS
S ACRTRM=^%ZIS(2,IOST(0),5)
S ACRON=$P(ACRTRM,U,4),ACROF=$P(ACRTRM,U,5)
Q
AC ;EP ; ----- WRITES WARNING MESSAGE IF FILEMAN ACCESS CODE NOT RIGHT -----
I DUZ(0)=""!((DUZ(0)'["#")&(DUZ(0)'["s")&(DUZ(0)'["S")) D
. W *7,*7
. D WRITE^ASUUHDG("ACTXT",0)
. D PAZ^ASUURHDR
Q
RV ;EP ; ----- WRITES WARNING MESSAGE IF REVERSE VIDEO NOT DEFINED -----
Q:$G(ACRON)]""&($G(ACROF)]"")
W @IOF
W *7,*7
K ASUU
S ASUU(1)=$I
D WRITE^ASUUHDG("RVTXT",0,.ASUU)
D PAZ^ASUURHDR
K ASUU
Q
HDR(ASUUM) ;EP
; ----- ENTRY POINT CALLED BY HEADER FIELD, WRITES HEADING -----
;
; ASUUM = MENU NAME
;
N Y K ASUK("HDG")
S Y=$O(^DIC(9.4,"C","ASU",0))
I Y S (ASUU(1),ASUK("HDG","VER"))=$P(^DIC(9.4,Y,"VERSION"),U)
S (ASUU(2),ASUK("HDG","ARNM"))=$G(ASUL(1,"AR","NM")) I ASUK("HDG","ARNM")']"" D
.D ^ASUVAR Q:$D(DTOUT) Q:$D(DUOUT) S (ASUU(2),ASUK("HDG","ARNM"))=ASUL(1,"AR","NM")
S (ASUU(3),ASUK("HDG","STNM"))=$G(ASUL(2,"STA","NM"))
S Y=$P(^VA(200,DUZ,0),U)
S (ASUU(4),ASUK("HDG","USER"))=$P($P(Y,",",2)," ")_" "_$P(Y,",")
S (ASUU(5),ASUK("HDG","MENU"))=ASUUM
W @IOF
D WRITE^ASUUHDG("HDG",1,.ASUU)
K ASUU Q
WRITE(ASUUTXT,ASUUCTR,ASUU) ;EP ;
; ----- WRITES THE TEXT STRING -----
;
; ASUUTXT = TEXT STRINGS
; ASUUCTR = CENTERING 0=NO CENTER, 1=CENTER
; ASUU = ARRAY CONTAINING HEADER 'FILL IN BLANK' INFO
;
I $G(ASUF("WARN"))']"" W !,"*************** WARNING: UNAUTHORIZED USE IS A FEDERAL CRIME ****************",! S ASUF("WARN")=1
F ASUUI=1:1 Q:$P($T(@ASUUTXT+ASUUI),";",3)["$$END" D
. S ASUUX=$P($T(@ASUUTXT+ASUUI),";",3)
. W !?$S(ASUUCTR:(IOM-$L($$STR^ASUUHDG(ASUUX,.ASUU)))\2,1:0),$$STR^ASUUHDG(ASUUX,.ASUU)
Q
SETT ;EP;
N X
I $D(XQY0) S X=$P(XQY0,U,2)
E D
.S X=$G(ASUL(11,"TRN","NAME")),Y="" D LOWCASE(.X,.Y) S X=$G(ASUL(11,"TRN","CDE"))_" - "_Y
S Y="********** Entering "_X_" Records **********"
Q
LOWCASE(X,Y) ;
N Z F Z=1:1 S Z(1)=$P(X," ",Z) Q:Z(1)']"" D
.S Z(2)=$E(Z(1),2,$L(Z(1)))
.S Z(3)=$TR(Z(2),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
.S:$L(Y)>0 Y=Y_" "
.S Y=Y_$E(Z(1))_Z(3)
Q
SETU ;EP;
S ASUU(1)=ASUK("HDG","VER")
S ASUU(2)=ASUK("HDG","ARNM")
S ASUU(3)=ASUK("HDG","STNM")
S ASUU(4)=ASUK("HDG","USER")
S ASUU(5)="Entering "_$S($D(XQY0):$P(XQY0,U,2),1:$G(ASUL(11,"TRN","NM")))_" Records"
D SETY(1,.ASUU)
Q
SETY(X,ASUU) ;EP;
S Y=$P($T(HDG+X),";",3)
S Y=$$STR^ASUUHDG(Y,.ASUU)
Q
;
PAWS ;EP ; ----- GIVE USER CHANCE TO ESCAPE -----
Q:$E(IOST,1,2)'="C-"
S DIR(0)="E" D ^DIR K DIR
S ASUUOUT='Y
Q
KILL ;EP ; ----- CLEAN UP VARIABLES -----
K ASUU,ASUUCTR,ASUUI,ASUUTXT,ASUUX
Q
STR(ASUUX,ASUU) ;EP
; ----- EXTRINSIC FUNCTION TO CONVERT TEXT STRINGS -----
;
; ASUU = THE ARRAY CONTAINING 'FILL IN BLANK' INFO
; ASUUX = THE TEXT STRING TO BE CONVERTED
;
F Q:ASUUX'["|" D
. S ASUUX=$P(ASUUX,"|")_$S(+$P(ASUUX,"|",2)'>0:"",'$D(ASUU(+$P(ASUUX,"|",2)))#2:"",1:ASUU(+$P(ASUUX,"|",2)))_$E(ASUUX,$F(ASUUX,"|")+2,256)
Q ASUUX
;
CLS ;EP ;FORM FEED OR CLEAR SCREEN
I $G(IOF)]"" D
.W @(IOF)
E D
.I $D(ASUK("PTR")) D
..I $D(ASUK(ASUK("PTR"),"IOF")) W @(ASUK(ASUK("PTR"),"IOF"))
.E D ^XBCLS
Q
ACTXT ;EP ; ----- TEXT FOR FM ACCESS CODE WARNING MESSAGE -----
;;
;; WARNING WARNING WARNING WARNING WARNING
;;
;;You do NOT have the correct FILE MANAGER ACCESS CODE to use SAMS.
;;Contact the SAMS Manager at the Area Office Immediately. DO NOT use
;;SAMS until you have been assigned the proper FILE MANAGER ACCESS CODE.
;;$$END
RVTXT ;EP ; ----- TEXT FOR REVERSE VIDEO WARNING MESSAGE -----
;;
;; WARNING WARNING WARNING WARNING WARNING
;;
;;Your DEVICE and/or TERMINAL TYPE are not properly defined to work with the SAMS
;;system. The REVERSE VIDEO ON and/or REVERSE VIDEO OFF are not properly defined.
;;This is the responsibility of the AREA OFFICE computer site manager.
;;
;;Please contact this individual for assistance. Let him/her know that you
;;are logged in on device NO.: |1|.
;;$$END
HDG ;EP ; ----- TEXT OF THE MENU HEADING -----
;;************************ S **** A **** M **** S *********************
;;SUPPLY ACCOUNTING MANAGEMENT SYSTEM VER: |1|
;;AREA: |2| STATION: |3| USED BY: |4|
;;*********************************************************************
;;|5|
;;$$END
ASUUHDG ; IHS/ITSC/LMH - SAMS MENU HEADINGS ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;;Y2K/OK AEF/2980414
+3 ;;
EN ;EP
+1 ; ----- ENTRY POINT CALLED BY ENTRY ACTION FIELD -----
+2 KILL XQUIT
+3 DO ^XBKVAR
DO ^ASUVAR
IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
QUIT
+4 SET ASUUOUT=0
+5 DO HOME^ASUUHDG
DO AC^ASUUHDG
DO RV^ASUUHDG
+6 IF ASUUOUT
SET XQUIT=1
+7 DO KILL^ASUUHDG
+8 QUIT
HOME ;EP ; ----- SETS HOME DEVICE IO VARIABLES -----
+1 DO HOME^%ZIS
DO ENS^%ZISS
+2 SET ACRTRM=^%ZIS(2,IOST(0),5)
+3 SET ACRON=$PIECE(ACRTRM,U,4)
SET ACROF=$PIECE(ACRTRM,U,5)
+4 QUIT
AC ;EP ; ----- WRITES WARNING MESSAGE IF FILEMAN ACCESS CODE NOT RIGHT -----
+1 IF DUZ(0)=""!((DUZ(0)'["#")&(DUZ(0)'["s")&(DUZ(0)'["S"))
Begin DoDot:1
+2 WRITE *7,*7
+3 DO WRITE^ASUUHDG("ACTXT",0)
+4 DO PAZ^ASUURHDR
End DoDot:1
+5 QUIT
RV ;EP ; ----- WRITES WARNING MESSAGE IF REVERSE VIDEO NOT DEFINED -----
+1 IF $GET(ACRON)]""&($GET(ACROF)]"")
QUIT
+2 WRITE @IOF
+3 WRITE *7,*7
+4 KILL ASUU
+5 SET ASUU(1)=$IO
+6 DO WRITE^ASUUHDG("RVTXT",0,.ASUU)
+7 DO PAZ^ASUURHDR
+8 KILL ASUU
+9 QUIT
HDR(ASUUM) ;EP
+1 ; ----- ENTRY POINT CALLED BY HEADER FIELD, WRITES HEADING -----
+2 ;
+3 ; ASUUM = MENU NAME
+4 ;
+5 NEW Y
KILL ASUK("HDG")
+6 SET Y=$ORDER(^DIC(9.4,"C","ASU",0))
+7 IF Y
SET (ASUU(1),ASUK("HDG","VER"))=$PIECE(^DIC(9.4,Y,"VERSION"),U)
+8 SET (ASUU(2),ASUK("HDG","ARNM"))=$GET(ASUL(1,"AR","NM"))
IF ASUK("HDG","ARNM")']""
Begin DoDot:1
+9 DO ^ASUVAR
IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
SET (ASUU(2),ASUK("HDG","ARNM"))=ASUL(1,"AR","NM")
End DoDot:1
+10 SET (ASUU(3),ASUK("HDG","STNM"))=$GET(ASUL(2,"STA","NM"))
+11 SET Y=$PIECE(^VA(200,DUZ,0),U)
+12 SET (ASUU(4),ASUK("HDG","USER"))=$PIECE($PIECE(Y,",",2)," ")_" "_$PIECE(Y,",")
+13 SET (ASUU(5),ASUK("HDG","MENU"))=ASUUM
+14 WRITE @IOF
+15 DO WRITE^ASUUHDG("HDG",1,.ASUU)
+16 KILL ASUU
QUIT
WRITE(ASUUTXT,ASUUCTR,ASUU) ;EP ;
+1 ; ----- WRITES THE TEXT STRING -----
+2 ;
+3 ; ASUUTXT = TEXT STRINGS
+4 ; ASUUCTR = CENTERING 0=NO CENTER, 1=CENTER
+5 ; ASUU = ARRAY CONTAINING HEADER 'FILL IN BLANK' INFO
+6 ;
+7 IF $GET(ASUF("WARN"))']""
WRITE !,"*************** WARNING: UNAUTHORIZED USE IS A FEDERAL CRIME ****************",!
SET ASUF("WARN")=1
+8 FOR ASUUI=1:1
IF $PIECE($TEXT(@ASUUTXT+ASUUI),";",3)["$$END"
QUIT
Begin DoDot:1
+9 SET ASUUX=$PIECE($TEXT(@ASUUTXT+ASUUI),";",3)
+10 WRITE !?$SELECT(ASUUCTR:(IOM-$LENGTH($$STR^ASUUHDG(ASUUX,.ASUU)))\2,1:0),$$STR^ASUUHDG(ASUUX,.ASUU)
End DoDot:1
+11 QUIT
SETT ;EP;
+1 NEW X
+2 IF $DATA(XQY0)
SET X=$PIECE(XQY0,U,2)
+3 IF '$TEST
Begin DoDot:1
+4 SET X=$GET(ASUL(11,"TRN","NAME"))
SET Y=""
DO LOWCASE(.X,.Y)
SET X=$GET(ASUL(11,"TRN","CDE"))_" - "_Y
End DoDot:1
+5 SET Y="********** Entering "_X_" Records **********"
+6 QUIT
LOWCASE(X,Y) ;
+1 NEW Z
FOR Z=1:1
SET Z(1)=$PIECE(X," ",Z)
IF Z(1)']""
QUIT
Begin DoDot:1
+2 SET Z(2)=$EXTRACT(Z(1),2,$LENGTH(Z(1)))
+3 SET Z(3)=$TRANSLATE(Z(2),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
+4 IF $LENGTH(Y)>0
SET Y=Y_" "
+5 SET Y=Y_$EXTRACT(Z(1))_Z(3)
End DoDot:1
+6 QUIT
SETU ;EP;
+1 SET ASUU(1)=ASUK("HDG","VER")
+2 SET ASUU(2)=ASUK("HDG","ARNM")
+3 SET ASUU(3)=ASUK("HDG","STNM")
+4 SET ASUU(4)=ASUK("HDG","USER")
+5 SET ASUU(5)="Entering "_$SELECT($DATA(XQY0):$PIECE(XQY0,U,2),1:$GET(ASUL(11,"TRN","NM")))_" Records"
+6 DO SETY(1,.ASUU)
+7 QUIT
SETY(X,ASUU) ;EP;
+1 SET Y=$PIECE($TEXT(HDG+X),";",3)
+2 SET Y=$$STR^ASUUHDG(Y,.ASUU)
+3 QUIT
+4 ;
PAWS ;EP ; ----- GIVE USER CHANCE TO ESCAPE -----
+1 IF $EXTRACT(IOST,1,2)'="C-"
QUIT
+2 SET DIR(0)="E"
DO ^DIR
KILL DIR
+3 SET ASUUOUT='Y
+4 QUIT
KILL ;EP ; ----- CLEAN UP VARIABLES -----
+1 KILL ASUU,ASUUCTR,ASUUI,ASUUTXT,ASUUX
+2 QUIT
STR(ASUUX,ASUU) ;EP
+1 ; ----- EXTRINSIC FUNCTION TO CONVERT TEXT STRINGS -----
+2 ;
+3 ; ASUU = THE ARRAY CONTAINING 'FILL IN BLANK' INFO
+4 ; ASUUX = THE TEXT STRING TO BE CONVERTED
+5 ;
+6 FOR
IF ASUUX'["|"
QUIT
Begin DoDot:1
+7 SET ASUUX=$PIECE(ASUUX,"|")_$SELECT(+$PIECE(ASUUX,"|",2)'>0:"",'$DATA(ASUU(+$PIECE(ASUUX,"|",2)))#2:"",1:ASUU(+$PIECE(ASUUX,"|",2)))_$EXTRACT(ASUUX,$FIND(ASUUX,"|")+2,256)
End DoDot:1
+8 QUIT ASUUX
+9 ;
CLS ;EP ;FORM FEED OR CLEAR SCREEN
+1 IF $GET(IOF)]""
Begin DoDot:1
+2 WRITE @(IOF)
End DoDot:1
+3 IF '$TEST
Begin DoDot:1
+4 IF $DATA(ASUK("PTR"))
Begin DoDot:2
+5 IF $DATA(ASUK(ASUK("PTR"),"IOF"))
WRITE @(ASUK(ASUK("PTR"),"IOF"))
End DoDot:2
+6 IF '$TEST
DO ^XBCLS
End DoDot:1
+7 QUIT
ACTXT ;EP ; ----- TEXT FOR FM ACCESS CODE WARNING MESSAGE -----
+1 ;;
+2 ;; WARNING WARNING WARNING WARNING WARNING
+3 ;;
+4 ;;You do NOT have the correct FILE MANAGER ACCESS CODE to use SAMS.
+5 ;;Contact the SAMS Manager at the Area Office Immediately. DO NOT use
+6 ;;SAMS until you have been assigned the proper FILE MANAGER ACCESS CODE.
+7 ;;$$END
RVTXT ;EP ; ----- TEXT FOR REVERSE VIDEO WARNING MESSAGE -----
+1 ;;
+2 ;; WARNING WARNING WARNING WARNING WARNING
+3 ;;
+4 ;;Your DEVICE and/or TERMINAL TYPE are not properly defined to work with the SAMS
+5 ;;system. The REVERSE VIDEO ON and/or REVERSE VIDEO OFF are not properly defined.
+6 ;;This is the responsibility of the AREA OFFICE computer site manager.
+7 ;;
+8 ;;Please contact this individual for assistance. Let him/her know that you
+9 ;;are logged in on device NO.: |1|.
+10 ;;$$END
HDG ;EP ; ----- TEXT OF THE MENU HEADING -----
+1 ;;************************ S **** A **** M **** S *********************
+2 ;;SUPPLY ACCOUNTING MANAGEMENT SYSTEM VER: |1|
+3 ;;AREA: |2| STATION: |3| USED BY: |4|
+4 ;;*********************************************************************
+5 ;;|5|
+6 ;;$$END
