ACRFRR31.m

ACRFRR31 ;IHS/OIRM/DSD/THL,AEF - RECEIVING REPORTS CONTINUED; [ 11/01/2001   9:44 AM ]

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

 ;;CONTINUATION OF ACRFRR

RECEIVE ;EP;

 D TOTRCD1

 I ACRRCDX'<ACRRQD D  Q:ACRACPX'<ACRRQD

 .W !!,ACRRQD," of these items ",$S(ACRRQD=1:"was",1:"were")," ordered,"

 .W !,ACRRCDX,$S(ACRRCDX=1:" has",1:" have")," already been received and."

 .W !,ACRACPX,$S(ACRACPX=1:" has",1:" have")," already been accepted."

 .W:ACRACPX'<ACRRQD !,"No further receiving action should be taken for this item."

 .D PAUSE^ACRFWARN

 ;S DIR(0)="FOA^1:10:I X?1N.6N.""."".N"

 S DIR(0)="NOA^0:"_(ACRRQD-ACRACP)_":3"

 S DIR("A")="NUMBER RECEIVED.....: "

 S DIR("?")="Enter the actual number received"

 S DIR("B")=ACRUNRCD

 D DIR^ACRFDIC

 I $D(ACRQUIT)!$D(ACROUT) D INCOMPLT Q

 S ACRRCDX=Y

 S ACRRCD=ACRRCD+Y

 S DIR(0)="FOA^1:10^I X?1N.6N.""."".N"

 S DIR("A")="NUMBER ACCEPTED.....: "

 S DIR("?")="Enter the actual number accepted"

 S DIR("B")=ACRRCDX

 D DIR^ACRFDIC

 I $D(ACRQUIT)!$D(ACROUT) D INCOMPLT Q

 S ACRACPX=Y

 S ACRACP=ACRACP+Y

 D DATE

 D ADD:'$D(ACRQUIT)

 Q

ADD ;EP;ADD RECEIVING REPORT

 ;

 N ACRNOW

 D NOW^%DTC

 S ACRNOW=%

 S X=ACRSSDA

 S DIC="^ACRRR("

 S DIC(0)="L"

 S DIC("DR")=".02////"_ACRSSPO_";.03////"_ACRSSRQ_";.04////"_ACRRRNO_";.05////"_DUZ_";.06////"_ACRNOW_";2////"_ACRRCDX_";3////"_ACRACPX_";4////"_ACRDATE

 D FILE^ACRFDIC

 I Y<1 S ACRQUIT="" Q

 S ACRRRDA=+Y

 S X=ACRNOW

 S DA(1)=ACRRRDA

 S DIC="^ACRRR("_ACRRRDA_",11,"

 S DIC(0)="L"

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

 S:'$D(@(DIC_"0)")) ^ACRRR(ACRRRDA,11,0)="^9002193.2111D"

 D FILE^ACRFDIC

C1 ;EP

 D TOTAL

 S DA=ACRSSDA

 S DIE="^ACRSS("

 S DR=$S($D(ACRRR)#2:"14////"_ACRRCD_";15////"_ACRACP,1:"16////"_(ACRIVD*ACRUC)_";17////"_ACRIVD)

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

 I ACROBJ,$D(^AUTTOBJC(ACROBJ,0)) D

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

 .S:$E(ACROBJ,1,2)=26 DR=DR_";33T"

 D DIE^ACRFDIC

 I ACRACP<ACRRCD D

 .S DA=ACRSSDA

 .S DIE="^ACRSS("

 .S DR="[ACR REJECTION/CANCELLATION]"

 .D DIE^ACRFDIC

 Q

INCOMPLT ;

 W *7,*7

 W !!,"Data entry for ITEM NO. ",ACRJ," not completed, entry not accepted."

 D PAUSE^ACRFWARN

 Q

TOTAL S (X,ACRRCD,ACRACP)=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)

 Q

RRNO ;EP;TO DETERMINE THE NO OF RECEIVING REPORTS ON FILE

 S (X,Z)=0

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

 S ACRRRNO=Z

 Q

TOTCHK ;EP;CALLED BY INPUT TRANSFOR TO ENSURE THAT THE QUANTITY REC'D ON A

 ;RECEIVING ACTION DOES NOT MAKE THE TOTAL QUANTITY REC'D GREATER THAN

 ;TOTAL QUANTITY ORDERED

 D TOTRCD

 S:$D(^ACRRR(DA,"DT")) ACRRCDX=ACRRCDX-$P(^("DT"),U,2)

 I ACRRCDX+X>ACRRQD D

 .W *7,*7

 .W !!,"The quantity received on this receiving action cannot make the total quantity"

 .W !,"received greater than the total quantity ordered (",ACRRQD,")"

 .W !

 .K X

 Q

