ACRFRR11.m

ACRFRR11 ;IHS/OIRM/DSD/THL,AEF - DISPLAY AND EDIT RECEIVING REPORT/INVOICE AUDIT - CON'T;  [ 09/23/2005  10:57 AM ]

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

 ;;CONTINUATION OF ACRFRR

FP ;EP;INDICATE WHETHER FINAL OR PARTIAL RECEIVING REPORT

 I $D(ACRIV)#2 D FP1 Q

 I '$D(ACRRRDA)#2 D RRNO^ACRFRRPT

 Q:'$D(ACRRRDA)#2

 Q:'ACRRRDA

 S ACRRRNO=$P(^ACRRR(ACRRRDA,0),U,4)

 I $P(^ACRRR(ACRRRDA,0),U,13)]"" S ACRPVN=$P(^(0),U,13)

 I $D(ACRRR)#2 D

 .D INVOICE

 S DA=ACRRRDA

 S DIE="^ACRRR("

 S DR=1301

 D DIE^ACRFDIC

 D RRR(ACRDOCDA,ACRRRNO,ACRRRDA)

FP1 S ACRP=$S($D(ACRRR)#2:"Receiving Report",1:"Invoice Audit")

 S:$D(ACRRR)#2 DIR(0)="SO^1:Final "_ACRP_";2:Partial "_ACRP_";3:Discontinue "_ACRP

 S:$D(ACRIV)#2 DIR(0)="SO^1:Final "_ACRP_" (191/192-1-4);2:Partial "_ACRP_" (181/182-1-4);3:Discontinue "_ACRP

 D DIR^ACRFDIC

 I 'Y S (ACRFINAL,ACRQUIT)="" Q

 S ACRFINAL=Y

 S:$D(ACRIV)#2 ACRTCODE=$S(ACRFINAL=1:19114,1:18114)

 Q:Y=3

 D ^ACRFIV4:$D(ACRIV)#2

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

 I $D(ACRIV)#2,'$D(ACRPAYME) Q

 D ^ACRFESIG:'$D(ACRIV)#2

 I $D(ACRQUIT)!$D(ACROUT) S ACRFINAL=0 Q

 N ACRRRZDA S ACRRRZDA=$G(ACRRRNO) ;ACR*2.1*3.31

 S:ACRRRZDA="" ACRRRZDA=$P($G(ACRRR0),U) ;ACR*2.1*3.31

 I $D(ACRRR)#2 D DHR:$P($G(^ACRSYS(1,"DT1")),U,5)=1

 I $D(ACRIV)#2 D

 .S ACRBTYP="V"

 .S ACRVDA=$S($P($G(^ACRDOC(ACRDOCDA,5)),U,5):$P(^(5),U,5),1:$P(^ACRDOC(ACRDOCDA,"PO"),U,5))

 .D SYNC^ACRFIV5

 .D ^ACRFIV11

 D NOW^%DTC

 S ACRDATE=%

 S DIE="^ACRDOC(",DA=ACRDOCDA,DR="113210////"_%_";113200////"_DUZ

 D DIE^ACRFDIC:$D(ACRRR)#2

 S ACRFINX=ACRFINAL

 I $D(ACRRR)#2,$G(ACRPVN)="" D PVN^ACRFRR12

 I $L($G(ACRPVN)) D

 .W !!,"PROPERTY VOUCHER NO. ",@ACRON,ACRPVN,@ACROF," has been assigned to"

 .W !,"RECEIVING REPORT NO. ",ACRRRNO

 I $D(ACRRR)#2,$D(ACRFINAL),ACRFINAL=1 W !!,"Final ",ACRP," completed." H 2 K:ACRRDATE ^ACRDOC("DI",ACRRDATE,ACRDOCDA)

 K ACRP

 D:'ACRRRNO&'+$G(ACRRRNOX) RRNO^ACRFRR31

 S ACRRRNOX=$S($D(ACRRRNOX):ACRRRNOX,1:ACRRRNO)

 N ACRJ

 F ACRJ=1:1 S ACRRRNO=$P(ACRRRNOX,",",ACRJ) Q:'ACRRRNO  D FINAL

 Q

FINAL S ACRSSNO=0

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

 .S ACRRRDA=0

 .F  S ACRRRDA=$O(^ACRRR("AC",ACRDOCDA,ACRRRNO,ACRSSNO,ACRRRDA)) Q:'ACRRRDA  D

 ..S ACRFINAL=ACRFINX

 ..S DA=ACRRRDA

 ..S DIE="^ACRRR("

 ..S:$D(ACRRR)#2 DR=".08////"_ACRFINAL_";.13////"_$G(ACRPVN)_";.06////"_ACRDATE_";.05////"_DUZ

 ..S:$D(ACRIV)#2 DR=".11"_"////"_ACRFINAL_";.09////"_DUZ_";.1////"_ACRDATE

 ..D DIE^ACRFDIC

 S ACRFINAL=ACRFINX,DA=ACRDOCDA,DIE="^ACROBL(",DR=$S($D(ACRRR)#2:909,1:912)_"////"_ACRFINAL D DIE^ACRFDIC

 I $D(ACRRR)#2 D

 .I ACRFINAL=1 S ACRDIDAT=$P(^ACRDOC(ACRDOCDA,"PO"),U,12),ACRRL=+^ACRDOC(ACRDOCDA,"POST") I ACRRL,ACRDIDAT,ACRDOCDA K ^ACRDOC("DI",ACRRL,ACRDIDAT,ACRDOCDA)

 .D RNOTE,RRPT^ACRFRRPT

 W !

 Q:$D(ACRIV)#2

 S DIR(0)="YO",DIR("A")="Print copy of Receiving Report now",DIR("B")="NO"

 D DIR^ACRFDIC

 Q:Y'=1

 D SETDOC^ACRFEA1,P11^ACRFPO1

 Q

RNOTE ;NOTIFY REQUEST INITIATOR AND REQUESTOR OF RECEIPT OF GOODS

 N W,X,Y,Z,ACRREFDA

 S ACRFINX=ACRFINAL,ACRAPVT=41,ACRORDER=1,ACRFINAL="N",ACRREFDA=$O(^AUTTDOCR("B",499,0))

 S X=0

 F  S X=$O(^ACRSS("J",ACRDOCDA,X)) Q:'X  I $D(^ACRSS(X,0)) S Y=$P(^(0),U,3) I Y,$D(^ACRDOC(Y,"REQ2")) S Z=$P(^("REQ2"),U,8) S:Z (XMY(Z),ACRXMY(Z))="I"

 S ACRUSER=0

 F  S ACRUSER=$O(ACRXMY(ACRUSER)) Q:'ACRUSER  D

 .K Y

 .S ACRFINX=ACRFINAL

 .S ACRAPVT=41

 .S ACRFINAL="N"

 .S ACRREFDA=$O(^AUTTDOCR("B",499,0))

 .S ACRORDER=1

 .D SETAPP^ACRFAPVS

 .I $G(Y)>0 D

 ..S ACRAPDA=+Y

 ..S ^ACRAPVS("ANXT",ACRAPVT,ACRUSER,+Y)=ACRDOCDA

 ..D APPS

 S XMDT=DT

 S XMDUZ=DUZ

 S XMSUB="RECIEVING REPORT # "_ACRRRNO_" FOR "_ACRDOC

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

 S X=$$NAME2^ACRFUTL1(DUZ)  ;ACR*2.1*19.02 IM16848

 S ACRRCVR=$P($P(X,",",2)," ")_" "_$P(X,",")

 D NOW^%DTC

 S Y=%

 X ^DD("DD")

 S ACRDATE=Y

 S XMTEXT="ACRTEXT("

 S ACRTEXT(1)="Receiving Report number "_ACRRRNO_" was completed by"

 S ACRTEXT(2)=ACRRCVR_" on "_ACRDATE

 S ACRTEXT(3)="For items received from "_$P($G(^AUTTVNDR(+$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5),0)),U)

 S ACRTEXT(4)="If items from this order are not delivered to your office in the next 24 hours,"

 S ACRTEXT(5)="pleae contact the receiving agent."

 N W,X,Y,Z

 S X=$P(^ACRDOC(ACRDOCDA,"REQ2"),U,8)

 S:X (XMY(X),ACRXMY(X))="I"

 S W=0

 F  S W=$O(^ACRSS("J",ACRDOCDA,W)) Q:'W  D

 .S X=0

 .F  S X=$O(^ACRSS("J",ACRDOCDA,W,X)) Q:'X  D

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

 ...I Y,$D(^ACRDOC(Y,"REQ2")) S Z=$P(^("REQ2"),U,8) S:Z (XMY(Z),ACRXMY(Z))="I"

 D ^XMD

 W !!,"MESSAGE(S) SENT TO THE FOLLOWING REQUEST INITIATORS THAT THEIR REQUESTED"

 W !,"ITEMS WERE RECEIVED."

 W !

 S X=0

 ;F  S X=$O(ACRXMY(X)) Q:'X  I $D(^VA(200,X,0)) S Y=$P(^(0),U) W !?10,$P($P(Y,",",2)," ")," ",$P(Y,",")  ; ACR*2.1*19.02 IM16848

 F  S X=$O(ACRXMY(X)) Q:'X  I $D(^VA(200,X,0)) S Y=$$NAME3^ACRFUTL1(X) W !?10,Y  ; ACR*2.1*19.02 IM16848

 K ACRXMY,ACRTEXT,XMTEXT,XMY

 D PAUSE^ACRFWARN

 Q

INVOICE ;EP;TO RECORD THE INVOICE NUMBER FOR A RECEIVING REPORT

 Q:'$D(ACRRRNO)

 D IADD^ACRFRR3

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

 S DA=ACRRRNO

 S DA(1)=ACRDOCDA

 S DIE="^ACRDOC("_ACRDOCDA_",20,"

 S DR=".01T;.02T;.03T"

 W !

 D DIE^ACRFDIC

 Q

DHR ;CREATE ACCRUAL DHR

 N ACRREFX,ACRRR,ACRTCODE,ACRRCODE,ACRMCODE

 S ACRREFX=499

 S ACRRR=""

 S ACRTCODE="081"

 S ACRRCODE="1"

 S ACRMCODE="4"

 D ^ACRFDHR

 Q

APPS ;SET SIGNATURE APPROVAL LINK

 S ACRSSNO=0

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

 .S ACRRRDA=0

 .F  S ACRRRDA=$O(^ACRRR("AC",ACRDOCDA,ACRRRNO,ACRSSNO,ACRRRDA)) Q:'ACRRRDA  D

 ..S (DA(1),DA)=ACRRRDA

 ..S X=ACRAPDA

 ..S DIC="^ACRRR("_DA_",10,"

 ..S DIC(0)="L"

 ..S:'$D(^ACRRR(DA,10,0)) ^ACRRR(DA,10,0)="^9002193.2101"

 ..D FILE^ACRFDIC

 Q

RRR(ACRDOCDA,ACRRRNO,ACRRRDA)          ;

 ;----- STUFF REMARKS INTO ALL ITEMS ON RECEIVING REPORT

 ;

 N ACR

 S ACR=0

 F  S ACR=$O(^ACRRR("AD",ACRDOCDA,ACRRRNO,ACR)) Q:'ACR  D

 . Q:ACR=ACRRRDA

 . S %X="^ACRRR("_ACRRRDA_",13,"

 . S %Y="^ACRRR("_ACR_",13,"

 . D %XY^%RCR

 Q

ACRFRR11  ;IHS/OIRM/DSD/THL,AEF - DISPLAY AND EDIT RECEIVING REPORT/INVOICE AUDIT - CON'T;  [ 09/23/2005  10:57 AM ]

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

 +2       ;;CONTINUATION OF ACRFRR

FP        ;EP;INDICATE WHETHER FINAL OR PARTIAL RECEIVING REPORT

 +1        IF $DATA(ACRIV)#2

               DO FP1

               QUIT 

 +2        IF '$DATA(ACRRRDA)#2

               DO RRNO^ACRFRRPT

 +3        IF '$DATA(ACRRRDA)#2

               QUIT 

 +4        IF 'ACRRRDA

               QUIT 

 +5        SET ACRRRNO=$PIECE(^ACRRR(ACRRRDA,0),U,4)

 +6        IF $PIECE(^ACRRR(ACRRRDA,0),U,13)]""

               SET ACRPVN=$PIECE(^(0),U,13)

 +7        IF $DATA(ACRRR)#2

               Begin DoDot:1

 +8                DO INVOICE

               End DoDot:1

 +9        SET DA=ACRRRDA

 +10       SET DIE="^ACRRR("

 +11       SET DR=1301

 +12       DO DIE^ACRFDIC

 +13       DO RRR(ACRDOCDA,ACRRRNO,ACRRRDA)

