- 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
