ACRFRR1 ;IHS/OIRM/DSD/THL,AEF - DISPLAY AND EDIT RECEIVING REPORT OR INVOICE AUDIT; [ 07/20/2006 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**20**;NOV 05, 2001
;;CONTINUATION OF ACRFRR
EN Q:$D(ACRQUIT)!$D(ACROUT)
K ACRRRNO,ACRRRNOX
S ACRDOC=$S($P(ACRDOC0,U,2)]"":$P(ACRDOC0,U,2),1:$P(ACRDOC0,U))
S ACRLBDA=$P(ACRDOC0,U,6)
S ACRRDATE=$P(ACRDOCPO,U,12)
I $D(ACRIV)#2 D Q:$D(ACRQUIT)!$D(ACROUT)
.D RR^ACRFIV:'+$G(ACRRRNOX)
.S ACRVDA=$P($G(^ACRDOC(ACRDOCDA,5)),U,5)
.I 'ACRVDA S ACRQUIT="" Q
.D EDIT^ACRFIVD
Q:$D(ACROUT)
F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
S ACRSSDA=0
S ACRP=$S($D(ACRRR)#2:6,1:19)
I $D(ACRFINAL) D I 1
.S ACRFINAL=0
.F S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA D
..S:$P(^ACRSS(ACRSSDA,"DT"),U,ACRP)]"" ACRFINAL=1
E S ACRFINAL=0
K ACRP
I '$D(ACRIV)#2,$D(^ACRSS("J",ACRDOCDA))&ACRFINAL D FP^ACRFRR11
I '$D(ACRRR)#2,$D(^TMP("ACRSYNC",$J)) D FP^ACRFRR11
I $D(ACRRR)#2,$D(ACRSSTOT),$P(^ACROBL(ACRDOCDA,0),U)'=ACRSSTOT D EX
EXIT K ACRX,ACRSS,ACRSSDT,ACRQUIT,ACRRDATE,ACRSSACP,ACRSSITP,ACRSSREC,ACRSSTP,ACRPVN
Q
EN1 I $D(ACRIV)#2 D ^ACRFIV5 Q
D DISPLAY
D EORA^ACRFRR3:'$D(ACRQUIT)
Q
EX S DA=ACRDOCDA
S DIE="^ACROBL("
S DR=".01///"_ACRSSTOT
D DIE^ACRFDIC
Q
TRX S DA=$O(^ACRTRX("AC",ACRDOCDA,ACRFINAL,""))
I DA]"" D G TRX1
.S DA=$O(^ACRTRX("AC",ACRDOCDA,"F",""))
.S DIE="^ACRTRX("
.S DR="10////"_ACRSSTP
.D DIE^ACRFDIC
I DA="" D
.S X=ACRFINAL
.S DIC="^ACRTRX("
.S DIC(0)="L"
.S DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_ACRLBDA_";1////"_DT_";2////"_DT_";3////"_DUZ_";10////"_ACRSSTP
.D FILE^ACRFDIC
TRX1 S DA=ACRDOCDA
S DIE="^ACROBL("
S DR="2////"_ACRSSTP_";909////1"
D DIE^ACRFDIC
Q
DISPLAY ;EP;
K ACRSS
D HEAD
S (ACRSSDA,ACRSSTOT,ACRSSTP,ACRIVTP,ACRSSMAX,ACRJ)=0
F S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA D
.S ACRSSMAX=ACRSSMAX+1
.D D2
S ACRJ=0
F S ACRJ=$O(ACRSS(ACRJ)) Q:'ACRJ!$D(ACRQUIT) D DISP
K ACRQUIT,ACROUT
I ACRSSMAX<1 D Q
.W !?4,"NO ITEMS ON FILE FOR THIS PROCUREMENT"
.S ACRQUIT=""
.H 2
I ACRSSMAX>0 D
.W !?48,"-------------"
.W:$D(ACRIV)#2 ?62,"-------------"
.W !?38,"TOTAL"
.W ?48,$J($FN(ACRSSTOT,"P",2),13)
.W:$D(ACRIV)#2 ?62,$J($FN(ACRSSTP,"P",2),13)
I $D(ACRIV)#2,ACRIVTP>0 D
.W ?76,$J($P(ACRIVTP-ACRSSTP,"."),4)
.W !?29,"TOTAL INVOICED:"
.W ?62,$J($FN(ACRIVTP,"P",2),13)
.W:ACRSSTP>0 ?76,$J($P(ACRIVTP/(ACRSSTP*100)-100,"."),4)
Q
DISP D D1
W !,$J(ACRJ,3)
I $P(ACRSSNMS,U)]"" D
.W ?4,"VON: ",$P(ACRSSNMS,U)
.W !?3
I $P(ACRSSNMS,U,3)]"" D
.W ?4,"NDC: ",$P(ACRSSNMS,U,3)
.W !?3
I $P(ACRSSNMS,U,2)]"" D
.W ?4,"NSN: ",$P(ACRSSNMS,U,2)
.W !?3
W ?4,$P(ACRSSDSC,U)
N ACRJ,ACRI,ACRX
F ACRJ=2:1:5 I $P(ACRSSDSC,U,ACRJ)]"" S ACRX=$P(ACRSSDSC,U,ACRJ) D
.F ACRI=1:1 S ACRY=$P(ACRX," ",ACRI) Q:ACRY="" D
.W:$X+$L(ACRY)>79 !?3
.W ?$X+1,ACRY
W:ACRNOTES]"" !
F ACRJ=1:1:5 I $P(ACRNOTES,U,ACRJ)]"" S ACRX=$P(ACRNOTES,U,ACRJ) D
.F ACRI=1:1 S ACRY=$P(ACRX," ",ACRI) Q:ACRY="" D
.W:$X+$L(ACRY)>79 !?3
.W ?$X+1,ACRY
K ACRSSDSC,ACRNOTES
W !?22,$J(ACRSSORD,6)
W ?29,$J(ACRSSACP,6)
W ?36,$J($FN(ACRSSUP,"P",2),12)
W ?48,$J($FN(ACRSSIT,"P",2),13)
W:$D(ACRIV)#2 ?62,$J($FN(ACRSSITP,"P",2),13)
W:$D(ACRRR)#2 ?62,$J($FN(ACRSSACP*ACRSSUP,"P",2),13)
I $D(ACRIV)#2 D
.W:ACRIVT>0 ?76,$J($P(ACRIVT-ACRSSITP,"."),4)
.I ACRIVACP]"" D
..W !?13,"INVOICED:"
..W ?29,$J(ACRIVACP,6)
..W ?36,$J($FN(ACRIVUP,"P",2),12)
..W ?62,$J($FN(ACRIVT,"P",2),13)
.W:ACRSSITP>0 ?76,$J($P(ACRIVT/ACRSSITP*100-100,"."),4)
I IOSL-4<$Y D
.S DIR(0)="YO"
.S DIR("A")="Display Remaining Items"
.S DIR("B")="YES"
.W !
.D DIR^ACRFDIC
.I Y'=1 S ACRQUIT="" Q
.D HEAD
Q
HEAD W @IOF
W !?10,@ACRON,"SERVICES/SUPPLIES",@ACROF," RECEIVED FOR"
W !?10,"PURCHASE ORDER NO.: ",@ACRON,$S($P(ACRDOC0,U,2)]"":$P(ACRDOC0,U,2),1:$P(ACRDOC0,U)),@ACROF
W:$D(ACRIV)#2 !?76,"VARI"
W !?22,"ORD-"
W ?29,"ACC-"
W ?48,"ORDERED"
I $D(ACRIV)#2 D
.W ?62,"RECOMDED"
.W ?76,"ANCE"
W:$D(ACRRR)#2 ?62,"ESTIMATED"
W !,"ITM"
W ?4,"ORDER #/DESCRIPT"
W ?22,"ERED"
W ?29,"EPTED"
W ?36,"UNIT PRICE"
W ?48,"AMOUNT"
I $D(ACRIV)#2 D
.W ?62,"PAYMENT"
.W ?76,"$$/%"
W:$D(ACRRR)#2 ?62,"COST"
W !,"---"
W ?4,"-----------------"
W ?22,"------"
W ?29,"------"
W ?36,"-----------"
W ?48,"-------------"
I $D(ACRIV)#2 D
.W ?62,"-------------"
.W ?76,"----"
W:$D(ACRRR)#2 ?62,"-------------"
Q
D1 S ACRSSDA=ACRSS(ACRJ)
S ACRSSDT=^ACRSS(ACRSSDA,"DT")
S ACRSSNMS=$G(^ACRSS(ACRSSDA,"NMS"))
S ACRSSDSC=$G(^ACRSS(ACRSSDA,"DESC"))
S ACRNOTES=$G(^ACRSS(ACRSSDA,"NOTES"))
S ACRSSORD=$P(ACRSSDT,U)
S ACRSSREC=$P(ACRSSDT,U,5)
S ACRSSACP=$P(ACRSSDT,U,6)
S ACRSSIT=$P(ACRSSDT,U,4)
S ACRSSITP=$P(ACRSSDT,U,7)
S ACRSSUP=$P(ACRSSDT,U,3)
S ACRIVACP=$P(ACRSSDT,U,19)
S ACRIVUP=$P(ACRSSDT,U,20)
Q
D2 S ACRJ=ACRJ+1
S ACRSS0=^ACRSS(ACRSSDA,0)
I +ACRSS0'=ACRJ D
.S DA=ACRSSDA
.S DIE="^ACRSS("
.S DR=".01///^S X=ACRJ"
.D DIE^ACRFDIC
.S $P(ACRSS0,U)=ACRJ
S ACRSSDT=^ACRSS(ACRSSDA,"DT")
S ACRSS(+ACRSS0)=ACRSSDA
S ACRSSIT=$P(ACRSSDT,U,4)
S ACRSSITP=$P(ACRSSDT,U,7)
S ACRSSTOT=ACRSSTOT+ACRSSIT
S ACRSSTP=ACRSSTP+ACRSSITP
S ACRIVT=$P(ACRSSDT,U,21)
S ACRIVTP=ACRIVTP+ACRIVT
Q
VHEAD ;EP;PRINT VENDOR DATA
S D0=$S($P($G(^ACRDOC(+$G(ACRDOCDA),5)),U,5):$P(^(5),U,5),$D(^ACRDOC(+$G(ACRDOCDA),"PO")):$P(^("PO"),U,5),$G(ACRVDA):ACRVDA,1:"")
Q:'D0
N DXS,DIP,DC,DN
W @IOF
I $G(ACRDOCDA),D0'=$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5) W !?9,"VENDOR: ",$P($G(^AUTTVNDR(+$P($G(^("PO")),U,5),0)),U)
W !?9,"PAYEE.:"
W !?9,"------------------------------"
W !
D ^ACRPVND
Q
VCHANGE ;EP;SELECT PAYEE
I $D(ACRCC) D Q
.W !!,"THE DEFAULT CREDIT CARD VENDOR DATA CAN ONLY BE CHANGED THROUGH "
.W !,"THE ADD/EDIT VENDOR (EV) OPTION ON THE MAIN ARMS MENU"
.W !!,"NOTE: DO NOT CHANGE VENDOR ON THE REQUISITION WHEN "
.W "MAKING A CREDIT CARD PAYMENT",!
.D PAUSE^ACRFWARN
.S ACRQUIT=1
W !!,"WARNING: If any VENDOR DATA other than the REMIT TO ADDRESS information"
W !,"needs to be changed, consult with someone who has access to change"
W !,"ALL VENDOR DATA before you record this payment.",!
;S ACRVDA=$S($P($G(^ACRDOC(ACRDOCDA,5)),U,5):$P(^(5),U,5),$D(^("PO")):$P(^("PO"),U,5),1:"") ;ACR*2.1*20.07 IM17200
S ACRDOCDA=+$G(ACRDOCDA) ;ACR*2.1*20.07 IM17200
I '$G(ACRVDA) D ;ACR*2.1*20.07 IM17200
.S ACRVDA=$P($G(^ACRDOC(ACRDOCDA,5)),U,5) ;ACR*2.1*20.07 IM17200
.S:ACRVDA="" ACRVDA=$P($G(^ACRDOC(ACRDOCDA,"PO")),U,5) ;ACR*2.1*20.07 IM17200
S DIC="^AUTTVNDR("
S DIC(0)="AEMQZ"
S DIC("A")="PAYEE...............: "
;S DIC("B")=$P($G(^AUTTVNDR(ACRVDA,0)),U) ;ACR*2.1*20.07 IM17200
S:ACRVDA]"" DIC("B")=$P($G(^AUTTVNDR(ACRVDA,0)),U) ;ACR*2.1*20.07 IM17200
W !
D DIC^ACRFDIC
Q:$D(ACRQUIT)
I +Y>0 S ACRVDA=+Y
I +Y<1 D
.S DIR(0)="YO"
.S DIR("A",1)="No PAYEE was selected."
.S DIR("A")="Leave the PAYEE the same as the current VENDOR"
.S DIR("B")="YES"
.W !
.D DIR^ACRFDIC
.Q:Y=1!$D(ACRQUIT)
.G VCHANGE
S DA=ACRDOCDA
S DIE="^ACRDOC("
S DR="103950////"_ACRVDA
D DIE^ACRFDIC
Q
ACRFRR1 ;IHS/OIRM/DSD/THL,AEF - DISPLAY AND EDIT RECEIVING REPORT OR INVOICE AUDIT; [ 07/20/2006 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**20**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFRR
EN IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+1 KILL ACRRRNO,ACRRRNOX
+2 SET ACRDOC=$SELECT($PIECE(ACRDOC0,U,2)]"":$PIECE(ACRDOC0,U,2),1:$PIECE(ACRDOC0,U))
+3 SET ACRLBDA=$PIECE(ACRDOC0,U,6)
+4 SET ACRRDATE=$PIECE(ACRDOCPO,U,12)
+5 IF $DATA(ACRIV)#2
Begin DoDot:1
+6 IF '+$GET(ACRRRNOX)
DO RR^ACRFIV
+7 SET ACRVDA=$PIECE($GET(^ACRDOC(ACRDOCDA,5)),U,5)
+8 IF 'ACRVDA
SET ACRQUIT=""
QUIT
+9 DO EDIT^ACRFIVD
End DoDot:1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+10 IF $DATA(ACROUT)
QUIT
+11 FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+12 SET ACRSSDA=0
+13 SET ACRP=$SELECT($DATA(ACRRR)#2:6,1:19)
+14 IF $DATA(ACRFINAL)
Begin DoDot:1
+15 SET ACRFINAL=0
+16 FOR
SET ACRSSDA=$ORDER(^ACRSS("J",ACRDOCDA,ACRSSDA))
IF 'ACRSSDA
QUIT
Begin DoDot:2
+17 IF $PIECE(^ACRSS(ACRSSDA,"DT"),U,ACRP)]""
SET ACRFINAL=1
End DoDot:2
End DoDot:1
IF 1
+18 IF '$TEST
SET ACRFINAL=0
+19 KILL ACRP
+20 IF '$DATA(ACRIV)#2
IF $DATA(^ACRSS("J",ACRDOCDA))&ACRFINAL
DO FP^ACRFRR11
+21 IF '$DATA(ACRRR)#2
IF $DATA(^TMP("ACRSYNC",$JOB))
DO FP^ACRFRR11
+22 IF $DATA(ACRRR)#2
IF $DATA(ACRSSTOT)
IF $PIECE(^ACROBL(ACRDOCDA,0),U)'=ACRSSTOT
DO EX
EXIT KILL ACRX,ACRSS,ACRSSDT,ACRQUIT,ACRRDATE,ACRSSACP,ACRSSITP,ACRSSREC,ACRSSTP,ACRPVN
+1 QUIT
EN1 IF $DATA(ACRIV)#2
DO ^ACRFIV5
QUIT
+1 DO DISPLAY
+2 IF '$DATA(ACRQUIT)
DO EORA^ACRFRR3
+3 QUIT
EX SET DA=ACRDOCDA
+1 SET DIE="^ACROBL("
+2 SET DR=".01///"_ACRSSTOT
+3 DO DIE^ACRFDIC
+4 QUIT
TRX SET DA=$ORDER(^ACRTRX("AC",ACRDOCDA,ACRFINAL,""))
+1 IF DA]""
Begin DoDot:1
+2 SET DA=$ORDER(^ACRTRX("AC",ACRDOCDA,"F",""))
+3 SET DIE="^ACRTRX("
+4 SET DR="10////"_ACRSSTP
+5 DO DIE^ACRFDIC
End DoDot:1
GOTO TRX1
+6 IF DA=""
Begin DoDot:1
+7 SET X=ACRFINAL
+8 SET DIC="^ACRTRX("
+9 SET DIC(0)="L"
+10 SET DIC("DR")=".02////"_ACRDOCDA_";.03////"_ACRDOCDA_";.04////"_ACRLBDA_";1////"_DT_";2////"_DT_";3////"_DUZ_";10////"_ACRSSTP
+11 DO FILE^ACRFDIC
End DoDot:1
TRX1 SET DA=ACRDOCDA
+1 SET DIE="^ACROBL("
+2 SET DR="2////"_ACRSSTP_";909////1"
+3 DO DIE^ACRFDIC
+4 QUIT
DISPLAY ;EP;
+1 KILL ACRSS
+2 DO HEAD
+3 SET (ACRSSDA,ACRSSTOT,ACRSSTP,ACRIVTP,ACRSSMAX,ACRJ)=0
+4 FOR
SET ACRSSDA=$ORDER(^ACRSS("J",ACRDOCDA,ACRSSDA))
IF 'ACRSSDA
QUIT
Begin DoDot:1
+5 SET ACRSSMAX=ACRSSMAX+1
+6 DO D2
End DoDot:1
+7 SET ACRJ=0
+8 FOR
SET ACRJ=$ORDER(ACRSS(ACRJ))
IF 'ACRJ!$DATA(ACRQUIT)
QUIT
DO DISP
+9 KILL ACRQUIT,ACROUT
+10 IF ACRSSMAX<1
Begin DoDot:1
+11 WRITE !?4,"NO ITEMS ON FILE FOR THIS PROCUREMENT"
+12 SET ACRQUIT=""
+13 HANG 2
End DoDot:1
QUIT
+14 IF ACRSSMAX>0
Begin DoDot:1
+15 WRITE !?48,"-------------"
+16 IF $DATA(ACRIV)#2
WRITE ?62,"-------------"
+17 WRITE !?38,"TOTAL"
+18 WRITE ?48,$JUSTIFY($FNUMBER(ACRSSTOT,"P",2),13)
+19 IF $DATA(ACRIV)#2
WRITE ?62,$JUSTIFY($FNUMBER(ACRSSTP,"P",2),13)
End DoDot:1
+20 IF $DATA(ACRIV)#2
IF ACRIVTP>0
Begin DoDot:1
+21 WRITE ?76,$JUSTIFY($PIECE(ACRIVTP-ACRSSTP,"."),4)
+22 WRITE !?29,"TOTAL INVOICED:"
+23 WRITE ?62,$JUSTIFY($FNUMBER(ACRIVTP,"P",2),13)
+24 IF ACRSSTP>0
WRITE ?76,$JUSTIFY($PIECE(ACRIVTP/(ACRSSTP*100)-100,"."),4)
End DoDot:1
+25 QUIT
DISP DO D1
+1 WRITE !,$JUSTIFY(ACRJ,3)
+2 IF $PIECE(ACRSSNMS,U)]""
Begin DoDot:1
+3 WRITE ?4,"VON: ",$PIECE(ACRSSNMS,U)
+4 WRITE !?3
End DoDot:1
+5 IF $PIECE(ACRSSNMS,U,3)]""
Begin DoDot:1
+6 WRITE ?4,"NDC: ",$PIECE(ACRSSNMS,U,3)
+7 WRITE !?3
End DoDot:1
+8 IF $PIECE(ACRSSNMS,U,2)]""
Begin DoDot:1
+9 WRITE ?4,"NSN: ",$PIECE(ACRSSNMS,U,2)
+10 WRITE !?3
End DoDot:1
+11 WRITE ?4,$PIECE(ACRSSDSC,U)
+12 NEW ACRJ,ACRI,ACRX
+13 FOR ACRJ=2:1:5
IF $PIECE(ACRSSDSC,U,ACRJ)]""
SET ACRX=$PIECE(ACRSSDSC,U,ACRJ)
Begin DoDot:1
+14 FOR ACRI=1:1
SET ACRY=$PIECE(ACRX," ",ACRI)
IF ACRY=""
QUIT
Begin DoDot:2
End DoDot:2
+15 IF $X+$LENGTH(ACRY)>79
WRITE !?3
+16 WRITE ?$X+1,ACRY
End DoDot:1
+17 IF ACRNOTES]""
WRITE !
+18 FOR ACRJ=1:1:5
IF $PIECE(ACRNOTES,U,ACRJ)]""
SET ACRX=$PIECE(ACRNOTES,U,ACRJ)
Begin DoDot:1
+19 FOR ACRI=1:1
SET ACRY=$PIECE(ACRX," ",ACRI)
IF ACRY=""
QUIT
Begin DoDot:2
End DoDot:2
+20 IF $X+$LENGTH(ACRY)>79
WRITE !?3
+21 WRITE ?$X+1,ACRY
End DoDot:1
+22 KILL ACRSSDSC,ACRNOTES
+23 WRITE !?22,$JUSTIFY(ACRSSORD,6)
+24 WRITE ?29,$JUSTIFY(ACRSSACP,6)
+25 WRITE ?36,$JUSTIFY($FNUMBER(ACRSSUP,"P",2),12)
+26 WRITE ?48,$JUSTIFY($FNUMBER(ACRSSIT,"P",2),13)
+27 IF $DATA(ACRIV)#2
WRITE ?62,$JUSTIFY($FNUMBER(ACRSSITP,"P",2),13)
+28 IF $DATA(ACRRR)#2
WRITE ?62,$JUSTIFY($FNUMBER(ACRSSACP*ACRSSUP,"P",2),13)
+29 IF $DATA(ACRIV)#2
Begin DoDot:1
+30 IF ACRIVT>0
WRITE ?76,$JUSTIFY($PIECE(ACRIVT-ACRSSITP,"."),4)
+31 IF ACRIVACP]""
Begin DoDot:2
+32 WRITE !?13,"INVOICED:"
+33 WRITE ?29,$JUSTIFY(ACRIVACP,6)
+34 WRITE ?36,$JUSTIFY($FNUMBER(ACRIVUP,"P",2),12)
+35 WRITE ?62,$JUSTIFY($FNUMBER(ACRIVT,"P",2),13)
End DoDot:2
+36 IF ACRSSITP>0
WRITE ?76,$JUSTIFY($PIECE(ACRIVT/ACRSSITP*100-100,"."),4)
End DoDot:1
+37 IF IOSL-4<$Y
Begin DoDot:1
+38 SET DIR(0)="YO"
+39 SET DIR("A")="Display Remaining Items"
+40 SET DIR("B")="YES"
+41 WRITE !
+42 DO DIR^ACRFDIC
+43 IF Y'=1
SET ACRQUIT=""
QUIT
+44 DO HEAD
End DoDot:1
+45 QUIT
HEAD WRITE @IOF
+1 WRITE !?10,@ACRON,"SERVICES/SUPPLIES",@ACROF," RECEIVED FOR"
+2 WRITE !?10,"PURCHASE ORDER NO.: ",@ACRON,$SELECT($PIECE(ACRDOC0,U,2)]"":$PIECE(ACRDOC0,U,2),1:$PIECE(ACRDOC0,U)),@ACROF
+3 IF $DATA(ACRIV)#2
WRITE !?76,"VARI"
+4 WRITE !?22,"ORD-"
+5 WRITE ?29,"ACC-"
+6 WRITE ?48,"ORDERED"
+7 IF $DATA(ACRIV)#2
Begin DoDot:1
+8 WRITE ?62,"RECOMDED"
+9 WRITE ?76,"ANCE"
End DoDot:1
+10 IF $DATA(ACRRR)#2
WRITE ?62,"ESTIMATED"
+11 WRITE !,"ITM"
+12 WRITE ?4,"ORDER #/DESCRIPT"
+13 WRITE ?22,"ERED"
+14 WRITE ?29,"EPTED"
+15 WRITE ?36,"UNIT PRICE"
+16 WRITE ?48,"AMOUNT"
+17 IF $DATA(ACRIV)#2
Begin DoDot:1
+18 WRITE ?62,"PAYMENT"
+19 WRITE ?76,"$$/%"
End DoDot:1
+20 IF $DATA(ACRRR)#2
WRITE ?62,"COST"
+21 WRITE !,"---"
+22 WRITE ?4,"-----------------"
+23 WRITE ?22,"------"
+24 WRITE ?29,"------"
+25 WRITE ?36,"-----------"
+26 WRITE ?48,"-------------"
+27 IF $DATA(ACRIV)#2
Begin DoDot:1
+28 WRITE ?62,"-------------"
+29 WRITE ?76,"----"
End DoDot:1
+30 IF $DATA(ACRRR)#2
WRITE ?62,"-------------"
+31 QUIT
D1 SET ACRSSDA=ACRSS(ACRJ)
+1 SET ACRSSDT=^ACRSS(ACRSSDA,"DT")
+2 SET ACRSSNMS=$GET(^ACRSS(ACRSSDA,"NMS"))
+3 SET ACRSSDSC=$GET(^ACRSS(ACRSSDA,"DESC"))
+4 SET ACRNOTES=$GET(^ACRSS(ACRSSDA,"NOTES"))
+5 SET ACRSSORD=$PIECE(ACRSSDT,U)
+6 SET ACRSSREC=$PIECE(ACRSSDT,U,5)
+7 SET ACRSSACP=$PIECE(ACRSSDT,U,6)
+8 SET ACRSSIT=$PIECE(ACRSSDT,U,4)
+9 SET ACRSSITP=$PIECE(ACRSSDT,U,7)
+10 SET ACRSSUP=$PIECE(ACRSSDT,U,3)
+11 SET ACRIVACP=$PIECE(ACRSSDT,U,19)
+12 SET ACRIVUP=$PIECE(ACRSSDT,U,20)
+13 QUIT
D2 SET ACRJ=ACRJ+1
+1 SET ACRSS0=^ACRSS(ACRSSDA,0)
+2 IF +ACRSS0'=ACRJ
Begin DoDot:1
+3 SET DA=ACRSSDA
+4 SET DIE="^ACRSS("
+5 SET DR=".01///^S X=ACRJ"
+6 DO DIE^ACRFDIC
+7 SET $PIECE(ACRSS0,U)=ACRJ
End DoDot:1
+8 SET ACRSSDT=^ACRSS(ACRSSDA,"DT")
+9 SET ACRSS(+ACRSS0)=ACRSSDA
+10 SET ACRSSIT=$PIECE(ACRSSDT,U,4)
+11 SET ACRSSITP=$PIECE(ACRSSDT,U,7)
+12 SET ACRSSTOT=ACRSSTOT+ACRSSIT
+13 SET ACRSSTP=ACRSSTP+ACRSSITP
+14 SET ACRIVT=$PIECE(ACRSSDT,U,21)
+15 SET ACRIVTP=ACRIVTP+ACRIVT
+16 QUIT
VHEAD ;EP;PRINT VENDOR DATA
+1 SET D0=$SELECT($PIECE($GET(^ACRDOC(+$GET(ACRDOCDA),5)),U,5):$PIECE(^(5),U,5),$DATA(^ACRDOC(+$GET(ACRDOCDA),"PO")):$PIECE(^("PO"),U,5),$GET(ACRVDA):ACRVDA,1:"")
+2 IF 'D0
QUIT
+3 NEW DXS,DIP,DC,DN
+4 WRITE @IOF
+5 IF $GET(ACRDOCDA)
IF D0'=$PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,5)
WRITE !?9,"VENDOR: ",$PIECE($GET(^AUTTVNDR(+$PIECE($GET(^("PO")),U,5),0)),U)
+6 WRITE !?9,"PAYEE.:"
+7 WRITE !?9,"------------------------------"
+8 WRITE !
+9 DO ^ACRPVND
+10 QUIT
VCHANGE ;EP;SELECT PAYEE
+1 IF $DATA(ACRCC)
Begin DoDot:1
+2 WRITE !!,"THE DEFAULT CREDIT CARD VENDOR DATA CAN ONLY BE CHANGED THROUGH "
+3 WRITE !,"THE ADD/EDIT VENDOR (EV) OPTION ON THE MAIN ARMS MENU"
+4 WRITE !!,"NOTE: DO NOT CHANGE VENDOR ON THE REQUISITION WHEN "
+5 WRITE "MAKING A CREDIT CARD PAYMENT",!
+6 DO PAUSE^ACRFWARN
+7 SET ACRQUIT=1
End DoDot:1
QUIT
+8 WRITE !!,"WARNING: If any VENDOR DATA other than the REMIT TO ADDRESS information"
+9 WRITE !,"needs to be changed, consult with someone who has access to change"
+10 WRITE !,"ALL VENDOR DATA before you record this payment.",!
+11 ;S ACRVDA=$S($P($G(^ACRDOC(ACRDOCDA,5)),U,5):$P(^(5),U,5),$D(^("PO")):$P(^("PO"),U,5),1:"") ;ACR*2.1*20.07 IM17200
+12 ;ACR*2.1*20.07 IM17200
SET ACRDOCDA=+$GET(ACRDOCDA)
+13 ;ACR*2.1*20.07 IM17200
IF '$GET(ACRVDA)
Begin DoDot:1
+14 ;ACR*2.1*20.07 IM17200
SET ACRVDA=$PIECE($GET(^ACRDOC(ACRDOCDA,5)),U,5)
+15 ;ACR*2.1*20.07 IM17200
IF ACRVDA=""
SET ACRVDA=$PIECE($GET(^ACRDOC(ACRDOCDA,"PO")),U,5)
End DoDot:1
+16 SET DIC="^AUTTVNDR("
+17 SET DIC(0)="AEMQZ"
+18 SET DIC("A")="PAYEE...............: "
+19 ;S DIC("B")=$P($G(^AUTTVNDR(ACRVDA,0)),U) ;ACR*2.1*20.07 IM17200
+20 ;ACR*2.1*20.07 IM17200
IF ACRVDA]""
SET DIC("B")=$PIECE($GET(^AUTTVNDR(ACRVDA,0)),U)
+21 WRITE !
+22 DO DIC^ACRFDIC
+23 IF $DATA(ACRQUIT)
QUIT
+24 IF +Y>0
SET ACRVDA=+Y
+25 IF +Y<1
Begin DoDot:1
+26 SET DIR(0)="YO"
+27 SET DIR("A",1)="No PAYEE was selected."
+28 SET DIR("A")="Leave the PAYEE the same as the current VENDOR"
+29 SET DIR("B")="YES"
+30 WRITE !
+31 DO DIR^ACRFDIC
+32 IF Y=1!$DATA(ACRQUIT)
QUIT
+33 GOTO VCHANGE
End DoDot:1
+34 SET DA=ACRDOCDA
+35 SET DIE="^ACRDOC("
+36 SET DR="103950////"_ACRVDA
+37 DO DIE^ACRFDIC
+38 QUIT