TOTRCD ;EP;TO CALCULATE THE TOTAL RECEIVED FOR AN ITEM

 S ACRRCDX=0

 I '$D(ACRRRDA),'$D(DA) D TOTRCD1 Q

 I '$D(DA),$D(ACRRRDA) S DA=ACRRRDA

 N ACRRRDA,ACRSSDA

 S ACRRRDA=DA

 Q:'$D(^ACRRR(+DA,0))

 S ACRSSDA=+^ACRRR(DA,0)

TOTRCD1 Q:'$D(^ACRSS(ACRSSDA,"DT"))

 S ACRRQD=+^ACRSS(ACRSSDA,"DT")

 S (ACRRCDX,ACRRRX,ACRACPX)=0

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

 .S ACRRCDX=ACRRCDX+$P($G(^ACRRR(ACRRRX,"DT")),U,2)

 .S ACRACPX=ACRACPX+$P($G(^ACRRR(ACRRRX,"DT")),U,3)

 K ACRRRX

 Q

DATE ;EP;

 S DIR(0)="DA^::EP"

 S DIR("A")="DATE RECEIVED.......: "

 S DIR("?",1)="Enter the date the items were actually received,"

 S DIR("?")="not the date you are doing the Receiving Report."

 I $G(ACRDATE) D

 .S Y=$P(ACRDATE,".")

 .X ^DD("DD")

 .S DIR("B")=Y

 D DIR^ACRFDIC

 I $D(ACRQUIT)!$D(ACROUT),$D(ACRJ),ACRJ D INCOMPLT Q

 S ACRDATE=Y

 Q

ACRFRR31  ;IHS/OIRM/DSD/THL,AEF - RECEIVING REPORTS CONTINUED; [ 11/01/2001   9:44 AM ]

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

 +2       ;;CONTINUATION OF ACRFRR

RECEIVE   ;EP;

 +1        DO TOTRCD1

 +2        IF ACRRCDX'<ACRRQD

               Begin DoDot:1

 +3                WRITE !!,ACRRQD," of these items ",$SELECT(ACRRQD=1:"was",1:"were")," ordered,"

 +4                WRITE !,ACRRCDX,$SELECT(ACRRCDX=1:" has",1:" have")," already been received and."

 +5                WRITE !,ACRACPX,$SELECT(ACRACPX=1:" has",1:" have")," already been accepted."

 +6                IF ACRACPX'<ACRRQD

                       WRITE !,"No further receiving action should be taken for this item."

 +7                DO PAUSE^ACRFWARN

               End DoDot:1

               IF ACRACPX'<ACRRQD

                   QUIT 

 +8       ;S DIR(0)="FOA^1:10:I X?1N.6N.""."".N"

 +9        SET DIR(0)="NOA^0:"_(ACRRQD-ACRACP)_":3"

 +10       SET DIR("A")="NUMBER RECEIVED.....: "

 +11       SET DIR("?")="Enter the actual number received"

 +12       SET DIR("B")=ACRUNRCD

 +13       DO DIR^ACRFDIC

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

               DO INCOMPLT

               QUIT 

 +15       SET ACRRCDX=Y

 +16       SET ACRRCD=ACRRCD+Y

 +17       SET DIR(0)="FOA^1:10^I X?1N.6N.""."".N"

 +18       SET DIR("A")="NUMBER ACCEPTED.....: "

 +19       SET DIR("?")="Enter the actual number accepted"

 +20       SET DIR("B")=ACRRCDX

 +21       DO DIR^ACRFDIC

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

               DO INCOMPLT

               QUIT 

 +23       SET ACRACPX=Y

 +24       SET ACRACP=ACRACP+Y

 +25       DO DATE

 +26       IF '$DATA(ACRQUIT)

               DO ADD

 +27       QUIT 

ADD       ;EP;ADD RECEIVING REPORT

 +1       ;

 +2        NEW ACRNOW

 +3        DO NOW^%DTC

 +4        SET ACRNOW=%

 +5        SET X=ACRSSDA

 +6        SET DIC="^ACRRR("

 +7        SET DIC(0)="L"

 +8        SET DIC("DR")=".02////"_ACRSSPO_";.03////"_ACRSSRQ_";.04////"_ACRRRNO_";.05////"_DUZ_";.06////"_ACRNOW_";2////"_ACRRCDX_";3////"_ACRACPX_";4////"_ACRDATE

 +9        DO FILE^ACRFDIC

 +10       IF Y<1

               SET ACRQUIT=""

               QUIT 

 +11       SET ACRRRDA=+Y

 +12       SET X=ACRNOW

 +13       SET DA(1)=ACRRRDA

 +14       SET DIC="^ACRRR("_ACRRRDA_",11,"

 +15       SET DIC(0)="L"

 +16       SET DIC("DR")=".02////"_DUZ_";.03////1"

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

               SET ^ACRRR(ACRRRDA,11,0)="^9002193.2111D"

 +18       DO FILE^ACRFDIC

