ACRFPA ;IHS/OIRM/DSD/THL,AEF - PURCHASE OFFICE MANAGEMENT; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE FOR CREATION AND MANAGEMENT OF PURCHASING OFFICES AND
;;EDITING PURCHASING AGENT DATA
PA ;EP;TO ADD PURCHASING AGENT
F D PA1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
PA1 W @IOF
W !?30,"ADD PURCHASING AGENT"
W !?30,"===================="
S DIC="^ACRPA("
S DIC("A")="Select PURCHASING AGENT: "
S DIC(0)="AELMQZ"
W !
D DIC^ACRFDIC
I U[$E(X)!(+Y<1) S ACRQUIT="" Q
S DA=+Y
S DIE="^ACRPA("
S DR="[ACR PURCHASING AGENT]"
D DDS^ACRFDIC
Q:'$D(ACRSCREN)
K ACRSCREN
D DIE^ACRFDIC
Q
PO ;EP;TO ADD PURCHASING OFFICE
F D PO1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
PO1 D OFFICE
Q:$D(ACRQUIT)
S DA=ACRDA
S DIE="^ACRPO("
S DR="[ACR PURCHASING OFFICE]"
D DDS^ACRFDIC
S DA=ACRDA
S DIE="^ACRPO("
S DR="[ACR PO PRINTER CONTROL]"
D DDS^ACRFDIC
Q:'$D(ACRSCREN)
K ACRSCREN
I $P(Y,U,3)'=1 D Q:$D(ACROUT)
.S D0=+Y
.W @IOF
.D ^ACRPPUR
.W !
.S DIR(0)="YO"
.S DIR("A")="Edit this data"
.S DIR("B")="NO"
.D DIR^ACRFDIC
I $G(Y)=1 D
.S DA=ACRDA
.S DIE="^ACRPO("
.S DR="[ACR PURCHASING OFFICE]"
.D DDS^ACRFDIC
.I $D(ACRSCREN) K ACRSCREN D DIE^ACRFDIC
.S DA=ACRDA
.S DIE="^ACRPO("
.S DR="[ACR PO PRINTER CONTROL]"
.D DDS^ACRFDIC
.I $D(ACRSCREN) K ACRSCREN D DIE^ACRFDIC
S X=$G(^AUTTLOC(+^ACRPO(ACRDA,0),0))
W !!?5,"MAILING ADDRESS-STREET.: ",$P(X,U,12)
W !?5,"MAILING ADDRESS-CITY...: ",$P(X,U,13)
W !?5,"MAILING ADDRESS-STATE..: ",$P($G(^DIC(5,+$P(X,U,14),0)),U)
W !?5,"MAILING ADDRESS-ZIPCODE: ",$P(X,U,15)
W !?5,"MAILING ADDRESS-PHONE..: ",$P(X,U,11)
W !
S DIR(0)="YO"
S DIR("A")="Edit LOCATION address"
S DIR("B")="NO"
D DIR^ACRFDIC
Q:$G(Y)'=1
S DA=+^ACRPO(ACRDA,0)
S DIE="^AUTTLOC("
S DR=".14MAILING ADDRESS-STREET.;.15MAILING ADDRESS-CITY...;.16MAILING ADDRESS-STATE..;.17MAILING ADDRESS-ZIPCODE;.13MAILING ADDRESS-PHONE.."
W !
D DIE^ACRFDIC
Q
OFFICE ;EP;TO SELECT PURCHASING OFFICE
W @IOF
W !?26,"PURCHASING OFFICE"
W !?26,"====================="
S DIC="^ACRPO("
S DIC(0)="AELMQZ"
S DIC("A")="Select PURCHASING OFFICE: "
W !
D DIC^ACRFDIC
I U[$E(X)!(+Y<1)!'$D(^ACRPO(+Y,0)) S ACRQUIT="" Q
S ACRDA=+Y
Q
ACRFPA ;IHS/OIRM/DSD/THL,AEF - PURCHASE OFFICE MANAGEMENT; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE FOR CREATION AND MANAGEMENT OF PURCHASING OFFICES AND
+3 ;;EDITING PURCHASING AGENT DATA
PA ;EP;TO ADD PURCHASING AGENT
+1 FOR
DO PA1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
PA1 WRITE @IOF
+1 WRITE !?30,"ADD PURCHASING AGENT"
+2 WRITE !?30,"===================="
+3 SET DIC="^ACRPA("
+4 SET DIC("A")="Select PURCHASING AGENT: "
+5 SET DIC(0)="AELMQZ"
+6 WRITE !
+7 DO DIC^ACRFDIC
+8 IF U[$EXTRACT(X)!(+Y<1)
SET ACRQUIT=""
QUIT
+9 SET DA=+Y
+10 SET DIE="^ACRPA("
+11 SET DR="[ACR PURCHASING AGENT]"
+12 DO DDS^ACRFDIC
+13 IF '$DATA(ACRSCREN)
QUIT
+14 KILL ACRSCREN
+15 DO DIE^ACRFDIC
+16 QUIT
PO ;EP;TO ADD PURCHASING OFFICE
+1 FOR
DO PO1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+2 KILL ACRQUIT
+3 QUIT
PO1 DO OFFICE
+1 IF $DATA(ACRQUIT)
QUIT
+2 SET DA=ACRDA
+3 SET DIE="^ACRPO("
+4 SET DR="[ACR PURCHASING OFFICE]"
+5 DO DDS^ACRFDIC
+6 SET DA=ACRDA
+7 SET DIE="^ACRPO("
+8 SET DR="[ACR PO PRINTER CONTROL]"
+9 DO DDS^ACRFDIC
+10 IF '$DATA(ACRSCREN)
QUIT
+11 KILL ACRSCREN
+12 IF $PIECE(Y,U,3)'=1
Begin DoDot:1
+13 SET D0=+Y
+14 WRITE @IOF
+15 DO ^ACRPPUR
+16 WRITE !
+17 SET DIR(0)="YO"
+18 SET DIR("A")="Edit this data"
+19 SET DIR("B")="NO"
+20 DO DIR^ACRFDIC
End DoDot:1
IF $DATA(ACROUT)
QUIT
+21 IF $GET(Y)=1
Begin DoDot:1
+22 SET DA=ACRDA
+23 SET DIE="^ACRPO("
+24 SET DR="[ACR PURCHASING OFFICE]"
+25 DO DDS^ACRFDIC
+26 IF $DATA(ACRSCREN)
KILL ACRSCREN
DO DIE^ACRFDIC
+27 SET DA=ACRDA
+28 SET DIE="^ACRPO("
+29 SET DR="[ACR PO PRINTER CONTROL]"
+30 DO DDS^ACRFDIC
+31 IF $DATA(ACRSCREN)
KILL ACRSCREN
DO DIE^ACRFDIC
End DoDot:1
+32 SET X=$GET(^AUTTLOC(+^ACRPO(ACRDA,0),0))
+33 WRITE !!?5,"MAILING ADDRESS-STREET.: ",$PIECE(X,U,12)
+34 WRITE !?5,"MAILING ADDRESS-CITY...: ",$PIECE(X,U,13)
+35 WRITE !?5,"MAILING ADDRESS-STATE..: ",$PIECE($GET(^DIC(5,+$PIECE(X,U,14),0)),U)
+36 WRITE !?5,"MAILING ADDRESS-ZIPCODE: ",$PIECE(X,U,15)
+37 WRITE !?5,"MAILING ADDRESS-PHONE..: ",$PIECE(X,U,11)
+38 WRITE !
+39 SET DIR(0)="YO"
+40 SET DIR("A")="Edit LOCATION address"
+41 SET DIR("B")="NO"
+42 DO DIR^ACRFDIC
+43 IF $GET(Y)'=1
QUIT
+44 SET DA=+^ACRPO(ACRDA,0)
+45 SET DIE="^AUTTLOC("
+46 SET DR=".14MAILING ADDRESS-STREET.;.15MAILING ADDRESS-CITY...;.16MAILING ADDRESS-STATE..;.17MAILING ADDRESS-ZIPCODE;.13MAILING ADDRESS-PHONE.."
+47 WRITE !
+48 DO DIE^ACRFDIC
+49 QUIT
OFFICE ;EP;TO SELECT PURCHASING OFFICE
+1 WRITE @IOF
+2 WRITE !?26,"PURCHASING OFFICE"
+3 WRITE !?26,"====================="
+4 SET DIC="^ACRPO("
+5 SET DIC(0)="AELMQZ"
+6 SET DIC("A")="Select PURCHASING OFFICE: "
+7 WRITE !
+8 DO DIC^ACRFDIC
+9 IF U[$EXTRACT(X)!(+Y<1)!'$DATA(^ACRPO(+Y,0))
SET ACRQUIT=""
QUIT
+10 SET ACRDA=+Y
+11 QUIT
