ACRFSTK1.m

ACRFSTK1 ;IHS/OIRM/DSD/THL,AEF - ACRFSTOK - CON'T; [ 11/01/2001   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 ;;CONTINUATION OF ACRFSTOK

ITEMSS ;EP;

 S DIR(0)="YO"

 S DIR("A")="STORES STOCK ITEM...: "

 S DIR("B")="NO"

 W !

 D DIR^ACRFDIC

 S ACRSTOCK=Y

 Q

DISP ;EP;TO DISPLAY STANDARD ITEM INFORMATION

 W @IOF

 W !?15,@ACRON,"ITEM INFORMATION",@ACROF

 S D0=ACRD0

 N DXS,DIP,DC,DN

 I $P(^ACRITEM(D0,0),U)'="XXXXXX" D ^ACRPSTM I 1 Q

 E  D ^ACRPITM

 Q

NEW ;EP;CREATE NEW STANDARD ITEM ENTRY

 S ACRSSITM=""

 S X="XXXXXX"

 S DIC="^ACRITEM("

 S DIC(0)="L"

 S DIC("DR")=DIC("DR")_";26////1"

 D FILE^ACRFDIC

NEW1 S ACRDA=Y

 S DA=+Y

 S DIE="^ACRITEM("

 S DR="15////"_+Y

 D DIE^ACRFDIC

 S DA=+ACRDA

 S DIE="^ACRITEM("

 S DR="[ACR ADD DIRECT ISSUE]"

 D DIE^ACRFDIC

 S ACR(1)=+ACRDA

 K ACRADD

 Q

DELETE ;EP;TO DELETE A SECONDARY OR TERTIARY VENDOR

 S DIR(0)="YO"

 S DIR("A")="Remove this vendor"

 S DIR("B")="NO"

 W !

 D DIR^ACRFDIC

 Q:Y'=1

 S DA=+ACRDEL

 S DIK="^ACRITEM("

 D ^DIK

 W !!,$P(ACR($P(ACRDEL,U,2)),U,3)," removed as a ",$S($P(ACRDEL,U,2)=2:"SECONDARY",1:"TERTIARY")," vendor for this item."

 H 2

 K ACR($P(ACRDEL,U,2))

 I $P(ACRDEL,U,2)=2,$D(ACR(3)) D

 .S DA=+ACR(3)

 .S DIE="^ACRITEM("

 .S DR=".03////2;26////2"

 .D DIE^ACRFDIC

 .S ACR(2)=ACR(3)

 .K ACR(3)

 S ACRQUIT=""

 Q

ACRFSTK1  ;IHS/OIRM/DSD/THL,AEF - ACRFSTOK - CON'T; [ 11/01/2001   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 +2       ;;CONTINUATION OF ACRFSTOK

ITEMSS    ;EP;

 +1        SET DIR(0)="YO"

 +2        SET DIR("A")="STORES STOCK ITEM...: "

 +3        SET DIR("B")="NO"

 +4        WRITE !

 +5        DO DIR^ACRFDIC

 +6        SET ACRSTOCK=Y

 +7        QUIT 

DISP      ;EP;TO DISPLAY STANDARD ITEM INFORMATION

 +1        WRITE @IOF

 +2        WRITE !?15,@ACRON,"ITEM INFORMATION",@ACROF

 +3        SET D0=ACRD0

 +4        NEW DXS,DIP,DC,DN

 +5        IF $PIECE(^ACRITEM(D0,0),U)'="XXXXXX"

               DO ^ACRPSTM

               IF 1

                   QUIT 

 +6       IF '$TEST

               DO ^ACRPITM

 +7        QUIT 

NEW       ;EP;CREATE NEW STANDARD ITEM ENTRY

 +1        SET ACRSSITM=""

 +2        SET X="XXXXXX"

 +3        SET DIC="^ACRITEM("

 +4        SET DIC(0)="L"

 +5        SET DIC("DR")=DIC("DR")_";26////1"

 +6        DO FILE^ACRFDIC

NEW1       SET ACRDA=Y

 +1        SET DA=+Y

 +2        SET DIE="^ACRITEM("

 +3        SET DR="15////"_+Y

 +4        DO DIE^ACRFDIC

 +5        SET DA=+ACRDA

 +6        SET DIE="^ACRITEM("

 +7        SET DR="[ACR ADD DIRECT ISSUE]"

 +8        DO DIE^ACRFDIC

 +9        SET ACR(1)=+ACRDA

 +10       KILL ACRADD

 +11       QUIT 

DELETE    ;EP;TO DELETE A SECONDARY OR TERTIARY VENDOR

 +1        SET DIR(0)="YO"

 +2        SET DIR("A")="Remove this vendor"

 +3        SET DIR("B")="NO"

 +4        WRITE !

 +5        DO DIR^ACRFDIC

 +6        IF Y'=1

               QUIT 

 +7        SET DA=+ACRDEL

 +8        SET DIK="^ACRITEM("

 +9        DO ^DIK

 +10       WRITE !!,$PIECE(ACR($PIECE(ACRDEL,U,2)),U,3)," removed as a ",$SELECT($PIECE(ACRDEL,U,2)=2:"SECONDARY",1:"TERTIARY")," vendor for this item."

 +11       HANG 2

 +12       KILL ACR($PIECE(ACRDEL,U,2))

 +13       IF $PIECE(ACRDEL,U,2)=2

               IF $DATA(ACR(3))

                   Begin DoDot:1

 +14                   SET DA=+ACR(3)

 +15                   SET DIE="^ACRITEM("

 +16                   SET DR=".03////2;26////2"

 +17                   DO DIE^ACRFDIC

 +18                   SET ACR(2)=ACR(3)

 +19                   KILL ACR(3)

                   End DoDot:1

 +20       SET ACRQUIT=""

 +21       QUIT