ACRFIV5 ;IHS/OIRM/DSD/THL,AEF - INVOICE AUDIT; [ 07/24/2002 10:20 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**3**;NOV 05, 2001
;;ROUTINE CALLED DURING PROCESSING OF INVOICES
EN K ^TMP("ACRSYNC",$J)
D EXIT
D GATHER
Q:'$D(^TMP("ACRIV",$J))
F D CHOOSE Q:$D(ACRQUIT)!$D(ACROUT)
EXIT K ACRSSDT,ACRSSNMS,ACRSSDSC,ACRNOTES,ACRSSUP,ACRSSORD,ACRSSACT,ACRIVACP,ACRSSIT,ACRIVIT,ACRSST,ACRIVT,ACRSSTX,ACRIVTX,ACRRR,ACRRRDA,ACRSS,ACRQUIT,ACRIVPAY,ACRIVTA,ACRRRACP,ACRRRIT,ACRRRT,ACRRRTA,ACRRRUP
K ^TMP("ACRIV",$J)
S ACRQUIT=""
S:'$D(ACROUT)&$D(ACRIVPAY) ACRFINAL=0
Q:'$D(^TMP("ACRSYNC",$J))
K ACRIVPAY
S ACRSSDA=0
F S ACRSSDA=$O(^TMP("ACRSYNC",$J,ACRSSDA)) Q:'ACRSSDA D PAY
I '$D(ACRIVPAY) D Q
.W !!,"No items were marked to be paid at this time."
.D PAUSE^ACRFWARN
.S ACRQUIT=""
Q
GATHER ;EP;GATHER INFO ON RECEIVING ACTIONS
I '$D(^ACRRR("AC",ACRDOCDA)) D Q
.W !!,"No RECEIVING REPORTS on file for this DOCUMENT." ;ACR*2.1*3.16
.D PAUSE^ACRFWARN
.S ACRQUIT="" Q
N ACRSSDA,X,Y,Z
S (ACRSSDA,ACRMAX)=0
F S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA D
.S ACRX=+^ACRSS(ACRSSDA,0)
.S ACRMAX=ACRMAX+1
.I ACRX'=ACRMAX D
..S DA=ACRSSDA
..S DIE="^ACRSS("
..S DR=".01///^S X=ACRMAX"
..D DIE^ACRFDIC
..S ACRX=ACRMAX
.S ^TMP("ACRIV",$J,ACRX)=ACRSSDA
Q
CHOOSE ;CHOOSE WHICH ORDERED ITEMS TO INVOICE FOR
D ITEMS
S DIR(0)="SO^1:Invoice ALL REMAINING QUANTITIES for ALL items;2:Invoice for SELECTED items only;3:RE-Set Number Invoiced;4:Display PURCHASE ORDER Items"
S DIR("A")="Which one"
W !
D DIR^ACRFDIC
I 'Y S ACRQUIT="" Q
I Y=1 D ALL Q
I Y=2 D SELECT Q
I Y=3 D RESET Q
I Y=4 D ITEMS
Q
ALL ;
N ACRSSDA,ACRZ
S ACRZ=0
F S ACRZ=$O(^TMP("ACRIV",$J,ACRZ)) Q:'ACRZ D ALL1
W !!,"All items have been marked as INVOICED in full."
D PAUSE^ACRFWARN
Q
ALL1 S ACRSSDA=+^TMP("ACRIV",$J,ACRZ)
S $P(^TMP("ACRSYNC",$J,ACRSSDA),U,3)=$P(^TMP("ACRSYNC",$J,ACRSSDA),U)-$P(^(ACRSSDA),U,2)
S $P(^TMP("ACRSYNC",$J,ACRSSDA),U,2)=$P(^TMP("ACRSYNC",$J,ACRSSDA),U)
S $P(^TMP("ACRSYNC",$J,ACRSSDA),U,5)=ACRIVUP
Q
SELECT D S1
Q:$G(ACRXX)=""
S DIR(0)="SO^1:Selected Items COMPLETELY INVOICED at listed cost;2:Edit Individual Items"
S DIR("A")="Which one"
W !
D DIR^ACRFDIC
Q:'Y
I Y=1 D EALL Q
I Y=2 D EDIT
Q
S1 ;SELECT ITEM(S)
I ACRMAX=1 S ACRY=+ACRSS0
E D
.S DIR(0)="LOA^1:"_ACRMAX
.S DIR("A")="Invoice for which items: "
.W !
.D DIR^ACRFDIC
.I '+Y S ACRQUIT="" Q
S ACRXX=ACRY
Q
EALL ;
F ACRI=1:1 S ACRZ=$P(ACRXX,",",ACRI) Q:'ACRZ D:$D(^TMP("ACRIV",$J,ACRZ)) ALL1
Q
EDIT F ACRI=1:1 S ACRZ=$P(ACRXX,",",ACRI) Q:'ACRZ D:$D(^TMP("ACRIV",$J,ACRZ)) IQ
Q
IQ ;EDIT INVOICE QUANTITIES
D IDHEAD
S ACRSSDA=+^TMP("ACRIV",$J,ACRZ)
D IDISPLAY
D IEDIT
Q
IEDIT S DIR(0)="NOA^"_(ACRIVTA*-1)_":"_(ACRRRTA-ACRIVTA)_":3"
S DIR("A")="QUANTITY INVOICED: "
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)!'Y
S $P(^TMP("ACRSYNC",$J,ACRSSDA),U,2)=Y+ACRIVTA
S:Y>0 $P(^TMP("ACRSYNC",$J,ACRSSDA),U,3)=Y+$P(^TMP("ACRSYNC",$J,ACRSSDA),U,3)
S DIR(0)="NOA^0:"_($P(^ACRSS(ACRSSDA,"DT"),U,3)+100)_":4"
S DIR("A")="INVOICE AMOUNT...: "
S DIR("B")=$P(^ACRSS(ACRSSDA,"DT"),U,3)
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)!'Y
S $P(^TMP("ACRSYNC",$J,ACRSSDA),U,4)=Y
Q
RESET ;RESET ITEM(S) TO ORIGINAL REMAINING QUANTITY
D S1
Q:$G(ACRXX)=""
F ACRI=1:1 S ACRZ=$P(ACRXX,",",ACRI) Q:'ACRZ I $D(^TMP("ACRIV",$J,ACRZ)) S ACRSSDA=^(ACRZ) Q:'$D(^TMP("ACRSYNC",$J,+ACRSSDA)) S $P(^(ACRSSDA),U,3)=0
Q
ITEMS ;DISPLAY ALL ITEMS FROM THE ORDER
K ACRQUIT
D IDHEAD
S ACRZ=0
F S ACRZ=$O(^TMP("ACRIV",$J,ACRZ)) Q:'ACRZ!$D(ACRQUIT)!$D(ACROUT) D
.S ACRSSDA=+^TMP("ACRIV",$J,ACRZ)
.D INVOICE(ACRSSDA)
S ACRZ=0
F S ACRZ=$O(^TMP("ACRIV",$J,ACRZ)) Q:'ACRZ!$D(ACRQUIT)!$D(ACROUT) D
.S ACRSSDA=+^TMP("ACRIV",$J,ACRZ)
.D IDISPLAY
K ACRQUIT
Q
SS ;GATHER INVOICE FOR DATA ONE ITEM
S ACRSS0=^ACRSS(ACRSSDA,0)
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 ACRSSUP=$P(ACRSSDT,U,3)
S ACRSST=ACRSSUP*ACRSSORD
S ACRSSACT=$G(ACRSSACT)+ACRSSORD
S (ACRRRDA,ACRRRT,ACRIVT,ACRRRTA,ACRIVTA,ACRCOST,ACRIVUP,ACRRRUP)=0
F S ACRRRDA=$O(^ACRRR("B",ACRSSDA,ACRRRDA)) Q:'ACRRRDA D
.S ACRRR0=$G(^ACRRR(ACRRRDA,0))
.S ACRRRDT=$G(^ACRRR(ACRRRDA,"DT"))
.S ACRRRACP=$P(ACRRRDT,U,3)
.S ACRIVACP=$P(ACRRRDT,U,6)
.S ACRRRUP=$P(ACRRRDT,U)
.S:ACRRRUP="" ACRRRUP=ACRSSUP
.S ACRIVUP=$P(ACRRRDT,U,5)
.S ACRRRTA=ACRRRTA+ACRRRACP
.S ACRIVTA=ACRIVTA+ACRIVACP
.S:ACRIVUP="" ACRIVUP=ACRSSUP
.S ACRRRIT=ACRRRACP*ACRRRUP
.S:$G(ACRRRIT)="" ACRRRIT=ACRSSIT
.S ACRIVIT=ACRIVACP*ACRIVUP
.S:$G(ACRIVIT)="" ACRIVIT=ACRSSIT
.S ACRRRT=ACRRRT+ACRRRIT
.S ACRIVT=ACRIVT+ACRIVIT
I $D(^TMP("ACRSYNC",$J,ACRSSDA)) S ACRIVTA=$P(^(ACRSSDA),U,2)
Q
INVOICE(X) ;GATHER INVOICE FOR DATA ONE ITEM
S ACRSSDA=X
S ACRSS0=^ACRSS(ACRSSDA,0)
S ACRSSDT=^ACRSS(ACRSSDA,"DT")
S ACROBJDA=$P(ACRSS0,U,4)
S ACRCANDA=$P(ACRSS0,U,5)
S ACRSSNMS=$G(^ACRSS(ACRSSDA,"NMS"))
S ACRSSDSC=$G(^ACRSS(ACRSSDA,"DESC"))
S ACRNOTES=$G(^ACRSS(ACRSSDA,"NOTES"))
S ACRSSORD=$P(ACRSSDT,U)
S ACRSSUP=$P(ACRSSDT,U,3)
S ACRSST=ACRSSUP*ACRSSORD
S ACRSSACT=$G(ACRSSACT)+ACRSSORD
S (ACRRRDA,ACRRRT,ACRIVT,ACRRRTA,ACRIVTA,ACRCOST,ACRIVUP)=0
F S ACRRRDA=$O(^ACRRR("B",ACRSSDA,ACRRRDA)) Q:'ACRRRDA D
.S ACRRR0=$G(^ACRRR(ACRRRDA,0))
.S ACRRRDT=$G(^ACRRR(ACRRRDA,"DT"))
.S ACRRRACP=$P(ACRRRDT,U,3)
.S ACRIVACP=$P(ACRRRDT,U,6)
.S ACRRRUP=$P(ACRRRDT,U)
.S:ACRRRUP="" ACRRRUP=ACRSSUP
.S ACRIVUP=$P(ACRRRDT,U,5)
.S ACRRRTA=ACRRRTA+ACRRRACP
.S ACRIVTA=ACRIVTA+ACRIVACP
.S:ACRIVUP="" ACRIVUP=ACRSSUP
.S ACRRRIT=ACRRRACP*ACRRRUP
.S:$G(ACRRRIT)="" ACRRRIT=ACRSSIT
.S ACRIVIT=ACRIVACP*ACRIVUP
.S:$G(ACRIVIT)="" ACRIVIT=ACRSSIT
.S ACRRRT=ACRRRT+ACRRRIT
.S ACRIVT=ACRIVT+ACRIVIT
I $D(^TMP("ACRSYNC",$J,ACRSSDA)) S ACRIVTA=$P(^(ACRSSDA),U,2)
E S $P(^TMP("ACRSYNC",$J,ACRSSDA),U)=ACRRRTA,$P(^(ACRSSDA),U,2)=ACRIVTA,$P(^(ACRSSDA),U,3)=0,$P(^(ACRSSDA),U,4)=ACRIVUP,$P(^(ACRSSDA),U,5)=ACRIVTA,$P(^(ACRSSDA),U,6)=ACRRRTA-ACRIVTA
Q
IDHEAD ;INVOICE DISPLAY HEADER
W @IOF
W !?10,"PURCHASE ORDER NO.......: ",$P(ACRDOC0,U,2)," ",$P(ACRDOC0,U)
W !!,?40,"RECEIVED/",?50,"ALREADY"
W ?70,"REMAINING"
W !,"ITM"
W ?4,"ORDER #/DESCRIPT"
W ?30,"OBLIGATED"
W ?40,"ACCEPTED"
W ?50,"PAID"
W ?60,"THIS PMT"
W ?70,"TO BE PD"
W !,"---"
W ?4,"-------------------------"
W ?30,"---------"
W ?40,"---------"
W ?50,"---------"
W ?60,"---------"
W ?70,"---------"
Q
IDISPLAY ;CONTROL DISPLAY OF ITEMS
D SS
D IDISP
Q
IDISP ;DISPLAY INVOICE HISTORY FOR ITEM
K ACR1,ACR2,ACR3
W !,ACRZ
I $P(ACRSSNMS,U)]"" D
.W ?4,"VON: ",$P(ACRSSNMS,U)
.D 1
.W !?3
I $P(ACRSSNMS,U,3)]"" D
.W ?4,"NDC: ",$P(ACRSSNMS,U,3)
.D 1:'$D(ACR1)
.D 2:'$D(ACR2)&$D(ACR1)
.D 3:'$D(ACR3)&$D(ACR1)&$D(ACR2)
.W !?3
I $P(ACRSSNMS,U,2)]"" D
.W ?4,"NSN: ",$P(ACRSSNMS,U,2)
.D 1:'$D(ACR1)
.D 2:'$D(ACR2)&$D(ACR1)
.D 3:'$D(ACR3)&$D(ACR1)&$D(ACR2)
.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
D 1:'$D(ACR1)
I '$D(ACR2)&$D(ACR1) W ! D 2
I '$D(ACR3)&$D(ACR1)&$D(ACR2) W ! D 3
W:$L(ACRNOTES)>4 !
N ACRI,ACRJ,ACRX,ACRY
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,ACRSSNMS
D 2:'$D(ACR2)
D 3:'$D(ACR3)
W $$DASH^ACRFMENU
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 IDHEAD
Q
1 N X
S X=^TMP("ACRSYNC",$J,ACRSSDA)
W:$X>30 !
W ?30,$J(ACRSSORD,8)
W ?40,$J($P(X,U),8)
W ?50,$J($P(X,U,2),8)
W ?60,$J($P(X,U,3),8)
W ?70,$J($P(X,U)-$P(X,U,2),8)
S ACR1=""
Q
2 N X
S X=^TMP("ACRSYNC",$J,ACRSSDA)
W:$X>15 !
W ?15,"UNIT PRICE:",?30,$J($FN(ACRSSUP,"P,",2),9)
W ?40,$J($FN(ACRRRUP,"P,",2),9)
W ?50,$J($FN($P(X,U,4),"P,",2),9)
S ACR2=""
Q
3 N X
S X=^TMP("ACRSYNC",$J,ACRSSDA)
W:$X>15 !
W ?15,"TOTAL.....:",?28,$J($FN(ACRSST,"P,",2),9)
W ?38,$J($FN(ACRRRT,"P,",2),9)
S ACR3=""
Q
SYNC ;EP - SYNCHRONIZE NEW INVOICED ITEMS
K ACRIVPAY
S ACRSSDA=0
F S ACRSSDA=$O(^TMP("ACRSYNC",$J,ACRSSDA)) Q:'ACRSSDA D
.S DA=$O(^ACRRR("B",ACRSSDA,0))
.Q:'DA
.S ACRRRDA=DA
.S DIE="^ACRRR("
.S DR="6////"_$P(^TMP("ACRSYNC",$J,ACRSSDA),U,2)_";5////"_$P(^TMP("ACRSYNC",$J,ACRSSDA),U,4)
.D DIE^ACRFDIC
.F S ACRRRDA=$O(^ACRRR("B",ACRSSDA,ACRRRDA)) Q:'ACRRRDA D
..S DA=ACRRRDA
..S DIE="^ACRRR("
..S DR="6////0"
..I $P($G(^ACRRR(ACRRRDA,"DT")),U,6) D DIE^ACRFDIC
.D PAY
K ^TMP("ACRSYNC",$J)
Q
PAY I '$P(^TMP("ACRSYNC",$J,ACRSSDA),U,3) K ^TMP("ACRSYNC",$J,ACRSSDA) Q
S ACRCANDA=$P(^ACRSS(ACRSSDA,0),U,5)
S ACROBJDA=$P(^ACRSS(ACRSSDA,0),U,4)
S ACRIVPAY(ACRCANDA,ACROBJDA)=$G(ACRIVPAY(ACRCANDA,ACROBJDA))+($P(^TMP("ACRSYNC",$J,ACRSSDA),U,3)*$P(^TMP("ACRSYNC",$J,ACRSSDA),U,4))
Q
N ACRSSDA,X,Y,Z,J
S (ACRSSDA,ACRMAX,J)=0
F S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA D
.S ACRX=+^ACRSS(ACRSSDA,0)
.S J=J+1
.I ACRX'=J D
..S DA=ACRSSDA
..S DIE="^ACRSS("
..S DR=".01///^S X=J"
..D DIE^ACRFDIC
..S ACRX=J
.I $D(^ACRRR("B",ACRSSDA)) S ^TMP("ACRIV",$J,ACRX)=ACRSSDA,ACRMAX=ACRMAX+1
Q
ACRFIV5 ;IHS/OIRM/DSD/THL,AEF - INVOICE AUDIT; [ 07/24/2002 10:20 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**3**;NOV 05, 2001
+2 ;;ROUTINE CALLED DURING PROCESSING OF INVOICES
EN KILL ^TMP("ACRSYNC",$JOB)
+1 DO EXIT
+2 DO GATHER
+3 IF '$DATA(^TMP("ACRIV",$JOB))
QUIT
+4 FOR
DO CHOOSE
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT KILL ACRSSDT,ACRSSNMS,ACRSSDSC,ACRNOTES,ACRSSUP,ACRSSORD,ACRSSACT,ACRIVACP,ACRSSIT,ACRIVIT,ACRSST,ACRIVT,ACRSSTX,ACRIVTX,ACRRR,ACRRRDA,ACRSS,ACRQUIT,ACRIVPAY,ACRIVTA,ACRRRACP,ACRRRIT,ACRRRT,ACRRRTA,ACRRRUP
+1 KILL ^TMP("ACRIV",$JOB)
+2 SET ACRQUIT=""
+3 IF '$DATA(ACROUT)&$DATA(ACRIVPAY)
SET ACRFINAL=0
+4 IF '$DATA(^TMP("ACRSYNC",$JOB))
QUIT
+5 KILL ACRIVPAY
+6 SET ACRSSDA=0
+7 FOR
SET ACRSSDA=$ORDER(^TMP("ACRSYNC",$JOB,ACRSSDA))
IF 'ACRSSDA
QUIT
DO PAY
+8 IF '$DATA(ACRIVPAY)
Begin DoDot:1
+9 WRITE !!,"No items were marked to be paid at this time."
+10 DO PAUSE^ACRFWARN
+11 SET ACRQUIT=""
End DoDot:1
QUIT
+12 QUIT
GATHER ;EP;GATHER INFO ON RECEIVING ACTIONS
+1 IF '$DATA(^ACRRR("AC",ACRDOCDA))
Begin DoDot:1
+2 ;ACR*2.1*3.16
WRITE !!,"No RECEIVING REPORTS on file for this DOCUMENT."
+3 DO PAUSE^ACRFWARN
+4 SET ACRQUIT=""
QUIT
End DoDot:1
QUIT
+5 NEW ACRSSDA,X,Y,Z
+6 SET (ACRSSDA,ACRMAX)=0
+7 FOR
SET ACRSSDA=$ORDER(^ACRSS("J",ACRDOCDA,ACRSSDA))
IF 'ACRSSDA
QUIT
Begin DoDot:1
+8 SET ACRX=+^ACRSS(ACRSSDA,0)
+9 SET ACRMAX=ACRMAX+1
+10 IF ACRX'=ACRMAX
Begin DoDot:2
+11 SET DA=ACRSSDA
+12 SET DIE="^ACRSS("
+13 SET DR=".01///^S X=ACRMAX"
+14 DO DIE^ACRFDIC
+15 SET ACRX=ACRMAX
End DoDot:2
+16 SET ^TMP("ACRIV",$JOB,ACRX)=ACRSSDA
End DoDot:1
+17 QUIT
CHOOSE ;CHOOSE WHICH ORDERED ITEMS TO INVOICE FOR
+1 DO ITEMS
+2 SET DIR(0)="SO^1:Invoice ALL REMAINING QUANTITIES for ALL items;2:Invoice for SELECTED items only;3:RE-Set Number Invoiced;4:Display PURCHASE ORDER Items"
+3 SET DIR("A")="Which one"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF 'Y
SET ACRQUIT=""
QUIT
+7 IF Y=1
DO ALL
QUIT
+8 IF Y=2
DO SELECT
QUIT
+9 IF Y=3
DO RESET
QUIT
+10 IF Y=4
DO ITEMS
+11 QUIT
ALL ;
+1 NEW ACRSSDA,ACRZ
+2 SET ACRZ=0
+3 FOR
SET ACRZ=$ORDER(^TMP("ACRIV",$JOB,ACRZ))
IF 'ACRZ
QUIT
DO ALL1
+4 WRITE !!,"All items have been marked as INVOICED in full."
+5 DO PAUSE^ACRFWARN
+6 QUIT
ALL1 SET ACRSSDA=+^TMP("ACRIV",$JOB,ACRZ)
+1 SET $PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U,3)=$PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U)-$PIECE(^(ACRSSDA),U,2)
+2 SET $PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U,2)=$PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U)
+3 SET $PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U,5)=ACRIVUP
+4 QUIT
SELECT DO S1
+1 IF $GET(ACRXX)=""
QUIT
+2 SET DIR(0)="SO^1:Selected Items COMPLETELY INVOICED at listed cost;2:Edit Individual Items"
+3 SET DIR("A")="Which one"
+4 WRITE !
+5 DO DIR^ACRFDIC
+6 IF 'Y
QUIT
+7 IF Y=1
DO EALL
QUIT
+8 IF Y=2
DO EDIT
+9 QUIT
S1 ;SELECT ITEM(S)
+1 IF ACRMAX=1
SET ACRY=+ACRSS0
+2 IF '$TEST
Begin DoDot:1
+3 SET DIR(0)="LOA^1:"_ACRMAX
+4 SET DIR("A")="Invoice for which items: "
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF '+Y
SET ACRQUIT=""
QUIT
End DoDot:1
+8 SET ACRXX=ACRY
+9 QUIT
EALL ;
+1 FOR ACRI=1:1
SET ACRZ=$PIECE(ACRXX,",",ACRI)
IF 'ACRZ
QUIT
IF $DATA(^TMP("ACRIV",$JOB,ACRZ))
DO ALL1
+2 QUIT
EDIT FOR ACRI=1:1
SET ACRZ=$PIECE(ACRXX,",",ACRI)
IF 'ACRZ
QUIT
IF $DATA(^TMP("ACRIV",$JOB,ACRZ))
DO IQ
+1 QUIT
IQ ;EDIT INVOICE QUANTITIES
+1 DO IDHEAD
+2 SET ACRSSDA=+^TMP("ACRIV",$JOB,ACRZ)
+3 DO IDISPLAY
+4 DO IEDIT
+5 QUIT
IEDIT SET DIR(0)="NOA^"_(ACRIVTA*-1)_":"_(ACRRRTA-ACRIVTA)_":3"
+1 SET DIR("A")="QUANTITY INVOICED: "
+2 WRITE !
+3 DO DIR^ACRFDIC
+4 IF $DATA(ACRQUIT)!$DATA(ACROUT)!'Y
QUIT
+5 SET $PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U,2)=Y+ACRIVTA
+6 IF Y>0
SET $PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U,3)=Y+$PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U,3)
+7 SET DIR(0)="NOA^0:"_($PIECE(^ACRSS(ACRSSDA,"DT"),U,3)+100)_":4"
+8 SET DIR("A")="INVOICE AMOUNT...: "
+9 SET DIR("B")=$PIECE(^ACRSS(ACRSSDA,"DT"),U,3)
+10 DO DIR^ACRFDIC
+11 IF $DATA(ACRQUIT)!$DATA(ACROUT)!'Y
QUIT
+12 SET $PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U,4)=Y
+13 QUIT
RESET ;RESET ITEM(S) TO ORIGINAL REMAINING QUANTITY
+1 DO S1
+2 IF $GET(ACRXX)=""
QUIT
+3 FOR ACRI=1:1
SET ACRZ=$PIECE(ACRXX,",",ACRI)
IF 'ACRZ
QUIT
IF $DATA(^TMP("ACRIV",$JOB,ACRZ))
SET ACRSSDA=^(ACRZ)
IF '$DATA(^TMP("ACRSYNC",$JOB,+ACRSSDA))
QUIT
SET $PIECE(^(ACRSSDA),U,3)=0
+4 QUIT
ITEMS ;DISPLAY ALL ITEMS FROM THE ORDER
+1 KILL ACRQUIT
+2 DO IDHEAD
+3 SET ACRZ=0
+4 FOR
SET ACRZ=$ORDER(^TMP("ACRIV",$JOB,ACRZ))
IF 'ACRZ!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+5 SET ACRSSDA=+^TMP("ACRIV",$JOB,ACRZ)
+6 DO INVOICE(ACRSSDA)
End DoDot:1
+7 SET ACRZ=0
+8 FOR
SET ACRZ=$ORDER(^TMP("ACRIV",$JOB,ACRZ))
IF 'ACRZ!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+9 SET ACRSSDA=+^TMP("ACRIV",$JOB,ACRZ)
+10 DO IDISPLAY
End DoDot:1
+11 KILL ACRQUIT
+12 QUIT
SS ;GATHER INVOICE FOR DATA ONE ITEM
+1 SET ACRSS0=^ACRSS(ACRSSDA,0)
+2 SET ACRSSDT=^ACRSS(ACRSSDA,"DT")
+3 SET ACRSSNMS=$GET(^ACRSS(ACRSSDA,"NMS"))
+4 SET ACRSSDSC=$GET(^ACRSS(ACRSSDA,"DESC"))
+5 SET ACRNOTES=$GET(^ACRSS(ACRSSDA,"NOTES"))
+6 SET ACRSSORD=$PIECE(ACRSSDT,U)
+7 SET ACRSSUP=$PIECE(ACRSSDT,U,3)
+8 SET ACRSST=ACRSSUP*ACRSSORD
+9 SET ACRSSACT=$GET(ACRSSACT)+ACRSSORD
+10 SET (ACRRRDA,ACRRRT,ACRIVT,ACRRRTA,ACRIVTA,ACRCOST,ACRIVUP,ACRRRUP)=0
+11 FOR
SET ACRRRDA=$ORDER(^ACRRR("B",ACRSSDA,ACRRRDA))
IF 'ACRRRDA
QUIT
Begin DoDot:1
+12 SET ACRRR0=$GET(^ACRRR(ACRRRDA,0))
+13 SET ACRRRDT=$GET(^ACRRR(ACRRRDA,"DT"))
+14 SET ACRRRACP=$PIECE(ACRRRDT,U,3)
+15 SET ACRIVACP=$PIECE(ACRRRDT,U,6)
+16 SET ACRRRUP=$PIECE(ACRRRDT,U)
+17 IF ACRRRUP=""
SET ACRRRUP=ACRSSUP
+18 SET ACRIVUP=$PIECE(ACRRRDT,U,5)
+19 SET ACRRRTA=ACRRRTA+ACRRRACP
+20 SET ACRIVTA=ACRIVTA+ACRIVACP
+21 IF ACRIVUP=""
SET ACRIVUP=ACRSSUP
+22 SET ACRRRIT=ACRRRACP*ACRRRUP
+23 IF $GET(ACRRRIT)=""
SET ACRRRIT=ACRSSIT
+24 SET ACRIVIT=ACRIVACP*ACRIVUP
+25 IF $GET(ACRIVIT)=""
SET ACRIVIT=ACRSSIT
+26 SET ACRRRT=ACRRRT+ACRRRIT
+27 SET ACRIVT=ACRIVT+ACRIVIT
End DoDot:1
+28 IF $DATA(^TMP("ACRSYNC",$JOB,ACRSSDA))
SET ACRIVTA=$PIECE(^(ACRSSDA),U,2)
+29 QUIT
INVOICE(X) ;GATHER INVOICE FOR DATA ONE ITEM
+1 SET ACRSSDA=X
+2 SET ACRSS0=^ACRSS(ACRSSDA,0)
+3 SET ACRSSDT=^ACRSS(ACRSSDA,"DT")
+4 SET ACROBJDA=$PIECE(ACRSS0,U,4)
+5 SET ACRCANDA=$PIECE(ACRSS0,U,5)
+6 SET ACRSSNMS=$GET(^ACRSS(ACRSSDA,"NMS"))
+7 SET ACRSSDSC=$GET(^ACRSS(ACRSSDA,"DESC"))
+8 SET ACRNOTES=$GET(^ACRSS(ACRSSDA,"NOTES"))
+9 SET ACRSSORD=$PIECE(ACRSSDT,U)
+10 SET ACRSSUP=$PIECE(ACRSSDT,U,3)
+11 SET ACRSST=ACRSSUP*ACRSSORD
+12 SET ACRSSACT=$GET(ACRSSACT)+ACRSSORD
+13 SET (ACRRRDA,ACRRRT,ACRIVT,ACRRRTA,ACRIVTA,ACRCOST,ACRIVUP)=0
+14 FOR
SET ACRRRDA=$ORDER(^ACRRR("B",ACRSSDA,ACRRRDA))
IF 'ACRRRDA
QUIT
Begin DoDot:1
+15 SET ACRRR0=$GET(^ACRRR(ACRRRDA,0))
+16 SET ACRRRDT=$GET(^ACRRR(ACRRRDA,"DT"))
+17 SET ACRRRACP=$PIECE(ACRRRDT,U,3)
+18 SET ACRIVACP=$PIECE(ACRRRDT,U,6)
+19 SET ACRRRUP=$PIECE(ACRRRDT,U)
+20 IF ACRRRUP=""
SET ACRRRUP=ACRSSUP
+21 SET ACRIVUP=$PIECE(ACRRRDT,U,5)
+22 SET ACRRRTA=ACRRRTA+ACRRRACP
+23 SET ACRIVTA=ACRIVTA+ACRIVACP
+24 IF ACRIVUP=""
SET ACRIVUP=ACRSSUP
+25 SET ACRRRIT=ACRRRACP*ACRRRUP
+26 IF $GET(ACRRRIT)=""
SET ACRRRIT=ACRSSIT
+27 SET ACRIVIT=ACRIVACP*ACRIVUP
+28 IF $GET(ACRIVIT)=""
SET ACRIVIT=ACRSSIT
+29 SET ACRRRT=ACRRRT+ACRRRIT
+30 SET ACRIVT=ACRIVT+ACRIVIT
End DoDot:1
+31 IF $DATA(^TMP("ACRSYNC",$JOB,ACRSSDA))
SET ACRIVTA=$PIECE(^(ACRSSDA),U,2)
+32 IF '$TEST
SET $PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U)=ACRRRTA
SET $PIECE(^(ACRSSDA),U,2)=ACRIVTA
SET $PIECE(^(ACRSSDA),U,3)=0
SET $PIECE(^(ACRSSDA),U,4)=ACRIVUP
SET $PIECE(^(ACRSSDA),U,5)=ACRIVTA
SET $PIECE(^(ACRSSDA),U,6)=ACRRRTA-ACRIVTA
+33 QUIT
IDHEAD ;INVOICE DISPLAY HEADER
+1 WRITE @IOF
+2 WRITE !?10,"PURCHASE ORDER NO.......: ",$PIECE(ACRDOC0,U,2)," ",$PIECE(ACRDOC0,U)
+3 WRITE !!,?40,"RECEIVED/",?50,"ALREADY"
+4 WRITE ?70,"REMAINING"
+5 WRITE !,"ITM"
+6 WRITE ?4,"ORDER #/DESCRIPT"
+7 WRITE ?30,"OBLIGATED"
+8 WRITE ?40,"ACCEPTED"
+9 WRITE ?50,"PAID"
+10 WRITE ?60,"THIS PMT"
+11 WRITE ?70,"TO BE PD"
+12 WRITE !,"---"
+13 WRITE ?4,"-------------------------"
+14 WRITE ?30,"---------"
+15 WRITE ?40,"---------"
+16 WRITE ?50,"---------"
+17 WRITE ?60,"---------"
+18 WRITE ?70,"---------"
+19 QUIT
IDISPLAY ;CONTROL DISPLAY OF ITEMS
+1 DO SS
+2 DO IDISP
+3 QUIT
IDISP ;DISPLAY INVOICE HISTORY FOR ITEM
+1 KILL ACR1,ACR2,ACR3
+2 WRITE !,ACRZ
+3 IF $PIECE(ACRSSNMS,U)]""
Begin DoDot:1
+4 WRITE ?4,"VON: ",$PIECE(ACRSSNMS,U)
+5 DO 1
+6 WRITE !?3
End DoDot:1
+7 IF $PIECE(ACRSSNMS,U,3)]""
Begin DoDot:1
+8 WRITE ?4,"NDC: ",$PIECE(ACRSSNMS,U,3)
+9 IF '$DATA(ACR1)
DO 1
+10 IF '$DATA(ACR2)&$DATA(ACR1)
DO 2
+11 IF '$DATA(ACR3)&$DATA(ACR1)&$DATA(ACR2)
DO 3
+12 WRITE !?3
End DoDot:1
+13 IF $PIECE(ACRSSNMS,U,2)]""
Begin DoDot:1
+14 WRITE ?4,"NSN: ",$PIECE(ACRSSNMS,U,2)
+15 IF '$DATA(ACR1)
DO 1
+16 IF '$DATA(ACR2)&$DATA(ACR1)
DO 2
+17 IF '$DATA(ACR3)&$DATA(ACR1)&$DATA(ACR2)
DO 3
+18 WRITE !?3
End DoDot:1
+19 WRITE ?4,$PIECE(ACRSSDSC,U)
+20 NEW ACRJ,ACRI,ACRX
+21 FOR ACRJ=2:1:5
IF $PIECE(ACRSSDSC,U,ACRJ)]""
SET ACRX=$PIECE(ACRSSDSC,U,ACRJ)
Begin DoDot:1
+22 FOR ACRI=1:1
SET ACRY=$PIECE(ACRX," ",ACRI)
IF ACRY=""
QUIT
Begin DoDot:2
+23 IF $X+$LENGTH(ACRY)>79
WRITE !?3
+24 WRITE ?$X+1,ACRY
End DoDot:2
End DoDot:1
+25 IF '$DATA(ACR1)
DO 1
+26 IF '$DATA(ACR2)&$DATA(ACR1)
WRITE !
DO 2
+27 IF '$DATA(ACR3)&$DATA(ACR1)&$DATA(ACR2)
WRITE !
DO 3
+28 IF $LENGTH(ACRNOTES)>4
WRITE !
+29 NEW ACRI,ACRJ,ACRX,ACRY
+30 FOR ACRJ=1:1:5
IF $PIECE(ACRNOTES,U,ACRJ)]""
SET ACRX=$PIECE(ACRNOTES,U,ACRJ)
Begin DoDot:1
+31 FOR ACRI=1:1
SET ACRY=$PIECE(ACRX," ",ACRI)
IF ACRY=""
QUIT
Begin DoDot:2
+32 IF $X+$LENGTH(ACRY)>79
WRITE !?3
+33 WRITE ?$X+1,ACRY
End DoDot:2
End DoDot:1
+34 KILL ACRSSDSC,ACRNOTES,ACRSSNMS
+35 IF '$DATA(ACR2)
DO 2
+36 IF '$DATA(ACR3)
DO 3
+37 WRITE $$DASH^ACRFMENU
+38 IF IOSL-4<$Y
Begin DoDot:1
+39 SET DIR(0)="YO"
+40 SET DIR("A")="Display Remaining Items"
+41 SET DIR("B")="YES"
+42 WRITE !
+43 DO DIR^ACRFDIC
+44 IF Y'=1
SET ACRQUIT=""
QUIT
+45 DO IDHEAD
End DoDot:1
+46 QUIT
1 NEW X
+1 SET X=^TMP("ACRSYNC",$JOB,ACRSSDA)
+2 IF $X>30
WRITE !
+3 WRITE ?30,$JUSTIFY(ACRSSORD,8)
+4 WRITE ?40,$JUSTIFY($PIECE(X,U),8)
+5 WRITE ?50,$JUSTIFY($PIECE(X,U,2),8)
+6 WRITE ?60,$JUSTIFY($PIECE(X,U,3),8)
+7 WRITE ?70,$JUSTIFY($PIECE(X,U)-$PIECE(X,U,2),8)
+8 SET ACR1=""
+9 QUIT
2 NEW X
+1 SET X=^TMP("ACRSYNC",$JOB,ACRSSDA)
+2 IF $X>15
WRITE !
+3 WRITE ?15,"UNIT PRICE:",?30,$JUSTIFY($FNUMBER(ACRSSUP,"P,",2),9)
+4 WRITE ?40,$JUSTIFY($FNUMBER(ACRRRUP,"P,",2),9)
+5 WRITE ?50,$JUSTIFY($FNUMBER($PIECE(X,U,4),"P,",2),9)
+6 SET ACR2=""
+7 QUIT
3 NEW X
+1 SET X=^TMP("ACRSYNC",$JOB,ACRSSDA)
+2 IF $X>15
WRITE !
+3 WRITE ?15,"TOTAL.....:",?28,$JUSTIFY($FNUMBER(ACRSST,"P,",2),9)
+4 WRITE ?38,$JUSTIFY($FNUMBER(ACRRRT,"P,",2),9)
+5 SET ACR3=""
+6 QUIT
SYNC ;EP - SYNCHRONIZE NEW INVOICED ITEMS
+1 KILL ACRIVPAY
+2 SET ACRSSDA=0
+3 FOR
SET ACRSSDA=$ORDER(^TMP("ACRSYNC",$JOB,ACRSSDA))
IF 'ACRSSDA
QUIT
Begin DoDot:1
+4 SET DA=$ORDER(^ACRRR("B",ACRSSDA,0))
+5 IF 'DA
QUIT
+6 SET ACRRRDA=DA
+7 SET DIE="^ACRRR("
+8 SET DR="6////"_$PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U,2)_";5////"_$PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U,4)
+9 DO DIE^ACRFDIC
+10 FOR
SET ACRRRDA=$ORDER(^ACRRR("B",ACRSSDA,ACRRRDA))
IF 'ACRRRDA
QUIT
Begin DoDot:2
+11 SET DA=ACRRRDA
+12 SET DIE="^ACRRR("
+13 SET DR="6////0"
+14 IF $PIECE($GET(^ACRRR(ACRRRDA,"DT")),U,6)
DO DIE^ACRFDIC
End DoDot:2
+15 DO PAY
End DoDot:1
+16 KILL ^TMP("ACRSYNC",$JOB)
+17 QUIT
PAY IF '$PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U,3)
KILL ^TMP("ACRSYNC",$JOB,ACRSSDA)
QUIT
+1 SET ACRCANDA=$PIECE(^ACRSS(ACRSSDA,0),U,5)
+2 SET ACROBJDA=$PIECE(^ACRSS(ACRSSDA,0),U,4)
+3 SET ACRIVPAY(ACRCANDA,ACROBJDA)=$GET(ACRIVPAY(ACRCANDA,ACROBJDA))+($PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U,3)*$PIECE(^TMP("ACRSYNC",$JOB,ACRSSDA),U,4))
+4 QUIT
+5 NEW ACRSSDA,X,Y,Z,J
+6 SET (ACRSSDA,ACRMAX,J)=0
+7 FOR
SET ACRSSDA=$ORDER(^ACRSS("J",ACRDOCDA,ACRSSDA))
IF 'ACRSSDA
QUIT
Begin DoDot:1
+8 SET ACRX=+^ACRSS(ACRSSDA,0)
+9 SET J=J+1
+10 IF ACRX'=J
Begin DoDot:2
+11 SET DA=ACRSSDA
+12 SET DIE="^ACRSS("
+13 SET DR=".01///^S X=J"
+14 DO DIE^ACRFDIC
+15 SET ACRX=J
End DoDot:2
+16 IF $DATA(^ACRRR("B",ACRSSDA))
SET ^TMP("ACRIV",$JOB,ACRX)=ACRSSDA
SET ACRMAX=ACRMAX+1
End DoDot:1
+17 QUIT
