ASUL20EN ; IHS/ITSC/LMH - ADD/EDIT REQUISITIONER TABLE #20 ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;;Y2K/OK AEF/2970717
;
;
ADD ;EP -- ENTRY POINT TO ADD NEW ENTRY
;
N ASUL,ASUL65,ASUOUT
D INIT Q:$G(ASUOUT)
F D A1 Q:$G(ASUOUT) W !
W !
Q:$G(ASUOUT)
G ADD
Q
A1 ;----- ADD NEW ENTRY
;
N ASUAREA,ASUNM,ASUREQ,ASUSST,ASUUSR,DA,DD,DIC,DINUM,DO,X,Y
Q:'$G(ASUL(1,"AR","AP"))
S ASUAREA=$G(ASUL(1,"AR","AP"))
D DIC("^ASUL(18,","AELMQ","Select Sub-Station: ",.Y)
I ($D(DTOUT)!($D(DUOUT))) S ASUOUT=1 Q
I Y'>0 S ASUOUT=1 Q
I $P(Y,U,3) W !,"Sub-station "_+Y_" "_$P(Y,U,2)_" ADDED"
S ASUSST=+Y
D USR G A1:'$G(ASUUSR)
S ASUREQ=ASUSST_$E(ASUUSR,3,6)
S ASUNM=$P(^ASUL(19,ASUUSR,0),U)_" @ "_$P(^ASUL(18,ASUSST,0),U)
W !,"Requisitioner "_ASUREQ_" "_ASUNM
I '$D(^ASUL(20,+ASUREQ)) D Q:$G(ASUOUT)
.K DD,DO
.S DIC="^ASUL(20,",DIC(0)="",(DA,DINUM)=ASUREQ,X=ASUNM
.S DIC("DR")=".02///^S X=ASUUSR;.03///^S X=ASUSST;.04///^S X=ASUAREA"
.D FILE^DICN
.I Y'>0 W *7," ??" S ASUOUT=1 Q
.W " ADDED"
.S ASUREQ=Y
Q:$G(ASUOUT)
D E2(+ASUREQ)
W !
Q
USR ;----- PROMPT FOR USER
;
K ASUL(19)
D A1^ASUL19EN
S ASUUSR=$G(ASUL(19,"USR","E#"))
Q
EDIT ;EP -- ENTRY POINT TO EDIT EXISTING REQUISITIONER ENTRY
;
N ASUL,ASUL65,ASUOUT,ASUREQ
D INIT Q:$G(ASUOUT)
F D E1 Q:$G(ASUOUT)
Q:$G(ASUOUT)
W !
G EDIT
Q
;
E1 ;----- LOOK UP ENTRY
;
N DA,DIC,X,Y
D DIC("^ASUL(20,","AEMQ","Select Requisitioner: ",.Y)
I Y'>0 S ASUOUT=1 Q
S DA=+Y
D E2(DA)
W !
G E1
Q
E2(DA) ;----- EDIT ENTRY
;
N DIE,DR,X,Y
K ASUL(20)
D REQ^ASULDIRR(DA)
S DIE="^ASUL(20,"
S DR="1//1.5;3"
D ^DIE
Q
DIC(F,D,A,Y) ;
;----- LOOK UP FILE ENTRIES
;
; F = file reference
; D = value of DIC(0)
; A = prompt
; Y = entry number returned in Y
;
N DIC
S DIC=F
S DIC(0)=D
S DIC("A")=A
D ^DIC
Q
INIT ;----- SET UP REQUIRED VARIABLES
;
I '$D(DUZ(2)) D
.W !!!?10,"DIVISION NOT SET, PLEASE SEE SITE MANAGER",!! S ASUOUT=1
.S DIR(0)="E" D ^DIR
E D
.I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
.I ASUL(1,"AR","AP")=65 S ASUL65=1
.D AREA
Q
AREA ;----- PROMPT USER FOR AREA
;
Q:'$G(ASUL65)
D FINDAREA^ASULARST
I Y'>0 S ASUOUT=1
Q
ASUL20EN ; IHS/ITSC/LMH - ADD/EDIT REQUISITIONER TABLE #20 ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;;Y2K/OK AEF/2970717
+3 ;
+4 ;
ADD ;EP -- ENTRY POINT TO ADD NEW ENTRY
+1 ;
+2 NEW ASUL,ASUL65,ASUOUT
+3 DO INIT
IF $GET(ASUOUT)
QUIT
+4 FOR
DO A1
IF $GET(ASUOUT)
QUIT
WRITE !
+5 WRITE !
+6 IF $GET(ASUOUT)
QUIT
+7 GOTO ADD
+8 QUIT
A1 ;----- ADD NEW ENTRY
+1 ;
+2 NEW ASUAREA,ASUNM,ASUREQ,ASUSST,ASUUSR,DA,DD,DIC,DINUM,DO,X,Y
+3 IF '$GET(ASUL(1,"AR","AP"))
QUIT
+4 SET ASUAREA=$GET(ASUL(1,"AR","AP"))
+5 DO DIC("^ASUL(18,","AELMQ","Select Sub-Station: ",.Y)
+6 IF ($DATA(DTOUT)!($DATA(DUOUT)))
SET ASUOUT=1
QUIT
+7 IF Y'>0
SET ASUOUT=1
QUIT
+8 IF $PIECE(Y,U,3)
WRITE !,"Sub-station "_+Y_" "_$PIECE(Y,U,2)_" ADDED"
+9 SET ASUSST=+Y
+10 DO USR
IF '$GET(ASUUSR)
GOTO A1
+11 SET ASUREQ=ASUSST_$EXTRACT(ASUUSR,3,6)
+12 SET ASUNM=$PIECE(^ASUL(19,ASUUSR,0),U)_" @ "_$PIECE(^ASUL(18,ASUSST,0),U)
+13 WRITE !,"Requisitioner "_ASUREQ_" "_ASUNM
+14 IF '$DATA(^ASUL(20,+ASUREQ))
Begin DoDot:1
+15 KILL DD,DO
+16 SET DIC="^ASUL(20,"
SET DIC(0)=""
SET (DA,DINUM)=ASUREQ
SET X=ASUNM
+17 SET DIC("DR")=".02///^S X=ASUUSR;.03///^S X=ASUSST;.04///^S X=ASUAREA"
+18 DO FILE^DICN
+19 IF Y'>0
WRITE *7," ??"
SET ASUOUT=1
QUIT
+20 WRITE " ADDED"
+21 SET ASUREQ=Y
End DoDot:1
IF $GET(ASUOUT)
QUIT
+22 IF $GET(ASUOUT)
QUIT
+23 DO E2(+ASUREQ)
+24 WRITE !
+25 QUIT
USR ;----- PROMPT FOR USER
+1 ;
+2 KILL ASUL(19)
+3 DO A1^ASUL19EN
+4 SET ASUUSR=$GET(ASUL(19,"USR","E#"))
+5 QUIT
EDIT ;EP -- ENTRY POINT TO EDIT EXISTING REQUISITIONER ENTRY
+1 ;
+2 NEW ASUL,ASUL65,ASUOUT,ASUREQ
+3 DO INIT
IF $GET(ASUOUT)
QUIT
+4 FOR
DO E1
IF $GET(ASUOUT)
QUIT
+5 IF $GET(ASUOUT)
QUIT
+6 WRITE !
+7 GOTO EDIT
+8 QUIT
+9 ;
E1 ;----- LOOK UP ENTRY
+1 ;
+2 NEW DA,DIC,X,Y
+3 DO DIC("^ASUL(20,","AEMQ","Select Requisitioner: ",.Y)
+4 IF Y'>0
SET ASUOUT=1
QUIT
+5 SET DA=+Y
+6 DO E2(DA)
+7 WRITE !
+8 GOTO E1
+9 QUIT
E2(DA) ;----- EDIT ENTRY
+1 ;
+2 NEW DIE,DR,X,Y
+3 KILL ASUL(20)
+4 DO REQ^ASULDIRR(DA)
+5 SET DIE="^ASUL(20,"
+6 SET DR="1//1.5;3"
+7 DO ^DIE
+8 QUIT
DIC(F,D,A,Y) ;
+1 ;----- LOOK UP FILE ENTRIES
+2 ;
+3 ; F = file reference
+4 ; D = value of DIC(0)
+5 ; A = prompt
+6 ; Y = entry number returned in Y
+7 ;
+8 NEW DIC
+9 SET DIC=F
+10 SET DIC(0)=D
+11 SET DIC("A")=A
+12 DO ^DIC
+13 QUIT
INIT ;----- SET UP REQUIRED VARIABLES
+1 ;
+2 IF '$DATA(DUZ(2))
Begin DoDot:1
+3 WRITE !!!?10,"DIVISION NOT SET, PLEASE SEE SITE MANAGER",!!
SET ASUOUT=1
+4 SET DIR(0)="E"
DO ^DIR
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 IF '$DATA(ASUL(1,"AR","AP"))
DO SETAREA^ASULARST
+7 IF ASUL(1,"AR","AP")=65
SET ASUL65=1
+8 DO AREA
End DoDot:1
+9 QUIT
AREA ;----- PROMPT USER FOR AREA
+1 ;
+2 IF '$GET(ASUL65)
QUIT
+3 DO FINDAREA^ASULARST
+4 IF Y'>0
SET ASUOUT=1
+5 QUIT
