ACRFRR32.m

ACRFRR32 ;IHS/OIRM/DSD/THL,AEF - RECEIVING REPORT/INVOICE AUDIT CONTINUED;  [ 11/01/2001   9:44 AM ]

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

 ;;CONTINUATION OF ACRFRR

DISPLAY ;EP;DISPLAY ALL RECEIPTS FOR SPECIFIED ITEM

 N ACRXX,ACRYY

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

 K ACRRRDA,ACRQUIT,^TMP("ACRRR",$J),ACRSSDAX

 Q

D1 K ^TMP("ACRRR",$J)

 D DHEAD

 K ACRRR

 S ACRSSDAX=ACRSSDA

 S (ACRYY,ACRMAX)=0

 F  S ACRYY=$O(^ACRRR("B",ACRSSDAX,ACRYY)) Q:'ACRYY!$D(ACRQUIT)  D

 .Q:'$D(^ACRRR(ACRYY,0))!'$D(^ACRRR(ACRYY,"DT"))

 .S ACRRR0=^ACRRR(ACRYY,0)

 .S ACRRRDT=^ACRRR(ACRYY,"DT")

 .Q:'$D(^ACRSS(+ACRRR0,0))

 .S ACRMAX=ACRMAX+1

 .S ^TMP("ACRRR",$J,ACRMAX)=ACRYY_"&&"_ACRRRDT

 S (ACRYY,Z,ACRRCDX,ACRACPX,ACRIVDX)=0

 F  S ACRYY=$O(^ACRRR("B",ACRSSDAX,ACRYY)) Q:'ACRYY!$D(ACRQUIT)  D

 .D DISP

 .I $Y+4>IOSL D PAUSE^ACRFWARN,DHEAD:'$D(ACRQUIT)

 I Z>1 D

 .W !?38,"-------"

 .W ?46,"-------"

 .W ?54,"-------"

 .W ?62,"-------"

 .W !?38,$J(ACRRQD,6)

 .W ?46,$J(ACRRCDX,6)

 .W ?54,$J(ACRACPX,6)

 .W ?62,$J(ACRIVDX,6)

 K ACRQUIT,ACROUT

 S:'$D(ACRIV)#2 ACRRR=""

 I Z=0 D  Q

 .W !?10,"No receiving actions on file for this item."

 .D PAUSE^ACRFWARN

 .S ACRQUIT=""

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

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

 W !

 I ACRMAX=1 S Y=1

 E  D DIR^ACRFDIC

 Q:+Y<1

 Q:'$D(^TMP("ACRRR",$J,+Y))

D11 D BYRR1

 I ACRMAX=1 S ACRQUIT=""

 Q

DISP Q:'$D(^ACRRR(ACRYY,0))!'$D(^ACRRR(ACRYY,"DT"))

 S ACRRR0=^ACRRR(ACRYY,0)

 S ACRRRDT=^ACRRR(ACRYY,"DT")

 Q:'$D(^ACRSS(+ACRRR0,0))

 S Z=Z+1

 S ACRSSNO=+^ACRSS(+ACRRR0,0)

 S ^TMP("ACRRR",$J,Z)=ACRYY_"&&"_ACRRRDT

 S ACRRRCD=$P(ACRRRDT,U,2)

 S ACRRACP=$P(ACRRRDT,U,3)

 S ACRRCDX=ACRRCDX+ACRRRCD

 S ACRACPX=ACRACPX+ACRRACP

 S ACRRRUC=$P(^ACRSS(+ACRRR0,"DT"),U,3)

 S ACRIVUC=$P(ACRRRDT,U,5)

 S ACRIVD=$P(ACRRRDT,U,6)

 S ACRIVDX=ACRIVDX+ACRIVD

 S ACRSSDA=+ACRRR0

 Q:'$D(^ACRSS(ACRSSDA,0))

 D SETSS^ACRFSSA

 W !,Z," (",ACRSSNO,")"

 W ?6,$P(ACRSSDSC,U)

 W ?38,$J(ACRRQD,6)

 W ?46,$J(ACRRRCD,6)

 W ?54,$J(ACRRACP,6)

 W ?62,$J(ACRIVD,6)

 W ?70,$J($FN(ACRRRUC,"P",2),10)

 W:$P(ACRRR0,U,7) ?$X+1,"**"

 I ACRIVUC,ACRIVUC'=ACRRRUC D

 .W !?28,"INVOICED UNIT COST:"

 .W ?70,$J($FN(ACRIVUC,"P",2),10)

 Q

