- 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
