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

ASUUHDG.m

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