BYRR ;EP;

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

 Q

B1 D BYRRDISP

 K ACRQUIT

 S DIR(0)="SO^1:Add Additional Items to this RR;2:Edit an Item"

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

 I $D(ACRIV)#2 D

 .S DIR(0)="SO^1:Invoice Quantities/Costs identical to RR Items;2:Edit an Item"

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

 W !

 D DIR^ACRFDIC

 I $D(ACRQUIT)!$D(ACROUT)!'Y S ACRQUIT="" Q

 I Y=1,'$D(ACRIV)#2 S ACRRRADD="" D ADD1^ACRFRR33 Q

 I Y=1,$D(ACRIV)#2 S ACRRRADD="" D ALL^ACRFIV31 Q

B11 S DIR(0)="LO^1:"_ACRSSNO

 S DIR("A")="Edit which item(s)"

 W !

 I ACRSSNO=1 S Y=1

 E  D DIR^ACRFDIC

 I $D(ACRQUIT)!$D(ACROUT)!'Y K:'$D(ACRIVDX) ACRQUIT Q

 N ACRYY

 S ACRYY=Y

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

 D B111

 N ACRJJ

 S ACRJJ=0

 F  S ACRJJ=$O(ACRYY(ACRJJ)) Q:'ACRJJ  S ACRYY=ACRYY(ACRJJ) D B111

 Q

B111 F ACRI=1:1 S Y=$P(ACRYY,",",ACRI) Q:'Y  D:$D(^TMP("ACRRR",$J,Y)) BYRR1 Q:$D(ACROUT)

 K ACRQUIT

 Q

