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

ASUL18IT.m

Go to the documentation of this file. 
  1. ASUL18IT ; IHS/ITSC/LMH -LOOKUP RTN TABLE 18 SUB STA ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine is the File Man Input transform for SAMS table 18 -
  1.  ;Sub Station table
  1.  I '$D(DUZ(2)) K X W !,"DUZ(2) must be set so Area Accounting Point can be determined" Q
  1.  I '$D(ASUL(1,"AR","AP")) S ASUV("SAVEX")=X D SETAREA^ASULARST S X=ASUV("SAVEX") K ASUV("SAVEX")
  1.  D ARE^ASUUSCRN
  1.  I $D(DIC(0)) S DIC(0)=$TR(DIC(0),"Q") S:DIC(0)'["A" DIC(0)="A"_DIC(0)
  1.  N DIC,DIE
  1. EN2 ;EP; DIC ALREADY SET
  1.  N DIK,DIR,DR
  1.  S X=$G(X)
  1.  I X']"" D ASUL18RC G:$D(DIRUT) ERR  I Y>0 S DA=+Y,X=ASUL(18,"SST","NM") G X
  1.  I X?1N.N D
  1.  .S DA=X
  1.  .I $L(DA)=3 S (ASUL(18,"SST","E#"),X,DA)=ASUL(1,"AR","AP")_DA Q
  1.  .I $L(DA)=2 S (ASUL(18,"SST","E#"),X,DA)=ASUL(1,"AR","AP")_"0"_DA
  1.  I X?5N D  Q:'$D(DA)
  1.  .S DA=X D SST^ASUUSCRN(.DA)
  1.  .I '$D(DA) D  Q
  1.  ..W !?10,$E(DA,1,2)," Is not Accounting Point you are signed on as, which is: ",ASUL(1,"AR","AP"),! D HELP D ERR
  1.  .I $D(^ASUL(18,DA,0)) D  Q  ;SST entry found
  1.  ..S ASUL(18,"SST","E#")=DA,ASUL(18,"SST")=$E(DA,4,5),ASUL(18,"SST","NM")=$P(^ASUL(18,DA,0),U)
  1.  .S ASUL(18,"SST","E#")=DA,ASUL(18,"SST")=$E(DA,4,5)
  1.  .D NAME^ASUL18IT Q:$D(DTOUT)  Q:$D(DUOUT)  Q:'$D(X)
  1.  .D FILE^ASUL18IT S X=ASUL(18,"SST","NM"),DA=ASUL(18,"SST","E#")
  1.  E  D
  1.  .D NMIT^ASUL18IT Q:'$D(X)
  1.  .S ASUL(18,"SST","NM")=X,ASUL(18,"SST","E#")=""
  1.  .F  S ASUL(18,"SST","E#")=$O(^ASUL(18,"C",ASUL(18,"SST","NM"),ASUL(18,"SST","E#"))) Q:$E(ASUL(18,"SST","E#"),1,2)=ASUL(1,"AR","AP")  Q:ASUL(18,"SST","E#")']""
  1.  .I ASUL(18,"SST","E#")]"" S ASUL(18,"SST")=$P(^ASUL(18,ASUL(18,"SST","E#"),1),U) Q
  1.  .D READSST I '$D(ASUL(18,"SST","E#")) D ERR Q
  1.  .I ASUL(18,"SST","E#")'["" D ERR Q
  1.  .D FILE
  1.  G:$D(DIRUT) ERR G:'$D(X) ERR G:X'["" ERR G:$D(DUOUT) ERR G:$D(DTOUT) ERR
  1. X ;
  1.  S DA=ASUL(18,"SST","E#"),X=ASUL(18,"SST","NM")
  1.  I '$D(ASUL("REQ")) K ASUL(18)
  1.  Q
  1. NAME ;EP ;
  1.  S DIR(0)="FA^3:30"
  1.  S DIR("?")="Name may be 3 to 30 characters long"
  1.  S DIR("A")="Enter Sub Station Name for code "_ASUL(18,"SST")_": "
  1.  D ^DIR Q:$D(DTOUT)  Q:$D(DUOUT)  Q:X']""
  1.  S ASUL(18,"SST","NM")=X
  1.  Q
  1. NMIT ;EP ; INPUT TRANSFORM FOR NAME (.01) FIELD
  1.  K:$L(X)<3!($L(X)>30)!(X'?3AN.APN) X
  1.  Q
  1. ARSST ;EP ;
  1.  I '$D(DUZ(2)) K X W !,"DUZ(2) must be set so Area Accounting Point can be determined" Q
  1.  I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
  1.  K:$E(X,1,2)'=ASUL(1,"AR","AP")!(X'?5N) X
  1.  Q
  1. FILE ;EP ;
  1.  N DIC,DIX
  1.  S:'$D(ASUL(1,"AP")) ASUL(1,"AP")=ASUL(1,"AR","AP")
  1.  W !?10,"Adding entry in Sub Station table (18) CODE:",ASUL(18,"SST")
  1.  W !!?48," NAME:",ASUL(18,"SST","NM")
  1.  W !!?48," AREA:",ASUL(1,"AR","AP")
  1.  S DIC="^ASUL(18,",DIC(0)="LISN",X=ASUL(18,"SST","NM"),(DINUM,DA)=ASUL(18,"SST","E#"),DLAYGO=9002039.18 K DD,DO D FILE^DICN
  1. FILE2 ;
  1.  S DR=".02///"_ASUL(1,"AR","AP")_";1///"_ASUL(18,"SST")
  1.  S (DA,D0)=ASUL(18,"SST","E#"),DIE="^ASUL(18," K DD D ^DIE K X
  1.  Q
  1. ERR ;
  1.  K X
  1.  Q
  1. DIC ;EP ;TO SET DIC
  1.  N DIC,DIE
  1.  S (DIC,DIE)="^ASUL(18,",DIC(0)="EALM"
  1.  S (DIE,DIC)="^ASUL(19,",DIC(0)="EALM",DIC("W")="W ""   "" W:$D(^(1)) ""   "",,$P(^(1),U)" D EN2
  1.  Q
  1. HELP ;
  1.  W !?5,"You may only access Sub Station table entries for the Area you are signed"
  1.  W !?5,"in to SAMS with. This is determined using the setting of DUZ(2)"
  1.  W !?5,"which is set when you sign in to SAMS. If you wish to change Areas,"
  1.  W !?5,"you must sign out of SAMS and then sign back in to SAMS selecting the"
  1.  W !?5,"appropriate DIVISION (area). If when you sign in to SAMS you are not"
  1.  W !?5,"prompted for a DIVISION, then you are automatically signed on as a"
  1.  W !?5,"specific Area and are restricted to that Area."
  1.  W !!?5,"You will be asked for the Sub Station Code or Sub Station Name for the"
  1.  W !?5,"entry you wish to Access. If an entry for that Sub Station does not exist,"
  1.  W !?5,"you will also be asked for the Sub Station Name or Sub Station Code"
  1.  W !?5,"(whichever has not already been enterd) so that a new entry may be added."
  1.  Q
  1. ASUL18RC ;EP; READ AFTER CLEAR LOCAL VARIABLES
  1.  K ASUL(18)
  1. READSST ;EP ;Get Sub Station to be processed
  1.  N DIR
  1.  S DIR(0)="FAO^2:5^K:X'?2AN.N X",DIR("A")="ENTER SUB STATION CODE "
  1.  S DIR("?")="^D HLPSSAD^ASUL18IT"
  1.  S DIR("??")="^D HLPSSLS^ASUL18IT"
  1.  D ^DIR Q:$D(DIROUT)  Q:$D(DUOUT)  Q:$D(DTOUT)
  1.  I X["PL" S DA=ASUL(1,"AR","AP")_999,ASUL(18,"SST")=X
  1.  I X?2N S ASUL(18,"SST")=X
  1.  I X?3N S ASUL(18,"SST")=$E(X,2,3)
  1.  S DA=X
  1.  D SST^ASULDIRR(.DA)
  1.  I Y<0 D
  1.  .W !,"No entry in Sub Station Table (18) for ",X
  1.  .S ASUF("HALT")=1
  1.  I $G(ASUL(18,"SST"))']"" S ASUF("HALT")=1
  1.  W " ",$G(ASUL(18,"SST","NM"))
  1.  Q
  1. HLPSSLST ;EP ;
  1.  N DIC,DO
  1.  S DIC="^ASUL(18,",DIC("S")="I $P(^(0),U,2)=ASUL(1,""AR"",""AP"")"
  1.  S DIC(0)="MEI",D="B",DZ="??" D DQ^DICQ
  1.  Q
  1. HLPSSADD ;
  1.  W !,"For the Sub Station to be found, Enter either:"
  1.  W !?10,"2 digit Sub Station code or"
  1.  W !?10,"?? to see a list of current entries in the Sub Station Table"
  1.  W !?10,"Enter '^' or <enter> to end session"
  1.  Q