ASUAPDUP.m

ASUAPDUP ;DSD/DFM - DIRECT ISSUE DUPLICATION;  [ 04/15/98  2:37 PM ]

 ;;3.0;SAMS;**1**;AUG 20, 1993

DUPFLDS ;

 K DIR("B")

 W !,"1. ENTER TRANSACTION CODE: ",ASUTRNS("TRANSACTION CODE")

 D AREA^ASUAUAST

 W !,"3. ENTER STATION CODE: ",ASUTRNS(ASUTRNS,"STATION")

 W !,"4. ENTER PURCHASE ORDER NUMBER: ",ASUTRNS(ASUTRNS,"PURCHASE ORDER #")

 G:ASUTRNS("TRANSACTION CODE")="02" OPTSRC

 G:$E(ASUTRNS("TRANSACTION CODE"),2,2)?1A OPTSRC

 W !,"5. ENTER SOURCE CODE: ",ASUTRNS(ASUTRNS,"SOURCE CODE") G ACCT

OPTSRC ;

 S:ASUTRNS(ASUTRNS,"SOURCE CODE")]"" DIR("B")=ASUTRNS(ASUTRNS,"SOURCE CODE")

 S ASUV("ITEM #")=5 D ^ASUAUSRC Q:$D(DUOUT)!($D(DIROUT))!($D(DTOUT))

ACCT ;

 S:ASUTRNS(ASUTRNS,"ACCOUNT")]"" DIR("B")=ASUTRNS(ASUTRNS,"ACCOUNT")

 S ASUV("ITEM #")=6 D ^ASUAUACC Q:$D(DUOUT)!($D(DIROUT))!($D(DTOUT))

 S:ASUTRNS(ASUTRNS,"SUB OBJECT")]"" DIR("B")=ASUTRNS(ASUTRNS,"SUB OBJECT")

 S ASUV("ITEM #")=7 D ^ASUAUDOJ Q:$D(DUOUT)!($D(DIROUT))!($D(DTOUT))

 S ASUSW("OPTIONAL")="PO"

 S ASUV("ITEM #")=8 D ^ASUAPSST Q:$D(DUOUT)!($D(DIROUT))!($D(DTOUT))

 K ASUSW("OPTIONAL")

 S:ASUTRNS(ASUTRNS,"USER")]"" DIR("B")=ASUTRNS(ASUTRNS,"USER")

 S ASUV("ITEM #")=9 D ^ASUAUUSR Q:$D(DUOUT)!($D(DIROUT))!($D(DTOUT))

 S ASUV("ITEM #")=10 D ^ASUAPCAN Q:$D(DUOUT)!($D(DIROUT))!($D(DTOUT))

 S ASUV("ITEM #")=11 D ^ASUAUSSA Q:$D(DUOUT)!($D(DIROUT))!($D(DTOUT))

 D ^ASUAPNLI Q:$D(DUOUT)!($D(DIROUT))!($D(DTOUT))

 S ASUV("ITEM #")=13,ASUV("LOWEST")=1 D ^ASUAUVAL

 W !,"14. ENTER VOUCHER NUMBER: ",ASUTRNS(ASUTRNS,"VOUCHER #")

EXIT ;RETURN TO CALLING ROUTINE

 K X,Y,ASUV("ITEM #")

 Q

ASUAPDUP  ;DSD/DFM - DIRECT ISSUE DUPLICATION;  [ 04/15/98  2:37 PM ]

 +1       ;;3.0;SAMS;**1**;AUG 20, 1993

DUPFLDS   ;

 +1        KILL DIR("B")

 +2        WRITE !,"1. ENTER TRANSACTION CODE: ",ASUTRNS("TRANSACTION CODE")

 +3        DO AREA^ASUAUAST

 +4        WRITE !,"3. ENTER STATION CODE: ",ASUTRNS(ASUTRNS,"STATION")

 +5        WRITE !,"4. ENTER PURCHASE ORDER NUMBER: ",ASUTRNS(ASUTRNS,"PURCHASE ORDER #")

 +6        IF ASUTRNS("TRANSACTION CODE")="02"

               GOTO OPTSRC

 +7        IF $EXTRACT(ASUTRNS("TRANSACTION CODE"),2,2)?1A

               GOTO OPTSRC

 +8        WRITE !,"5. ENTER SOURCE CODE: ",ASUTRNS(ASUTRNS,"SOURCE CODE")

           GOTO ACCT

OPTSRC    ;

 +1        IF ASUTRNS(ASUTRNS,"SOURCE CODE")]""

               SET DIR("B")=ASUTRNS(ASUTRNS,"SOURCE CODE")

 +2        SET ASUV("ITEM #")=5

           DO ^ASUAUSRC

           IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))

               QUIT 

ACCT      ;

 +1        IF ASUTRNS(ASUTRNS,"ACCOUNT")]""

               SET DIR("B")=ASUTRNS(ASUTRNS,"ACCOUNT")

 +2        SET ASUV("ITEM #")=6

           DO ^ASUAUACC

           IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))

               QUIT 

 +3        IF ASUTRNS(ASUTRNS,"SUB OBJECT")]""

               SET DIR("B")=ASUTRNS(ASUTRNS,"SUB OBJECT")

 +4        SET ASUV("ITEM #")=7

           DO ^ASUAUDOJ

           IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))

               QUIT 

 +5        SET ASUSW("OPTIONAL")="PO"

 +6        SET ASUV("ITEM #")=8

           DO ^ASUAPSST

           IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))

               QUIT 

 +7        KILL ASUSW("OPTIONAL")

 +8        IF ASUTRNS(ASUTRNS,"USER")]""

               SET DIR("B")=ASUTRNS(ASUTRNS,"USER")

 +9        SET ASUV("ITEM #")=9

           DO ^ASUAUUSR

           IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))

               QUIT 

 +10       SET ASUV("ITEM #")=10

           DO ^ASUAPCAN

           IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))

               QUIT 

 +11       SET ASUV("ITEM #")=11

           DO ^ASUAUSSA

           IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))

               QUIT 

 +12       DO ^ASUAPNLI

           IF $DATA(DUOUT)!($DATA(DIROUT))!($DATA(DTOUT))

               QUIT 

 +13       SET ASUV("ITEM #")=13

           SET ASUV("LOWEST")=1

           DO ^ASUAUVAL

 +14       WRITE !,"14. ENTER VOUCHER NUMBER: ",ASUTRNS(ASUTRNS,"VOUCHER #")

EXIT      ;RETURN TO CALLING ROUTINE

 +1        KILL X,Y,ASUV("ITEM #")

 +2        QUIT