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
