- 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