BYRR1 S ACRRRDA=+^TMP("ACRRR",$J,Y)

 S ACRXX=Y

 S ACRRR0=^ACRRR(ACRRRDA,0)

 S ACRRRDT=^ACRRR(ACRRRDA,"DT")

 S ACRSSDA=+ACRRR0

 S DIE="^ACRRR("

 S DR=$S($D(ACRRR)#2:"[ACR RECEIVING REPORT]",1:"[ACR INVOICE AUDIT]")

 I $D(ACRRR)#2,$P(ACRRR0,U,7) D  Q

 .W *7,*7

 .W !!,"This data has been exported to PHS/FMS.  You must add or edit another"

 .W !,"receiving report for this item to make any further adjustment."

 .D PAUSE^ACRFWARN

 W !

 I $D(ACRIV)#2,$P(ACRRRDT,U,5)="" D ADD^ACRFIV31

 S DA=ACRRRDA

 S DIE="^ACRRR("

 S DR=$S($D(ACRRR)#2:"[ACR RECEIVING REPORT]",1:"[ACR INVOICE AUDIT]")

 D DIE^ACRFDIC

 S ACRUCX=+^ACRRR(ACRRRDA,"DT")

 I $P(ACRRRDT,U,$S($D(ACRRR)#2:3,1:6))'=$P(^ACRRR(ACRRRDA,"DT"),U,$S($D(ACRRR)#2:3,1:6)) D

 .D NOW^%DTC

 .S (X,ACRDATE)=%

 .S DA(1)=ACRRRDA

 .S DIC(0)="L"

 .S DIC="^ACRRR("_ACRRRDA_","_$S($D(ACRRR)#2:11,1:12)_","

 .S DIC("DR")=".02////"_DUZ_";.03////2"

 .S:'$D(@(DIC_"0)")) ^ACRRR(ACRRRDA,"_$S($D(ACRRR)#2:11,1:12)_",0)="^9002193.2"_$S($D(ACRRR)#2:1,1:2)_"101D"

 .D FILE^ACRFDIC

SYNC ;EP;TO SYNCRONIZE WITH SUPPLY/SERVICES FILE

 S (X,ACRRCD,ACRACP,ACRIVD)=0

 F  S X=$O(^ACRRR("B",ACRSSDA,X)) Q:'X  D

 .S ACRRRDT=$G(^ACRRR(X,"DT"))

 .S ACRRCD=ACRRCD+$P(ACRRRDT,U,2)

 .S ACRACP=ACRACP+$P(ACRRRDT,U,3)

 .S ACRIVD=ACRIVD+$P(ACRRRDT,U,6)

 D C1^ACRFRR31:$D(ACRRR)#2

 D C1^ACRFIV31:$D(ACRIV)#2

 D NECOP:'$D(ACRIV)#2

 Q

BYRRDISP ;EP;

 N ACRXX,ACRYY

 W @IOF

 W !,"Receiving Report No. ",ACRRRNO," for PO No. ",ACRDOC

 W !!,"NO."

 D DH1

 K ACRRR

 S (ACRXX,Z)=0

 F  S ACRXX=$O(^ACRRR("AC",ACRDOCDA,ACRRRNO,ACRXX)) Q:'ACRXX!$D(ACRQUIT)  D

 .S (ACRYY,ACRRCDX,ACRACPX,ACRIVDX)=0

 .F  S ACRYY=$O(^ACRRR("AC",ACRDOCDA,ACRRRNO,ACRXX,ACRYY)) Q:'ACRYY!$D(ACRQUIT)!$D(ACROUT)  D

 ..D DISP

 ..I $Y+4>IOSL D PAUSE^ACRFWARN,DHEAD:'$D(ACRQUIT)

 S:'$D(ACRIV)#2 ACRRR=""

 K ACRQUIT,ACROUT

 Q

NECOP ;

 Q:'$G(ACRSSDA)

 N ACROBJDA,ACROBJ

 S ACROBJDA=$P($G(^ACRSS(ACRSSDA,0)),U,4)

 Q:'$D(^AUTTOBJC(+ACROBJDA,0))

 S ACROBJ=$P(^AUTTOBJC(ACROBJDA,0),U)

 Q:$E(ACROBJ,1,2)'=31

 S:'$D(^ACRSS(ACRSSDA,11,0)) ^ACRSS(ACRSSDA,11,0)="^9002193.01101"

 S (DA,DA(1))=ACRSSDA

 S DIE="^ACRSS("

 S DR="[ACR NEW EQUIPMENT]"

 D DDS^ACRFDIC

 Q:'$D(ACRSCREN)

 K ACRSCREN

 D DIE^ACRFDIC

 Q

DHEAD W @IOF

 W !,"Receiving history for Item No. ",ACRSSNO," PO No. ",ACRDOC

 W !!,"NO."

DH1 W ?6,"Description"

 W ?38,"Ordered"

 W ?46,"Recv'd"

 W ?54,"Acceptd"

 W ?62,"Invc'd"

 W ?70,"Unit Cost"

 W !,"----"

 W ?6,"------------------------------"

 W ?38,"-------"

 W ?46,"-------"

 W ?54,"-------"

 W ?62,"-------"

 W ?70,"----------"

 Q

ACRFRR32  ;IHS/OIRM/DSD/THL,AEF - RECEIVING REPORT/INVOICE AUDIT CONTINUED;  [ 11/01/2001   9:44 AM ]

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

 +2       ;;CONTINUATION OF ACRFRR

DISPLAY   ;EP;DISPLAY ALL RECEIPTS FOR SPECIFIED ITEM

 +1        NEW ACRXX,ACRYY

 +2        FOR 

               DO D1

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

                   QUIT 

 +3        KILL ACRRRDA,ACRQUIT,^TMP("ACRRR",$JOB),ACRSSDAX

 +4        QUIT 

D1         KILL ^TMP("ACRRR",$JOB)

 +1        DO DHEAD

 +2        KILL ACRRR

 +3        SET ACRSSDAX=ACRSSDA

 +4        SET (ACRYY,ACRMAX)=0

 +5        FOR 

               SET ACRYY=$ORDER(^ACRRR("B",ACRSSDAX,ACRYY))

               IF 'ACRYY!$DATA(ACRQUIT)

                   QUIT 

               Begin DoDot:1

 +6                IF '$DATA(^ACRRR(ACRYY,0))!'$DATA(^ACRRR(ACRYY,"DT"))

                       QUIT 

 +7                SET ACRRR0=^ACRRR(ACRYY,0)

 +8                SET ACRRRDT=^ACRRR(ACRYY,"DT")

 +9                IF '$DATA(^ACRSS(+ACRRR0,0))

                       QUIT 

 +10               SET ACRMAX=ACRMAX+1

 +11               SET ^TMP("ACRRR",$JOB,ACRMAX)=ACRYY_"&&"_ACRRRDT

               End DoDot:1

 +12       SET (ACRYY,Z,ACRRCDX,ACRACPX,ACRIVDX)=0

 +13       FOR 

               SET ACRYY=$ORDER(^ACRRR("B",ACRSSDAX,ACRYY))

               IF 'ACRYY!$DATA(ACRQUIT)

                   QUIT 

               Begin DoDot:1

 +14               DO DISP

 +15               IF $Y+4>IOSL

                       DO PAUSE^ACRFWARN

                       IF '$DATA(ACRQUIT)

                           DO DHEAD

               End DoDot:1

 +16       IF Z>1

               Begin DoDot:1

 +17               WRITE !?38,"-------"

 +18               WRITE ?46,"-------"

 +19               WRITE ?54,"-------"

 +20               WRITE ?62,"-------"

 +21               WRITE !?38,$JUSTIFY(ACRRQD,6)

 +22               WRITE ?46,$JUSTIFY(ACRRCDX,6)

 +23               WRITE ?54,$JUSTIFY(ACRACPX,6)

 +24               WRITE ?62,$JUSTIFY(ACRIVDX,6)

               End DoDot:1

 +25       KILL ACRQUIT,ACROUT

 +26       IF '$DATA(ACRIV)#2

               SET ACRRR=""

 +27       IF Z=0

               Begin DoDot:1

 +28               WRITE !?10,"No receiving actions on file for this item."

 +29               DO PAUSE^ACRFWARN

 +30               SET ACRQUIT=""

               End DoDot:1

               QUIT 

 +31       SET DIR(0)="NO^1:"_ACRMAX

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

 +33       WRITE !

 +34       IF ACRMAX=1

               SET Y=1

 +35      IF '$TEST

               DO DIR^ACRFDIC

 +36       IF +Y<1

               QUIT 

 +37       IF '$DATA(^TMP("ACRRR",$JOB,+Y))

               QUIT 

D11        DO BYRR1

 +1        IF ACRMAX=1

               SET ACRQUIT=""

 +2        QUIT 

DISP       IF '$DATA(^ACRRR(ACRYY,0))!'$DATA(^ACRRR(ACRYY,"DT"))

               QUIT 

 +1        SET ACRRR0=^ACRRR(ACRYY,0)

 +2        SET ACRRRDT=^ACRRR(ACRYY,"DT")

 +3        IF '$DATA(^ACRSS(+ACRRR0,0))

               QUIT 

 +4        SET Z=Z+1

 +5        SET ACRSSNO=+^ACRSS(+ACRRR0,0)

 +6        SET ^TMP("ACRRR",$JOB,Z)=ACRYY_"&&"_ACRRRDT

 +7        SET ACRRRCD=$PIECE(ACRRRDT,U,2)

 +8        SET ACRRACP=$PIECE(ACRRRDT,U,3)

 +9        SET ACRRCDX=ACRRCDX+ACRRRCD

 +10       SET ACRACPX=ACRACPX+ACRRACP

 +11       SET ACRRRUC=$PIECE(^ACRSS(+ACRRR0,"DT"),U,3)

 +12       SET ACRIVUC=$PIECE(ACRRRDT,U,5)

 +13       SET ACRIVD=$PIECE(ACRRRDT,U,6)

 +14       SET ACRIVDX=ACRIVDX+ACRIVD

 +15       SET ACRSSDA=+ACRRR0

 +16       IF '$DATA(^ACRSS(ACRSSDA,0))

               QUIT 

 +17       DO SETSS^ACRFSSA

 +18       WRITE !,Z," (",ACRSSNO,")"

 +19       WRITE ?6,$PIECE(ACRSSDSC,U)

 +20       WRITE ?38,$JUSTIFY(ACRRQD,6)

 +21       WRITE ?46,$JUSTIFY(ACRRRCD,6)

 +22       WRITE ?54,$JUSTIFY(ACRRACP,6)

 +23       WRITE ?62,$JUSTIFY(ACRIVD,6)

 +24       WRITE ?70,$JUSTIFY($FNUMBER(ACRRRUC,"P",2),10)

 +25       IF $PIECE(ACRRR0,U,7)

               WRITE ?$X+1,"**"

 +26       IF ACRIVUC

               IF ACRIVUC'=ACRRRUC

                   Begin DoDot:1

 +27                   WRITE !?28,"INVOICED UNIT COST:"

 +28                   WRITE ?70,$JUSTIFY($FNUMBER(ACRIVUC,"P",2),10)

                   End DoDot:1

 +29       QUIT 

BYRR      ;EP;

 +1        FOR 

               DO B1

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

                   QUIT 

 +2        QUIT 

B1         DO BYRRDISP

 +1        KILL ACRQUIT

 +2        SET DIR(0)="SO^1:Add Additional Items to this RR;2:Edit an Item"

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

 +4        IF $DATA(ACRIV)#2

               Begin DoDot:1

 +5                SET DIR(0)="SO^1:Invoice Quantities/Costs identical to RR Items;2:Edit an Item"

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

               End DoDot:1

 +7        WRITE !

 +8        DO DIR^ACRFDIC

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

               SET ACRQUIT=""

               QUIT 

 +10       IF Y=1

               IF '$DATA(ACRIV)#2

                   SET ACRRRADD=""

                   DO ADD1^ACRFRR33

                   QUIT 

 +11       IF Y=1

               IF $DATA(ACRIV)#2

                   SET ACRRRADD=""

                   DO ALL^ACRFIV31

                   QUIT 

B11        SET DIR(0)="LO^1:"_ACRSSNO

 +1        SET DIR("A")="Edit which item(s)"

 +2        WRITE !

 +3        IF ACRSSNO=1

               SET Y=1

 +4       IF '$TEST

               DO DIR^ACRFDIC

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

               IF '$DATA(ACRIVDX)

                   KILL ACRQUIT

               QUIT 

 +6        NEW ACRYY

 +7        SET ACRYY=Y

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

               SET %X="Y("

               SET %Y="ACRYY("

               DO %XY^%RCR

 +9        DO B111

 +10       NEW ACRJJ

 +11       SET ACRJJ=0

 +12       FOR 

               SET ACRJJ=$ORDER(ACRYY(ACRJJ))

               IF 'ACRJJ

                   QUIT 

               SET ACRYY=ACRYY(ACRJJ)

               DO B111

 +13       QUIT 

B111       FOR ACRI=1:1

               SET Y=$PIECE(ACRYY,",",ACRI)

               IF 'Y

                   QUIT 

               IF $DATA(^TMP("ACRRR",$JOB,Y))

                   DO BYRR1

               IF $DATA(ACROUT)

                   QUIT 

 +1        KILL ACRQUIT

 +2        QUIT 

BYRR1      SET ACRRRDA=+^TMP("ACRRR",$JOB,Y)

 +1        SET ACRXX=Y

 +2        SET ACRRR0=^ACRRR(ACRRRDA,0)

 +3        SET ACRRRDT=^ACRRR(ACRRRDA,"DT")

 +4        SET ACRSSDA=+ACRRR0

 +5        SET DIE="^ACRRR("

 +6        SET DR=$SELECT($DATA(ACRRR)#2:"[ACR RECEIVING REPORT]",1:"[ACR INVOICE AUDIT]")

 +7        IF $DATA(ACRRR)#2

               IF $PIECE(ACRRR0,U,7)

                   Begin DoDot:1

 +8                    WRITE *7,*7

 +9                    WRITE !!,"This data has been exported to PHS/FMS.  You must add or edit another"

 +10                   WRITE !,"receiving report for this item to make any further adjustment."

 +11                   DO PAUSE^ACRFWARN

                   End DoDot:1

                   QUIT 

 +12       WRITE !

 +13       IF $DATA(ACRIV)#2

               IF $PIECE(ACRRRDT,U,5)=""

                   DO ADD^ACRFIV31

 +14       SET DA=ACRRRDA

 +15       SET DIE="^ACRRR("

 +16       SET DR=$SELECT($DATA(ACRRR)#2:"[ACR RECEIVING REPORT]",1:"[ACR INVOICE AUDIT]")

 +17       DO DIE^ACRFDIC

 +18       SET ACRUCX=+^ACRRR(ACRRRDA,"DT")

 +19       IF $PIECE(ACRRRDT,U,$SELECT($DATA(ACRRR)#2:3,1:6))'=$PIECE(^ACRRR(ACRRRDA,"DT"),U,$SELECT($DATA(ACRRR)#2:3,1:6))

               Begin DoDot:1

 +20               DO NOW^%DTC

 +21               SET (X,ACRDATE)=%

 +22               SET DA(1)=ACRRRDA

 +23               SET DIC(0)="L"

 +24               SET DIC="^ACRRR("_ACRRRDA_","_$SELECT($DATA(ACRRR)#2:11,1:12)_","

 +25               SET DIC("DR")=".02////"_DUZ_";.03////2"

 +26               IF '$DATA(@(DIC_"0)"))

                       SET ^ACRRR(ACRRRDA,"_$S($D(ACRRR)#2:11,1:12)_",0)="^9002193.2"_$SELECT($DATA(ACRRR)#2:1,1:2)_"101D"

 +27               DO FILE^ACRFDIC

               End DoDot:1

SYNC      ;EP;TO SYNCRONIZE WITH SUPPLY/SERVICES FILE

 +1        SET (X,ACRRCD,ACRACP,ACRIVD)=0

 +2        FOR 

               SET X=$ORDER(^ACRRR("B",ACRSSDA,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +3                SET ACRRRDT=$GET(^ACRRR(X,"DT"))

 +4                SET ACRRCD=ACRRCD+$PIECE(ACRRRDT,U,2)

 +5                SET ACRACP=ACRACP+$PIECE(ACRRRDT,U,3)

 +6                SET ACRIVD=ACRIVD+$PIECE(ACRRRDT,U,6)

               End DoDot:1

 +7        IF $DATA(ACRRR)#2

               DO C1^ACRFRR31

 +8        IF $DATA(ACRIV)#2

               DO C1^ACRFIV31

 +9        IF '$DATA(ACRIV)#2

               DO NECOP

 +10       QUIT 

BYRRDISP  ;EP;

 +1        NEW ACRXX,ACRYY

 +2        WRITE @IOF

 +3        WRITE !,"Receiving Report No. ",ACRRRNO," for PO No. ",ACRDOC

 +4        WRITE !!,"NO."

 +5        DO DH1

 +6        KILL ACRRR

 +7        SET (ACRXX,Z)=0

 +8        FOR 

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

               IF 'ACRXX!$DATA(ACRQUIT)

                   QUIT 

               Begin DoDot:1

 +9                SET (ACRYY,ACRRCDX,ACRACPX,ACRIVDX)=0

 +10               FOR 

                       SET ACRYY=$ORDER(^ACRRR("AC",ACRDOCDA,ACRRRNO,ACRXX,ACRYY))

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

                           QUIT 

                       Begin DoDot:2

 +11                       DO DISP

 +12                       IF $Y+4>IOSL

                               DO PAUSE^ACRFWARN

                               IF '$DATA(ACRQUIT)

                                   DO DHEAD

                       End DoDot:2

               End DoDot:1

 +13       IF '$DATA(ACRIV)#2

               SET ACRRR=""

 +14       KILL ACRQUIT,ACROUT

 +15       QUIT 

NECOP     ;

 +1        IF '$GET(ACRSSDA)

               QUIT 

 +2        NEW ACROBJDA,ACROBJ

 +3        SET ACROBJDA=$PIECE($GET(^ACRSS(ACRSSDA,0)),U,4)

 +4        IF '$DATA(^AUTTOBJC(+ACROBJDA,0))

               QUIT 

 +5        SET ACROBJ=$PIECE(^AUTTOBJC(ACROBJDA,0),U)

 +6        IF $EXTRACT(ACROBJ,1,2)'=31

               QUIT 

 +7        IF '$DATA(^ACRSS(ACRSSDA,11,0))

               SET ^ACRSS(ACRSSDA,11,0)="^9002193.01101"

 +8        SET (DA,DA(1))=ACRSSDA

 +9        SET DIE="^ACRSS("

 +10       SET DR="[ACR NEW EQUIPMENT]"

 +11       DO DDS^ACRFDIC

 +12       IF '$DATA(ACRSCREN)

               QUIT 

 +13       KILL ACRSCREN

 +14       DO DIE^ACRFDIC

 +15       QUIT 

DHEAD      WRITE @IOF

 +1        WRITE !,"Receiving history for Item No. ",ACRSSNO," PO No. ",ACRDOC

 +2        WRITE !!,"NO."

DH1        WRITE ?6,"Description"

 +1        WRITE ?38,"Ordered"

 +2        WRITE ?46,"Recv'd"

 +3        WRITE ?54,"Acceptd"

 +4        WRITE ?62,"Invc'd"

 +5        WRITE ?70,"Unit Cost"

 +6        WRITE !,"----"

 +7        WRITE ?6,"------------------------------"

 +8        WRITE ?38,"-------"

 +9        WRITE ?46,"-------"

 +10       WRITE ?54,"-------"

 +11       WRITE ?62,"-------"

 +12       WRITE ?70,"----------"

 +13       QUIT