ASUL20IT ; IHS/ITSC/LMH -IN TRANSFORM REQUSITIONER TABLE 20 ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine is the File Man Input transform for SAMS table 20 -
;Requsitioner table
I '$D(DUZ(2)) K X W !?10,"DUZ(2) must be set so Area Accounting Point can be determined" Q
I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
I $D(DIC(0)) D
.S DIC(0)=$TR(DIC(0),"Q")
.S:DIC(0)'["N" DIC(0)="N"_DIC(0)
.S:DIC(0)'["A" DIC(0)="A"_DIC(0)
E D
.S DIC(0)="NAE"
N DIK,DIR,DR,DIC,DIE
S (DIC,DIE)=9002039.2
EN1 ;X ALREADY SET BY EN2
S X=$G(X),ASUL("REQ")=1
I X']"" D ASUL19RC^ASUL19IT G:$D(DIRUT) ERR I Y>0 G SST
I $D(DA) D G:ASUL("REQ")=2 REQ G:$D(ASUL(19,"USR","E#")) SST
.I DA?9N,$D(^ASUL(20,+DA,0)) D I ASUL("REQ")=2 Q
..I $E(DA,1,2)=ASUL(1,"AR","AP") S ASUL("REQ")=2
.I $D(^ASUL(19,+DA,0)),DA?6N D I Y>0 K DA
..I $E(DA,1,2)=ASUL(1,"AR","AP") D USR^ASULDIRR(.DA)
E D
.S DA=X
I DA]"" K Y D G:$G(Y)>0 SST
.I DA?6N,$D(^ASUL(19,+DA,0)) D Q:$G(Y)>0
..I $E(DA,1,2)'=ASUL(1,"AR","AP") Q
..I $G(ASUL(19,"USR","E#"))'=DA D USR^ASULDIRR(.DA) Q:Y<-1 Q:Y>0
..I Y=-1 D USR^ASULDIRA(.DA) Q:Y<0
.E D
..I DA?1AN.ANP S Y=$O(^ASUL(19,"B",DA,"")) I Y]"" S DA=Y D USR^ASULDIRR(.DA) Q
E D
.D DIC^ASUL19IT
G:$D(DIRUT) ERR
I $D(ASUL(19)) G SST
W !?5,"No valid Requsitioner, User, or Sub Station entered"
G ERR
SST ;
I $D(ASUL(18)) G REQ
D ASUL18RC^ASUL18IT
G:$D(DIRUT) ERR
I $D(ASUL(18)) G REQ
I Y>0 S DA=Y D SST^ASULDIRR(.DA)
I $D(ASUL(18)) G REQ
D DIC^ASUL18IT
I '$D(ASUL(18,"SST","E#")) W !?5,"Valid Sub Station not entered" G ERR
REQ ;
I '$D(DA),$D(ASUL(18,"SST","E#")),$D(ASUL(19,"USR","E#")) S DA=ASUL(18,"SST","E#")_$E(ASUL(19,"USR","E#"),3,6)
I DA?9N D G:Y>0 EXIT
.I '$D(ASUL(18,"SST","E#")) S ASUL(18,"SST","E#")=$E(DA,1,5) D SST^ASULDIRR(ASUL(18,"SST","E#"))
.I '$D(ASUL(19,"USR","E#")) S ASUL(19,"USR","E#")=$E(DA,1,2)_$E(DA,6,9) D USR^ASULDIRR(ASUL(19,"USR","E#"))
.D REQ^ASULDIRR(.DA)
I $D(ASUL(18,"SST","E#")) D
.I $D(ASUL(19,"USR","E#")) D
..S (DA,ASUL(20,"REQ","E#"))=ASUL(18,"SST","E#")_$E(ASUL(19,"USR","E#"),3,6)
..D REQ^ASULDIRR(.DA)
..D:Y<0 FILE
.E D
..W !?5,"Valid User not entered" D ERR
E D
.W !?5,"Valid Sub Station not entered" D ERR
G:'$D(X) ERR
EXIT ;
S (DA,D0)=ASUL(20,"REQ","E#"),X=ASUL(20,"REQ","NM")
K ASUL(18),ASUL(19),ASUL(20),ASUL(22),ASUL("REQ")
Q
ARIT ;EP;;AREA POINTER INPUT TRANSFORM FOR FILEMAN
N Z S Z=$E(DA,1,2) K:X'=Z X Q
FILE ;ADD ENTRY TO REQUSITIONER TABLE FILE
S ASUL(20,"REQ","ULV")=$S($E(DA,1,2)=59:2.0,1:1.5)
W !?10,"Adding entry in Requsitioner Table (20)"
W !?10," NAME: ",ASUL(20,"REQ","NM")
W !?10," AREA: ",ASUL(1,"AR","AP")
W !?10," USER LEVEL: ",ASUL(20,"REQ","ULV")
S ^ASUL(20,ASUL(20,"REQ","E#"),0)=ASUL(20,"REQ","NM")_U_ASUL(19,"USR","E#")_U_ASUL(18,"SST","E#")_U_ASUL(1,"AR","AP")
S ^ASUL(20,ASUL(20,"REQ","E#"),1)=ASUL(20,"REQ","ULV")
S $P(^ASUL(20,0),U,4)=$P(^ASUL(20,0),U,4)+1
S $P(^ASUL(20,0),U,3)=ASUL(19,"USR","E#")
S DIK="^ASUL(20,",DA=ASUL(20,"REQ","E#") D IX^DIK K X
ERR ;ERROR OR NEW ENTRY MADE
K X,DUOUT,DTOUT,ASUL(18),ASUL(19),ASUL(20),ASUL(22),ASUL("REQ")
Q
HELP ;
W !?5,"You may only access Requsitioner table entries for the Area you are signed"
W !?5,"in to SAMS with. This is determined using the setting of DUZ(2)"
W !?5,"which is set when you sign in to SAMS. If you wish to change Areas,"
W !?5,"you must sign out of SAMS and then sign back in to SAMS selecting the"
W !?5,"appropriate DIVISION (area). If when you sign in to SAMS you are not"
W !?5,"prompted for a DIVISION, then you are automatically signed on as a"
W !?5,"specific Area and are restricted to that Area."
W !!?5,"You will be asked for the Requsitioner (User) Code for the entry you wish"
W !?5,"to Access. If an entry for that User does not exist, you will be asked"
W !?5,"for all necessary data to enter a new User in the ASUTBL USER table file."
W !?5,"For the user you select, you will be asked for the Sub Station where the"
W !?5,"user is located. If an entry for that Sub Station does not exist, you will"
W !?5,"be asked for all data to enter a new Sub Station in the ASUTBL SUB STATION"
W !?5,"table file. Once an entry has been made to the Requsitioner table, only"
W !?5,"the USER LEVEL field may be changed. To change any other field, you must"
W !?5,"delete the entry and re-enter it with the changes. Deletions however,"
W !?5,"may only be done by those with specific access keys."
Q
EN2 ;EP;;FOR ASUL20EN
I $D(ASUL(19)) G SST
I $D(ASUL(18)) K X
G EN1
ASUL20IT ; IHS/ITSC/LMH -IN TRANSFORM REQUSITIONER TABLE 20 ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine is the File Man Input transform for SAMS table 20 -
+3 ;Requsitioner table
+4 IF '$DATA(DUZ(2))
KILL X
WRITE !?10,"DUZ(2) must be set so Area Accounting Point can be determined"
QUIT
+5 IF '$DATA(ASUL(1,"AR","AP"))
DO SETAREA^ASULARST
+6 IF $DATA(DIC(0))
Begin DoDot:1
+7 SET DIC(0)=$TRANSLATE(DIC(0),"Q")
+8 IF DIC(0)'["N"
SET DIC(0)="N"_DIC(0)
+9 IF DIC(0)'["A"
SET DIC(0)="A"_DIC(0)
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 SET DIC(0)="NAE"
End DoDot:1
+12 NEW DIK,DIR,DR,DIC,DIE
+13 SET (DIC,DIE)=9002039.2
EN1 ;X ALREADY SET BY EN2
+1 SET X=$GET(X)
SET ASUL("REQ")=1
+2 IF X']""
DO ASUL19RC^ASUL19IT
IF $DATA(DIRUT)
GOTO ERR
IF Y>0
GOTO SST
+3 IF $DATA(DA)
Begin DoDot:1
+4 IF DA?9N
IF $DATA(^ASUL(20,+DA,0))
Begin DoDot:2
+5 IF $EXTRACT(DA,1,2)=ASUL(1,"AR","AP")
SET ASUL("REQ")=2
End DoDot:2
IF ASUL("REQ")=2
QUIT
+6 IF $DATA(^ASUL(19,+DA,0))
IF DA?6N
Begin DoDot:2
+7 IF $EXTRACT(DA,1,2)=ASUL(1,"AR","AP")
DO USR^ASULDIRR(.DA)
End DoDot:2
IF Y>0
KILL DA
End DoDot:1
IF ASUL("REQ")=2
GOTO REQ
IF $DATA(ASUL(19,"USR","E#"))
GOTO SST
+8 IF '$TEST
Begin DoDot:1
+9 SET DA=X
End DoDot:1
+10 IF DA]""
KILL Y
Begin DoDot:1
+11 IF DA?6N
IF $DATA(^ASUL(19,+DA,0))
Begin DoDot:2
+12 IF $EXTRACT(DA,1,2)'=ASUL(1,"AR","AP")
QUIT
+13 IF $GET(ASUL(19,"USR","E#"))'=DA
DO USR^ASULDIRR(.DA)
IF Y<-1
QUIT
IF Y>0
QUIT
+14 IF Y=-1
DO USR^ASULDIRA(.DA)
IF Y<0
QUIT
End DoDot:2
IF $GET(Y)>0
QUIT
+15 IF '$TEST
Begin DoDot:2
+16 IF DA?1AN.ANP
SET Y=$ORDER(^ASUL(19,"B",DA,""))
IF Y]""
SET DA=Y
DO USR^ASULDIRR(.DA)
QUIT
End DoDot:2
End DoDot:1
IF $GET(Y)>0
GOTO SST
+17 IF '$TEST
Begin DoDot:1
+18 DO DIC^ASUL19IT
End DoDot:1
+19 IF $DATA(DIRUT)
GOTO ERR
+20 IF $DATA(ASUL(19))
GOTO SST
+21 WRITE !?5,"No valid Requsitioner, User, or Sub Station entered"
+22 GOTO ERR
SST ;
+1 IF $DATA(ASUL(18))
GOTO REQ
+2 DO ASUL18RC^ASUL18IT
+3 IF $DATA(DIRUT)
GOTO ERR
+4 IF $DATA(ASUL(18))
GOTO REQ
+5 IF Y>0
SET DA=Y
DO SST^ASULDIRR(.DA)
+6 IF $DATA(ASUL(18))
GOTO REQ
+7 DO DIC^ASUL18IT
+8 IF '$DATA(ASUL(18,"SST","E#"))
WRITE !?5,"Valid Sub Station not entered"
GOTO ERR
REQ ;
+1 IF '$DATA(DA)
IF $DATA(ASUL(18,"SST","E#"))
IF $DATA(ASUL(19,"USR","E#"))
SET DA=ASUL(18,"SST","E#")_$EXTRACT(ASUL(19,"USR","E#"),3,6)
+2 IF DA?9N
Begin DoDot:1
+3 IF '$DATA(ASUL(18,"SST","E#"))
SET ASUL(18,"SST","E#")=$EXTRACT(DA,1,5)
DO SST^ASULDIRR(ASUL(18,"SST","E#"))
+4 IF '$DATA(ASUL(19,"USR","E#"))
SET ASUL(19,"USR","E#")=$EXTRACT(DA,1,2)_$EXTRACT(DA,6,9)
DO USR^ASULDIRR(ASUL(19,"USR","E#"))
+5 DO REQ^ASULDIRR(.DA)
End DoDot:1
IF Y>0
GOTO EXIT
+6 IF $DATA(ASUL(18,"SST","E#"))
Begin DoDot:1
+7 IF $DATA(ASUL(19,"USR","E#"))
Begin DoDot:2
+8 SET (DA,ASUL(20,"REQ","E#"))=ASUL(18,"SST","E#")_$EXTRACT(ASUL(19,"USR","E#"),3,6)
+9 DO REQ^ASULDIRR(.DA)
+10 IF Y<0
DO FILE
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 WRITE !?5,"Valid User not entered"
DO ERR
End DoDot:2
End DoDot:1
+13 IF '$TEST
Begin DoDot:1
+14 WRITE !?5,"Valid Sub Station not entered"
DO ERR
End DoDot:1
+15 IF '$DATA(X)
GOTO ERR
EXIT ;
+1 SET (DA,D0)=ASUL(20,"REQ","E#")
SET X=ASUL(20,"REQ","NM")
+2 KILL ASUL(18),ASUL(19),ASUL(20),ASUL(22),ASUL("REQ")
+3 QUIT
ARIT ;EP;;AREA POINTER INPUT TRANSFORM FOR FILEMAN
+1 NEW Z
SET Z=$EXTRACT(DA,1,2)
IF X'=Z
KILL X
QUIT
FILE ;ADD ENTRY TO REQUSITIONER TABLE FILE
+1 SET ASUL(20,"REQ","ULV")=$SELECT($EXTRACT(DA,1,2)=59:2.0,1:1.5)
+2 WRITE !?10,"Adding entry in Requsitioner Table (20)"
+3 WRITE !?10," NAME: ",ASUL(20,"REQ","NM")
+4 WRITE !?10," AREA: ",ASUL(1,"AR","AP")
+5 WRITE !?10," USER LEVEL: ",ASUL(20,"REQ","ULV")
+6 SET ^ASUL(20,ASUL(20,"REQ","E#"),0)=ASUL(20,"REQ","NM")_U_ASUL(19,"USR","E#")_U_ASUL(18,"SST","E#")_U_ASUL(1,"AR","AP")
+7 SET ^ASUL(20,ASUL(20,"REQ","E#"),1)=ASUL(20,"REQ","ULV")
+8 SET $PIECE(^ASUL(20,0),U,4)=$PIECE(^ASUL(20,0),U,4)+1
+9 SET $PIECE(^ASUL(20,0),U,3)=ASUL(19,"USR","E#")
+10 SET DIK="^ASUL(20,"
SET DA=ASUL(20,"REQ","E#")
DO IX^DIK
KILL X
ERR ;ERROR OR NEW ENTRY MADE
+1 KILL X,DUOUT,DTOUT,ASUL(18),ASUL(19),ASUL(20),ASUL(22),ASUL("REQ")
+2 QUIT
HELP ;
+1 WRITE !?5,"You may only access Requsitioner table entries for the Area you are signed"
+2 WRITE !?5,"in to SAMS with. This is determined using the setting of DUZ(2)"
+3 WRITE !?5,"which is set when you sign in to SAMS. If you wish to change Areas,"
+4 WRITE !?5,"you must sign out of SAMS and then sign back in to SAMS selecting the"
+5 WRITE !?5,"appropriate DIVISION (area). If when you sign in to SAMS you are not"
+6 WRITE !?5,"prompted for a DIVISION, then you are automatically signed on as a"
+7 WRITE !?5,"specific Area and are restricted to that Area."
+8 WRITE !!?5,"You will be asked for the Requsitioner (User) Code for the entry you wish"
+9 WRITE !?5,"to Access. If an entry for that User does not exist, you will be asked"
+10 WRITE !?5,"for all necessary data to enter a new User in the ASUTBL USER table file."
+11 WRITE !?5,"For the user you select, you will be asked for the Sub Station where the"
+12 WRITE !?5,"user is located. If an entry for that Sub Station does not exist, you will"
+13 WRITE !?5,"be asked for all data to enter a new Sub Station in the ASUTBL SUB STATION"
+14 WRITE !?5,"table file. Once an entry has been made to the Requsitioner table, only"
+15 WRITE !?5,"the USER LEVEL field may be changed. To change any other field, you must"
+16 WRITE !?5,"delete the entry and re-enter it with the changes. Deletions however,"
+17 WRITE !?5,"may only be done by those with specific access keys."
+18 QUIT
EN2 ;EP;;FOR ASUL20EN
+1 IF $DATA(ASUL(19))
GOTO SST
+2 IF $DATA(ASUL(18))
KILL X
+3 GOTO EN1
