ASUAPCAN.m

ASUAPCAN ;DSD/DFM - DIRECT ISSUE COMMON ACCOUNTING NUMBER (CAN);  [ 04/15/98  2:33 PM ]

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

RDCAN ;

 S ASUVX=ASUK("AREA","ACCPT")

 I $E(ASUVX)=5 D

 .I ASUVX=50!(ASUVX=51) S ASUVX=$E(ASUVX)

 S DIR("A")=ASUV("ITEM #")_". ENTER COMMON ACCOUNTING NUMBER : J"_ASUVX

 S X=$S(ASUVX=5:5,1:4)

 S DIR(0)="FA^"_X_":"_X_"^K:X'?"_X_"AN X"

 S DIR("?")="Enter "_X_" alpha-numeric characters" K X

 D ^DIR

 I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) G EXIT

 S ASUTRNS(ASUTRNS,"COMMON ACCOUNT #")="J"_ASUVX_X

EXIT ;RETURN TO CALLING ROUTINE

 K X,Y,DIR,ASUVX

 Q

ASUAPCAN  ;DSD/DFM - DIRECT ISSUE COMMON ACCOUNTING NUMBER (CAN);  [ 04/15/98  2:33 PM ]

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

RDCAN     ;

 +1        SET ASUVX=ASUK("AREA","ACCPT")

 +2        IF $EXTRACT(ASUVX)=5

               Begin DoDot:1

 +3                IF ASUVX=50!(ASUVX=51)

                       SET ASUVX=$EXTRACT(ASUVX)

               End DoDot:1

 +4        SET DIR("A")=ASUV("ITEM #")_". ENTER COMMON ACCOUNTING NUMBER : J"_ASUVX

 +5        SET X=$SELECT(ASUVX=5:5,1:4)

 +6        SET DIR(0)="FA^"_X_":"_X_"^K:X'?"_X_"AN X"

 +7        SET DIR("?")="Enter "_X_" alpha-numeric characters"

           KILL X

 +8        DO ^DIR

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

               GOTO EXIT

 +10       SET ASUTRNS(ASUTRNS,"COMMON ACCOUNT #")="J"_ASUVX_X

EXIT      ;RETURN TO CALLING ROUTINE

 +1        KILL X,Y,DIR,ASUVX

 +2        QUIT