C1        ;EP

 +1        DO TOTAL

 +2        SET DA=ACRSSDA

 +3        SET DIE="^ACRSS("

 +4        SET DR=$SELECT($DATA(ACRRR)#2:"14////"_ACRRCD_";15////"_ACRACP,1:"16////"_(ACRIVD*ACRUC)_";17////"_ACRIVD)

 +5        SET ACROBJ=$PIECE(^ACRSS(ACRSSDA,0),U,4)

 +6        IF ACROBJ

               IF $DATA(^AUTTOBJC(ACROBJ,0))

                   Begin DoDot:1

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

 +8                    IF $EXTRACT(ACROBJ,1,2)=26

                           SET DR=DR_";33T"

                   End DoDot:1

 +9        DO DIE^ACRFDIC

 +10       IF ACRACP<ACRRCD

               Begin DoDot:1

 +11               SET DA=ACRSSDA

 +12               SET DIE="^ACRSS("

 +13               SET DR="[ACR REJECTION/CANCELLATION]"

 +14               DO DIE^ACRFDIC

               End DoDot:1

 +15       QUIT 

INCOMPLT  ;

 +1        WRITE *7,*7

 +2        WRITE !!,"Data entry for ITEM NO. ",ACRJ," not completed, entry not accepted."

 +3        DO PAUSE^ACRFWARN

 +4        QUIT 

TOTAL      SET (X,ACRRCD,ACRACP)=0

 +1        FOR 

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

               IF 'X

                   QUIT 

               Begin DoDot:1

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

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

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

               End DoDot:1

 +5        QUIT 

RRNO      ;EP;TO DETERMINE THE NO OF RECEIVING REPORTS ON FILE

 +1        SET (X,Z)=0

 +2        FOR 

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

               IF 'X

                   QUIT 

               SET Z=Z+1

 +3        SET ACRRRNO=Z

 +4        QUIT 

TOTCHK    ;EP;CALLED BY INPUT TRANSFOR TO ENSURE THAT THE QUANTITY REC'D ON A

 +1       ;RECEIVING ACTION DOES NOT MAKE THE TOTAL QUANTITY REC'D GREATER THAN

 +2       ;TOTAL QUANTITY ORDERED

 +3        DO TOTRCD

 +4        IF $DATA(^ACRRR(DA,"DT"))

               SET ACRRCDX=ACRRCDX-$PIECE(^("DT"),U,2)

 +5        IF ACRRCDX+X>ACRRQD

               Begin DoDot:1

 +6                WRITE *7,*7

 +7                WRITE !!,"The quantity received on this receiving action cannot make the total quantity"

 +8                WRITE !,"received greater than the total quantity ordered (",ACRRQD,")"

 +9                WRITE !

 +10               KILL X

               End DoDot:1

 +11       QUIT 

TOTRCD    ;EP;TO CALCULATE THE TOTAL RECEIVED FOR AN ITEM

 +1        SET ACRRCDX=0

 +2        IF '$DATA(ACRRRDA)

               IF '$DATA(DA)

                   DO TOTRCD1

                   QUIT 

 +3        IF '$DATA(DA)

               IF $DATA(ACRRRDA)

                   SET DA=ACRRRDA

 +4        NEW ACRRRDA,ACRSSDA

 +5        SET ACRRRDA=DA

 +6        IF '$DATA(^ACRRR(+DA,0))

               QUIT 

 +7        SET ACRSSDA=+^ACRRR(DA,0)

TOTRCD1    IF '$DATA(^ACRSS(ACRSSDA,"DT"))

               QUIT 

 +1        SET ACRRQD=+^ACRSS(ACRSSDA,"DT")

 +2        SET (ACRRCDX,ACRRRX,ACRACPX)=0

 +3        FOR 

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

               IF 'ACRRRX

                   QUIT 

               Begin DoDot:1

 +4                SET ACRRCDX=ACRRCDX+$PIECE($GET(^ACRRR(ACRRRX,"DT")),U,2)

 +5                SET ACRACPX=ACRACPX+$PIECE($GET(^ACRRR(ACRRRX,"DT")),U,3)

               End DoDot:1

 +6        KILL ACRRRX

 +7        QUIT 

DATE      ;EP;

 +1        SET DIR(0)="DA^::EP"

 +2        SET DIR("A")="DATE RECEIVED.......: "

 +3        SET DIR("?",1)="Enter the date the items were actually received,"

 +4        SET DIR("?")="not the date you are doing the Receiving Report."

 +5        IF $GET(ACRDATE)

               Begin DoDot:1

 +6                SET Y=$PIECE(ACRDATE,".")

 +7                XECUTE ^DD("DD")

 +8                SET DIR("B")=Y

               End DoDot:1

 +9        DO DIR^ACRFDIC

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

               IF $DATA(ACRJ)

                   IF ACRJ

                       DO INCOMPLT

                       QUIT 

 +11       SET ACRDATE=Y

 +12       QUIT