- 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
