ACRFRR3.m

ACRFRR3 ;IHS/OIRM/DSD/THL,AEF - RECEIVING REPORT/INVOICE AUDIT CONT'D;  [ 09/23/2005   9:44 AM ]

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

 ;;CONTINUATION OF ACRFRR

EORA ;EP;EDIT OR ADD RECEIVING REPORT

 I $D(ACRRR)#2,'$D(^ACRAPL("AC",DUZ,7)) D  Q

 .W !!,"You do not have authority to sign as a Receiving Agent."

 .W !,"Contact your ARMS Systems Manager if you should have this authority."

 .D PAUSE^ACRFWARN

 .S ACRQUIT=""

 .K ACRFINAL

 I $D(ACRIV)#2,'$D(^ACRAPL("AC",DUZ,42)) D  Q

 .W !!,"You do not have authority to sign as an Invoice Auditor."

 .W !,"Contact your ARMS Systems Manager if you should have this authority."

 .D PAUSE^ACRFWARN

 .S ACRQUIT=""

 .K ACRFINAL

 S ACRDUZ=$S($D(ACRRR)#2:$P(^ACRDOC(ACRDOCDA,"REQ1"),U,6),1:$P(^ACRDOC(ACRDOCDA,"POIO"),U,8))

 I 'ACRDUZ D  Q

 .W !!,"No ",$S($D(ACRRR)#2:"Receiving Agent",1:"Invoice Auditor")

 .W " is specified for this Purchase Order."

 .W !,"Please contact your ARMS Systems Manager for assistance."

 .D PAUSE^ACRFWARN

 .S ACRQUIT=""

 .K ACRFINAL

 I DUZ'=ACRDUZ,'$D(^ACRAPL("ALT",ACRDUZ,$S($D(ACRRR)#2:7,1:42),DUZ)) D  Q:$D(ACRQUIT)

 .N X,Y

 .S Y=0

 .F  S Y=$O(^ACRSS("J",ACRDOCDA,Y)) Q:'Y!$D(ACRQUIT)  D

 ..S X=$P(^ACRSS(Y,0),U,3)

 ..S X=$P($G(^ACRDOC(X,"REQ1")),U,6)

 ..I X=DUZ!$D(^ACRAPL("ALT",X,$S($D(ACRRR)#2:7,1:42),DUZ)) S ACRQUIT=""

 .I $D(ACRQUIT) K ACRQUIT Q

 .;S ACRDUZ=$P(^VA(200,ACRDUZ,0),U)  ;ACR*2.1*19.02 IM16848

 .S ACRDUZ=$$NAME2^ACRFUTL1(ACRDUZ)  ;ACR*2.1*19.02 IM16848

 .S ACRDUZ=$P($P(ACRDUZ,",",2)," ")_" "_$P(ACRDUZ,",")

 .W !!,"You are not the designated "

 .W $S($D(ACRRR)#2:"Receiving Agent",1:"Invoice Auditor")

 .W " for this Purchase Order,"

 .W !,"nor are you an alternate to the designated "

 .W $S($D(ACRRR)#2:"Receiving Agent",1:"Invoice Auditor")

 .W !!,"Contact ",ACRDUZ," or his/her authorized alternate to complete"

 .W !,"this "

 .W $S($D(ACRRR)#2:"receiving action.",1:"invoice audit.")

 .D PAUSE^ACRFWARN

 .S ACRQUIT=""

 .K ACRFINAL

 K ACRRRADD

 I $D(ACRIV)#2,$P(^ACRDOC(ACRDOCDA,"PO"),U,16)]"" S ACRIVNO=$P(^("PO"),U,16)

 E  I $D(ACRIV)#2,$P(^ACRDOC(ACRDOCDA,"PO"),U,16)="" D

 .S DA=ACRDOCDA

 .S DIE="^ACRDOC("

 .S DR="103200T;103200.1T"

 .W !

 .D DIE^ACRFDIC

 .S ACRIVNO=$P(^ACRDOC(ACRDOCDA,"PO"),U,16)

 I $D(ACRRR)#2 D

 .S DIR(0)="SO^1:Add Receiving Report;2:Cancel an Item"

 .I $D(^ACRRR("C",ACRDOCDA)) D

 ..S DIR(0)=DIR(0)_";3:Edit Receiving Report by Item;4:Edit Receiving Report by Report"

 I $D(ACRIV)#2 D ^ACRFIV Q

 S DIR(0)=DIR(0)_";P:Print Receiving Report"

 S DIR("A")="Which one"

 D DIR^ACRFDIC

 S ACRFINAL=0

 Q:(1234'[Y&(Y'="P"))!$D(ACRQUIT)!$D(ACROUT)

 I Y,$D(ACRIV)#2 S Y=Y+2

 I Y=1 S ACRRRADD="" D ADD^ACRFRR33 S Y=1

 I Y=2 D CANCEL^ACRFRR2 S Y=1

 I Y=3 D ITEM K ACRQUIT S Y=1

 I Y=4 D SELECT S Y=1

 I Y="P" D P11^ACRFPO1 K ACRQUIT

 S ACRFINAL=0

 Q

SELECT ;EP;SELECT RECEIVING REPORT TO EDIT

 F  D S1 Q:$D(ACRQUIT)!$D(ACROUT)

 K ACRQUIT

 Q

S1 ;EP;

 S (X,Z)=0

 F  S X=$O(^ACRRR("AC",ACRDOCDA,X)) Q:'X  S Z=Z+1

 I Z=0 D  Q

 .W !!,"No Receiving Reports on file for this document."

 .D PAUSE^ACRFWARN

 I Z=1 D  Q

 .S (ACRRRNO,Y)=1

 .D S2

 .S ACRQUIT=""

 S DIR(0)="NO^1:"_Z

 S DIR("A")="Which Receiving Report"

 W !

 D DIR^ACRFDIC

 Q:$D(ACRQUIT)!$D(ACROUT)!'Y

 S ACRRRNO=Y

S2 D BYRR^ACRFRR32

 Q

ITEM ;EP;TO AUDIT BY ITEM

 F  D I1 Q:$D(ACRQUIT)!$D(ACROUT)

 Q

I1 I ACRSSMAX=1 S ACRXX=+ACRSS0 G ITEM1

 S DIR(0)="LO^1:"_ACRSSMAX

 S DIR("A")="Which item(s)"

 W !

 D DIR^ACRFDIC

 Q:'+Y!$D(ACRQUIT)!$D(ACROUT)

 S ACRXX=Y

 I $G(Y(1))]"" S %X="Y(",%Y="ACRXX(" D %XY^%RCR

 D ITEM1

 N ACRJJ

 S ACRJJ=0

 F  S ACRJJ=$O(ACRXX(ACRJJ)) Q:'ACRJJ  S ACRXX=ACRXX(ACRJJ) D ITEM1

 Q

ITEM1 F ACRK=1:1 S ACRSSNO=$P(ACRXX,",",ACRK) Q:'ACRSSNO  S ACRSSDA=+$G(ACRSS(ACRSSNO)) D:ACRSSDA DISPLAY^ACRFRR32

 S ACRQUIT=""

 Q

IADD ;EP;

 Q:'$G(ACRRRNO)

 I '$D(^ACRDOC(ACRDOCDA,20,"B",ACRRRNO)) D

 .S:'$D(^ACRDOC(ACRDOCDA,20,0)) ^(0)="^9002196.2001"

 .S DA(1)=ACRDOCDA

 .S DINUM=ACRRRNO

 .S X=$S($D(ACRIVNO):ACRIVNO,1:$P(^ACRDOC(ACRDOCDA,"PO"),U,16))

 .Q:X=""

 .S DIC="^ACRDOC("_DA(1)_",20,"

 .S DIC(0)="L"

 .S DIC("DR")=".02////"_$P($G(^ACRDOC(ACRDOCDA,"PO")),U,21)_";.03////"_$P($G(^ACRDOC(ACRDOCDA,5)),U,6)

 .D FILE^ACRFDIC

 Q

ACRFRR3   ;IHS/OIRM/DSD/THL,AEF - RECEIVING REPORT/INVOICE AUDIT CONT'D;  [ 09/23/2005   9:44 AM ]

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

 +2       ;;CONTINUATION OF ACRFRR

EORA      ;EP;EDIT OR ADD RECEIVING REPORT

 +1        IF $DATA(ACRRR)#2

               IF '$DATA(^ACRAPL("AC",DUZ,7))

                   Begin DoDot:1

 +2                    WRITE !!,"You do not have authority to sign as a Receiving Agent."

 +3                    WRITE !,"Contact your ARMS Systems Manager if you should have this authority."

 +4                    DO PAUSE^ACRFWARN

 +5                    SET ACRQUIT=""

 +6                    KILL ACRFINAL

                   End DoDot:1

                   QUIT 

 +7        IF $DATA(ACRIV)#2

               IF '$DATA(^ACRAPL("AC",DUZ,42))

                   Begin DoDot:1

 +8                    WRITE !!,"You do not have authority to sign as an Invoice Auditor."

 +9                    WRITE !,"Contact your ARMS Systems Manager if you should have this authority."

 +10                   DO PAUSE^ACRFWARN

 +11                   SET ACRQUIT=""

 +12                   KILL ACRFINAL

                   End DoDot:1

                   QUIT 

 +13       SET ACRDUZ=$SELECT($DATA(ACRRR)#2:$PIECE(^ACRDOC(ACRDOCDA,"REQ1"),U,6),1:$PIECE(^ACRDOC(ACRDOCDA,"POIO"),U,8))

 +14       IF 'ACRDUZ

               Begin DoDot:1

 +15               WRITE !!,"No ",$SELECT($DATA(ACRRR)#2:"Receiving Agent",1:"Invoice Auditor")

 +16               WRITE " is specified for this Purchase Order."

 +17               WRITE !,"Please contact your ARMS Systems Manager for assistance."

 +18               DO PAUSE^ACRFWARN

 +19               SET ACRQUIT=""

 +20               KILL ACRFINAL

               End DoDot:1

               QUIT 

 +21       IF DUZ'=ACRDUZ

               IF '$DATA(^ACRAPL("ALT",ACRDUZ,$SELECT($DATA(ACRRR)#2:7,1:42),DUZ))

                   Begin DoDot:1

 +22                   NEW X,Y

 +23                   SET Y=0

 +24                   FOR 

                           SET Y=$ORDER(^ACRSS("J",ACRDOCDA,Y))

                           IF 'Y!$DATA(ACRQUIT)

                               QUIT 

                           Begin DoDot:2

 +25                           SET X=$PIECE(^ACRSS(Y,0),U,3)

 +26                           SET X=$PIECE($GET(^ACRDOC(X,"REQ1")),U,6)

 +27                           IF X=DUZ!$DATA(^ACRAPL("ALT",X,$SELECT($DATA(ACRRR)#2:7,1:42),DUZ))

                                   SET ACRQUIT=""

                           End DoDot:2

 +28                   IF $DATA(ACRQUIT)

                           KILL ACRQUIT

                           QUIT 

 +29      ;S ACRDUZ=$P(^VA(200,ACRDUZ,0),U)  ;ACR*2.1*19.02 IM16848

 +30      ;ACR*2.1*19.02 IM16848

                       SET ACRDUZ=$$NAME2^ACRFUTL1(ACRDUZ)

 +31                   SET ACRDUZ=$PIECE($PIECE(ACRDUZ,",",2)," ")_" "_$PIECE(ACRDUZ,",")

 +32                   WRITE !!,"You are not the designated "

 +33                   WRITE $SELECT($DATA(ACRRR)#2:"Receiving Agent",1:"Invoice Auditor")

 +34                   WRITE " for this Purchase Order,"

 +35                   WRITE !,"nor are you an alternate to the designated "

 +36                   WRITE $SELECT($DATA(ACRRR)#2:"Receiving Agent",1:"Invoice Auditor")

 +37                   WRITE !!,"Contact ",ACRDUZ," or his/her authorized alternate to complete"

 +38                   WRITE !,"this "

 +39                   WRITE $SELECT($DATA(ACRRR)#2:"receiving action.",1:"invoice audit.")

 +40                   DO PAUSE^ACRFWARN

 +41                   SET ACRQUIT=""

 +42                   KILL ACRFINAL

                   End DoDot:1

                   IF $DATA(ACRQUIT)

                       QUIT 

 +43       KILL ACRRRADD

 +44       IF $DATA(ACRIV)#2

               IF $PIECE(^ACRDOC(ACRDOCDA,"PO"),U,16)]""

                   SET ACRIVNO=$PIECE(^("PO"),U,16)

 +45      IF '$TEST

               IF $DATA(ACRIV)#2

                   IF $PIECE(^ACRDOC(ACRDOCDA,"PO"),U,16)=""

                       Begin DoDot:1

 +46                       SET DA=ACRDOCDA

 +47                       SET DIE="^ACRDOC("

 +48                       SET DR="103200T;103200.1T"

 +49                       WRITE !

 +50                       DO DIE^ACRFDIC

 +51                       SET ACRIVNO=$PIECE(^ACRDOC(ACRDOCDA,"PO"),U,16)

                       End DoDot:1

 +52       IF $DATA(ACRRR)#2

               Begin DoDot:1

 +53               SET DIR(0)="SO^1:Add Receiving Report;2:Cancel an Item"

 +54               IF $DATA(^ACRRR("C",ACRDOCDA))

                       Begin DoDot:2

 +55                       SET DIR(0)=DIR(0)_";3:Edit Receiving Report by Item;4:Edit Receiving Report by Report"

                       End DoDot:2

               End DoDot:1

 +56       IF $DATA(ACRIV)#2

               DO ^ACRFIV

               QUIT 

 +57       SET DIR(0)=DIR(0)_";P:Print Receiving Report"

 +58       SET DIR("A")="Which one"

 +59       DO DIR^ACRFDIC

 +60       SET ACRFINAL=0

 +61       IF (1234'[Y&(Y'="P"))!$DATA(ACRQUIT)!$DATA(ACROUT)

               QUIT 

 +62       IF Y

               IF $DATA(ACRIV)#2

                   SET Y=Y+2

 +63       IF Y=1

               SET ACRRRADD=""

               DO ADD^ACRFRR33

               SET Y=1

 +64       IF Y=2

               DO CANCEL^ACRFRR2

               SET Y=1

 +65       IF Y=3

               DO ITEM

               KILL ACRQUIT

               SET Y=1

 +66       IF Y=4

               DO SELECT

               SET Y=1

 +67       IF Y="P"

               DO P11^ACRFPO1

               KILL ACRQUIT

 +68       SET ACRFINAL=0

 +69       QUIT 

SELECT    ;EP;SELECT RECEIVING REPORT TO EDIT

 +1        FOR 

               DO S1

               IF $DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT 

 +2        KILL ACRQUIT

 +3        QUIT 

S1        ;EP;

 +1        SET (X,Z)=0

 +2        FOR 

               SET X=$ORDER(^ACRRR("AC",ACRDOCDA,X))

               IF 'X

                   QUIT 

               SET Z=Z+1

 +3        IF Z=0

               Begin DoDot:1

 +4                WRITE !!,"No Receiving Reports on file for this document."

 +5                DO PAUSE^ACRFWARN

               End DoDot:1

               QUIT 

 +6        IF Z=1

               Begin DoDot:1

 +7                SET (ACRRRNO,Y)=1

 +8                DO S2

 +9                SET ACRQUIT=""

               End DoDot:1

               QUIT 

 +10       SET DIR(0)="NO^1:"_Z

 +11       SET DIR("A")="Which Receiving Report"

 +12       WRITE !

 +13       DO DIR^ACRFDIC

 +14       IF $DATA(ACRQUIT)!$DATA(ACROUT)!'Y

               QUIT 

 +15       SET ACRRRNO=Y

S2         DO BYRR^ACRFRR32

 +1        QUIT 

ITEM      ;EP;TO AUDIT BY ITEM

 +1        FOR 

               DO I1

               IF $DATA(ACRQUIT)!$DATA(ACROUT)

                   QUIT 

 +2        QUIT 

I1         IF ACRSSMAX=1

               SET ACRXX=+ACRSS0

               GOTO ITEM1

 +1        SET DIR(0)="LO^1:"_ACRSSMAX

 +2        SET DIR("A")="Which item(s)"

 +3        WRITE !

 +4        DO DIR^ACRFDIC

 +5        IF '+Y!$DATA(ACRQUIT)!$DATA(ACROUT)

               QUIT 

 +6        SET ACRXX=Y

 +7        IF $GET(Y(1))]""

               SET %X="Y("

               SET %Y="ACRXX("

               DO %XY^%RCR

 +8        DO ITEM1

 +9        NEW ACRJJ

 +10       SET ACRJJ=0

 +11       FOR 

               SET ACRJJ=$ORDER(ACRXX(ACRJJ))

               IF 'ACRJJ

                   QUIT 

               SET ACRXX=ACRXX(ACRJJ)

               DO ITEM1

 +12       QUIT 

ITEM1      FOR ACRK=1:1

               SET ACRSSNO=$PIECE(ACRXX,",",ACRK)

               IF 'ACRSSNO

                   QUIT 

               SET ACRSSDA=+$GET(ACRSS(ACRSSNO))

               IF ACRSSDA

                   DO DISPLAY^ACRFRR32

 +1        SET ACRQUIT=""

 +2        QUIT 

IADD      ;EP;

 +1        IF '$GET(ACRRRNO)

               QUIT 

 +2        IF '$DATA(^ACRDOC(ACRDOCDA,20,"B",ACRRRNO))

               Begin DoDot:1

 +3                IF '$DATA(^ACRDOC(ACRDOCDA,20,0))

                       SET ^(0)="^9002196.2001"

 +4                SET DA(1)=ACRDOCDA

 +5                SET DINUM=ACRRRNO

 +6                SET X=$SELECT($DATA(ACRIVNO):ACRIVNO,1:$PIECE(^ACRDOC(ACRDOCDA,"PO"),U,16))

 +7                IF X=""

                       QUIT 

 +8                SET DIC="^ACRDOC("_DA(1)_",20,"

 +9                SET DIC(0)="L"

 +10               SET DIC("DR")=".02////"_$PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,21)_";.03////"_$PIECE($GET(^ACRDOC(ACRDOCDA,5)),U,6)

 +11               DO FILE^ACRFDIC

               End DoDot:1

 +12       QUIT