FP1        SET ACRP=$SELECT($DATA(ACRRR)#2:"Receiving Report",1:"Invoice Audit")

 +1        IF $DATA(ACRRR)#2

               SET DIR(0)="SO^1:Final "_ACRP_";2:Partial "_ACRP_";3:Discontinue "_ACRP

 +2        IF $DATA(ACRIV)#2

               SET DIR(0)="SO^1:Final "_ACRP_" (191/192-1-4);2:Partial "_ACRP_" (181/182-1-4);3:Discontinue "_ACRP

 +3        DO DIR^ACRFDIC

 +4        IF 'Y

               SET (ACRFINAL,ACRQUIT)=""

               QUIT 

 +5        SET ACRFINAL=Y

 +6        IF $DATA(ACRIV)#2

               SET ACRTCODE=$SELECT(ACRFINAL=1:19114,1:18114)

 +7        IF Y=3

               QUIT 

 +8        IF $DATA(ACRIV)#2

               DO ^ACRFIV4

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

               QUIT 

 +10       IF $DATA(ACRIV)#2

               IF '$DATA(ACRPAYME)

                   QUIT 

 +11       IF '$DATA(ACRIV)#2

               DO ^ACRFESIG

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

               SET ACRFINAL=0

               QUIT 

 +13      ;ACR*2.1*3.31

           NEW ACRRRZDA

           SET ACRRRZDA=$GET(ACRRRNO)

 +14      ;ACR*2.1*3.31

           IF ACRRRZDA=""

               SET ACRRRZDA=$PIECE($GET(ACRRR0),U)

 +15       IF $DATA(ACRRR)#2

               IF $PIECE($GET(^ACRSYS(1,"DT1")),U,5)=1

                   DO DHR

 +16       IF $DATA(ACRIV)#2

               Begin DoDot:1

 +17               SET ACRBTYP="V"

 +18               SET ACRVDA=$SELECT($PIECE($GET(^ACRDOC(ACRDOCDA,5)),U,5):$PIECE(^(5),U,5),1:$PIECE(^ACRDOC(ACRDOCDA,"PO"),U,5))

 +19               DO SYNC^ACRFIV5

 +20               DO ^ACRFIV11

               End DoDot:1

 +21       DO NOW^%DTC

 +22       SET ACRDATE=%

 +23       SET DIE="^ACRDOC("

           SET DA=ACRDOCDA

           SET DR="113210////"_%_";113200////"_DUZ

 +24       IF $DATA(ACRRR)#2

               DO DIE^ACRFDIC

 +25       SET ACRFINX=ACRFINAL

 +26       IF $DATA(ACRRR)#2

               IF $GET(ACRPVN)=""

                   DO PVN^ACRFRR12

 +27       IF $LENGTH($GET(ACRPVN))

               Begin DoDot:1

 +28               WRITE !!,"PROPERTY VOUCHER NO. ",@ACRON,ACRPVN,@ACROF," has been assigned to"

 +29               WRITE !,"RECEIVING REPORT NO. ",ACRRRNO

               End DoDot:1

 +30       IF $DATA(ACRRR)#2

               IF $DATA(ACRFINAL)

                   IF ACRFINAL=1

                       WRITE !!,"Final ",ACRP," completed."

                       HANG 2

                       IF ACRRDATE

                           KILL ^ACRDOC("DI",ACRRDATE,ACRDOCDA)

 +31       KILL ACRP

 +32       IF 'ACRRRNO&'+$GET(ACRRRNOX)

               DO RRNO^ACRFRR31

 +33       SET ACRRRNOX=$SELECT($DATA(ACRRRNOX):ACRRRNOX,1:ACRRRNO)

 +34       NEW ACRJ

 +35       FOR ACRJ=1:1

               SET ACRRRNO=$PIECE(ACRRRNOX,",",ACRJ)

               IF 'ACRRRNO

                   QUIT 

               DO FINAL

 +36       QUIT 

FINAL      SET ACRSSNO=0

 +1        FOR 

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

               IF 'ACRSSNO

                   QUIT 

               Begin DoDot:1

 +2                SET ACRRRDA=0

 +3                FOR 

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

                       IF 'ACRRRDA

                           QUIT 

                       Begin DoDot:2

 +4                        SET ACRFINAL=ACRFINX

 +5                        SET DA=ACRRRDA

 +6                        SET DIE="^ACRRR("

 +7                        IF $DATA(ACRRR)#2

                               SET DR=".08////"_ACRFINAL_";.13////"_$GET(ACRPVN)_";.06////"_ACRDATE_";.05////"_DUZ

 +8                        IF $DATA(ACRIV)#2

                               SET DR=".11"_"////"_ACRFINAL_";.09////"_DUZ_";.1////"_ACRDATE

 +9                        DO DIE^ACRFDIC

                       End DoDot:2

               End DoDot:1

 +10       SET ACRFINAL=ACRFINX

           SET DA=ACRDOCDA

           SET DIE="^ACROBL("

           SET DR=$SELECT($DATA(ACRRR)#2:909,1:912)_"////"_ACRFINAL

           DO DIE^ACRFDIC

 +11       IF $DATA(ACRRR)#2

               Begin DoDot:1

 +12               IF ACRFINAL=1

                       SET ACRDIDAT=$PIECE(^ACRDOC(ACRDOCDA,"PO"),U,12)

                       SET ACRRL=+^ACRDOC(ACRDOCDA,"POST")

                       IF ACRRL

                           IF ACRDIDAT

                               IF ACRDOCDA

                                   KILL ^ACRDOC("DI",ACRRL,ACRDIDAT,ACRDOCDA)

 +13               DO RNOTE

                   DO RRPT^ACRFRRPT

               End DoDot:1

 +14       WRITE !

 +15       IF $DATA(ACRIV)#2

               QUIT 

 +16       SET DIR(0)="YO"

           SET DIR("A")="Print copy of Receiving Report now"

           SET DIR("B")="NO"

 +17       DO DIR^ACRFDIC

 +18       IF Y'=1

               QUIT 

 +19       DO SETDOC^ACRFEA1

           DO P11^ACRFPO1

 +20       QUIT 

RNOTE     ;NOTIFY REQUEST INITIATOR AND REQUESTOR OF RECEIPT OF GOODS

 +1        NEW W,X,Y,Z,ACRREFDA

 +2        SET ACRFINX=ACRFINAL

           SET ACRAPVT=41

           SET ACRORDER=1

           SET ACRFINAL="N"

           SET ACRREFDA=$ORDER(^AUTTDOCR("B",499,0))

 +3        SET X=0

 +4        FOR 

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

               IF 'X

                   QUIT 

               IF $DATA(^ACRSS(X,0))

                   SET Y=$PIECE(^(0),U,3)

                   IF Y

                       IF $DATA(^ACRDOC(Y,"REQ2"))

                           SET Z=$PIECE(^("REQ2"),U,8)

                           IF Z

                               SET (XMY(Z),ACRXMY(Z))="I"

 +5        SET ACRUSER=0

 +6        FOR 

               SET ACRUSER=$ORDER(ACRXMY(ACRUSER))

               IF 'ACRUSER

                   QUIT 

               Begin DoDot:1

 +7                KILL Y

 +8                SET ACRFINX=ACRFINAL

 +9                SET ACRAPVT=41

 +10               SET ACRFINAL="N"

 +11               SET ACRREFDA=$ORDER(^AUTTDOCR("B",499,0))

 +12               SET ACRORDER=1

 +13               DO SETAPP^ACRFAPVS

 +14               IF $GET(Y)>0

                       Begin DoDot:2

 +15                       SET ACRAPDA=+Y

 +16                       SET ^ACRAPVS("ANXT",ACRAPVT,ACRUSER,+Y)=ACRDOCDA

 +17                       DO APPS

                       End DoDot:2

               End DoDot:1

 +18       SET XMDT=DT

 +19       SET XMDUZ=DUZ

 +20       SET XMSUB="RECIEVING REPORT # "_ACRRRNO_" FOR "_ACRDOC

 +21      ;S X=$P(^VA(200,DUZ,0),U)  ;ACR*2.1*19.02 IM16848

 +22      ;ACR*2.1*19.02 IM16848

           SET X=$$NAME2^ACRFUTL1(DUZ)

 +23       SET ACRRCVR=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")

 +24       DO NOW^%DTC

 +25       SET Y=%

 +26       XECUTE ^DD("DD")

 +27       SET ACRDATE=Y

 +28       SET XMTEXT="ACRTEXT("

 +29       SET ACRTEXT(1)="Receiving Report number "_ACRRRNO_" was completed by"

 +30       SET ACRTEXT(2)=ACRRCVR_" on "_ACRDATE

 +31       SET ACRTEXT(3)="For items received from "_$PIECE($GET(^AUTTVNDR(+$PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,5),0)),U)

 +32       SET ACRTEXT(4)="If items from this order are not delivered to your office in the next 24 hours,"

 +33       SET ACRTEXT(5)="pleae contact the receiving agent."

 +34       NEW W,X,Y,Z

 +35       SET X=$PIECE(^ACRDOC(ACRDOCDA,"REQ2"),U,8)

 +36       IF X

               SET (XMY(X),ACRXMY(X))="I"

 +37       SET W=0

 +38       FOR 

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

               IF 'W

                   QUIT 

               Begin DoDot:1

 +39               SET X=0

 +40               FOR 

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

                       IF 'X

                           QUIT 

                       Begin DoDot:2

 +41                       IF $DATA(^ACRSS(X,0))

                               SET Y=$PIECE(^(0),U,3)

                               Begin DoDot:3

 +42                               IF Y

                                       IF $DATA(^ACRDOC(Y,"REQ2"))

                                           SET Z=$PIECE(^("REQ2"),U,8)

                                           IF Z

                                               SET (XMY(Z),ACRXMY(Z))="I"

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +43       DO ^XMD

 +44       WRITE !!,"MESSAGE(S) SENT TO THE FOLLOWING REQUEST INITIATORS THAT THEIR REQUESTED"

 +45       WRITE !,"ITEMS WERE RECEIVED."

 +46       WRITE !

 +47       SET X=0

 +48      ;F  S X=$O(ACRXMY(X)) Q:'X  I $D(^VA(200,X,0)) S Y=$P(^(0),U) W !?10,$P($P(Y,",",2)," ")," ",$P(Y,",")  ; ACR*2.1*19.02 IM16848

 +49      ; ACR*2.1*19.02 IM16848

           FOR 

               SET X=$ORDER(ACRXMY(X))

               IF 'X

                   QUIT 

               IF $DATA(^VA(200,X,0))

                   SET Y=$$NAME3^ACRFUTL1(X)

                   WRITE !?10,Y

 +50       KILL ACRXMY,ACRTEXT,XMTEXT,XMY

 +51       DO PAUSE^ACRFWARN

 +52       QUIT 

INVOICE   ;EP;TO RECORD THE INVOICE NUMBER FOR A RECEIVING REPORT

 +1        IF '$DATA(ACRRRNO)

               QUIT 

 +2        DO IADD^ACRFRR3

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

               SET ^ACRDOC(ACRDOCDA,20,0)="^9002196.2001"

 +4        SET DA=ACRRRNO

 +5        SET DA(1)=ACRDOCDA

 +6        SET DIE="^ACRDOC("_ACRDOCDA_",20,"

 +7        SET DR=".01T;.02T;.03T"

 +8        WRITE !

 +9        DO DIE^ACRFDIC

 +10       QUIT 

DHR       ;CREATE ACCRUAL DHR

 +1        NEW ACRREFX,ACRRR,ACRTCODE,ACRRCODE,ACRMCODE

 +2        SET ACRREFX=499

 +3        SET ACRRR=""

 +4        SET ACRTCODE="081"

 +5        SET ACRRCODE="1"

 +6        SET ACRMCODE="4"

 +7        DO ^ACRFDHR

 +8        QUIT 

APPS      ;SET SIGNATURE APPROVAL LINK

 +1        SET ACRSSNO=0

 +2        FOR 

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

               IF 'ACRSSNO

                   QUIT 

               Begin DoDot:1

 +3                SET ACRRRDA=0

 +4                FOR 

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

                       IF 'ACRRRDA

                           QUIT 

                       Begin DoDot:2

 +5                        SET (DA(1),DA)=ACRRRDA

 +6                        SET X=ACRAPDA

 +7                        SET DIC="^ACRRR("_DA_",10,"

 +8                        SET DIC(0)="L"

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

                               SET ^ACRRR(DA,10,0)="^9002193.2101"

 +10                       DO FILE^ACRFDIC

                       End DoDot:2

               End DoDot:1

 +11       QUIT 

RRR(ACRDOCDA,ACRRRNO,ACRRRDA) ;

 +1       ;----- STUFF REMARKS INTO ALL ITEMS ON RECEIVING REPORT

 +2       ;

 +3        NEW ACR

 +4        SET ACR=0

 +5        FOR 

               SET ACR=$ORDER(^ACRRR("AD",ACRDOCDA,ACRRRNO,ACR))

               IF 'ACR

                   QUIT 

               Begin DoDot:1

 +6                IF ACR=ACRRRDA

                       QUIT 

 +7                SET %X="^ACRRR("_ACRRRDA_",13,"

 +8                SET %Y="^ACRRR("_ACR_",13,"

 +9                DO %XY^%RCR

               End DoDot:1

 +10       QUIT