- 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
