- 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
