ACRFCCP1 ;IHS/OIRM/DSD/THL,AEF - CREDIT CARD PURCHASE MANAGEMENT REPORTS - CONT; [ 09/23/2005 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
;;ROUTINE TO PRINT THE CREDIT CARD REPORT
PRINT ;EP;TO PRINT CREDIT CARD REPORT
D CH
S ACRX=""
F S ACRX=$O(^TMP("ACRD",$J,35,ACRX)) Q:ACRX=""!$D(ACRQUIT) D
.S (ACR(ACRX),ACRDUZ,ACRT,ACRP)=0
.F S ACRDUZ=$O(^TMP("ACRD",$J,35,ACRX,ACRDUZ)) Q:'ACRDUZ!$D(ACRQUIT) D P1
.D:$D(ACRBYCAN) CANTOT
Q
P1 D H1
S (ACRTOTAL,ACRTOTPD)=0,ACRDOC=""
F S ACRDOC=$O(^TMP("ACRD",$J,35,ACRX,ACRDUZ,ACRDOC)) Q:ACRDOC=""!$D(ACRQUIT) D
.S ACRDOCDA=^TMP("ACRD",$J,35,ACRX,ACRDUZ,ACRDOC)
.S ACRDOC0=^ACRDOC(ACRDOCDA,0),ACRREQ=^ACRDOC(ACRDOCDA,"REQ"),ACRREQ2=$G(^ACRDOC(ACRDOCDA,"REQ2")),ACRPO=^ACRDOC(ACRDOCDA,"PO")
.S ACRDATE=$P(ACRREQ,U,11)
.D P11
;I ACRDUZ'=99999999 S X=$P(^VA(200,ACRDUZ,0),U) ;ACR*2.1*19.02 IM16848
I ACRDUZ'=99999999 S X=$$NAME2^ACRFUTL1(ACRDUZ) ;ACR*2.1*19.02 IM16848
E S X="NOT STATED,CARDHOLDER"
D DASH
W !?20,"TOTAL CREDIT CARD PURCHASES FOR: "
W $P($P(X,",",2)," ")," ",$P(X,",")
W ?90,$J($FN(ACRTOTAL,"P",2),12)
W ?113,$J($FN(ACRTOTPD,"P",2),12)
I ACRT'=ACRTOTAL D
.D DASH
.W !?20,"TOTAL OF ALL CREDIT CARD PURCHASES:"
.W ?90,$J($FN(ACRT,"P",2),12)
.W ?113,$J($FN(ACRP,"P",2),12)
D PAUSE^ACRFWARN
W @IOF
Q
P11 ;
K DXS,DIP,DC
S D0=$P(ACRPO,U,5)
D HEAD
D ^ACRPCCV
K DXS,DIP,DC
S (ACRSSDA,ACRTOT,ACRTOTP,ACRI)=0
F S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA!$D(ACRQUIT) D
.S ACRI=ACRI+1
.D ITEM
.D HEAD:$O(^ACRSS("J",ACRDOCDA,ACRSSDA))
I ACRI>1 D
.W !?90,"-----------"
.W ?113,"-----------"
.W !?20,"TOTAL FOR ",$P(ACRDOC0,U)
.W ?90,$J($FN(ACRTOT,"P",2),12)
.W ?113,$J($FN(ACRTOTP,"P",2),12)
D DASH:$O(^TMP("ACRD",$J,35,ACRX,ACRDUZ,ACRDOC))]""
D HEAD
Q
HEAD I IOSL-4<$Y D HEAD1
Q
HEAD1 ;
D PAUSE^ACRFWARN
H1 Q:$D(ACRQUIT)
W @IOF
W !,"RECORD OF CREDIT CARD ORDERS"
W ?55,"FROM......: "
S Y=ACRBEGIN
X ^DD("DD")
;I ACRDUZ'=99999999 S X=$P(^VA(200,ACRDUZ,0),U) ;ACR*2.1*19.02 IM16848
I ACRDUZ'=99999999 S X=$$NAME2^ACRFUTL1(ACRDUZ) ;ACR*2.1*19.02 IM16848
E S X="NOT STATED,CARDHOLDER"
W Y
W !,"CARDHOLDER: ",$P($P(X,",",2)," ")," ",$P(X,",")
W ?55,"TO........: "
S Y=ACREND
X ^DD("DD")
W Y
D DASH
D ^ACRPCCH
Q
ITEM ;PRINT EACH ITEM
N X,Y,Z
S X=^ACRSS(ACRSSDA,0),Y=^ACRSS(ACRSSDA,"DT"),Z=$G(^ACRSS(ACRSSDA,"DESC"))
S ACRCAN=$P(^AUTTCAN($P(X,U,5),0),U)
S ACROBJ=$P(^AUTTOBJC($P(X,U,4),0),U)
S ACRUI=$P(Y,U,2)
S ACRUI=$S($D(^ACRUI(+ACRUI,0)):$P(^(0),U),1:"**")
S ACRQUAN=$P(Y,U)
S ACRUC=$P(Y,U,3)
S ACRTP=$P(Y,U,4)
S ACRRCD=$P(Y,U,11)
S ACRPAID=$P(Y,U,21)
S ACRTOT=ACRTOT+ACRTP
S ACRTOTAL=ACRTOTAL+ACRTP
S ACRTOTP=ACRTOTP+ACRPAID
S ACRTOTPD=ACRTOTPD+ACRPAID
S ACRT=ACRT+ACRTP
S ACRP=ACRP+ACRPAID
S $P(ACR(ACRX),U)=$P(ACR(ACRX),U)+ACRTP
S $P(ACR(ACRX),U,2)=$P(ACR(ACRX),U,2)+ACRPAID
I ACRI=1 D I 1
.S Y=ACRDATE
.X ^DD("DD")
.W !,Y
.W !,$P(ACRDOC0,U)
E W !
W ?16,$P(Z,U)
W ?48,ACRCAN
W ?57,ACROBJ
W ?63,$J(ACRQUAN,6)
W ?71,ACRUI
W ?78,$J($FN(ACRUC,"P",2),11)
W ?90,$J($FN(ACRTP,"P",2),12)
W ?103,ACRRCD
W ?113,$J($FN(ACRPAID,"P",2),12)
F ACRJ=2:1:5 I $P(Z,U,ACRJ)]"" W !?16,$P(Z,U,ACRJ) D HEAD
Q
CH ;SET ARRAY FOR ALL CARD HOLDERS
K ^TMP("ACRD",$J)
S ACRDOCDA=0
F S ACRDOCDA=$O(^ACRDOC("D",35,ACRDOCDA)) Q:'ACRDOCDA!$D(ACRQUIT) D
.S ACRDOC0=$G(^ACRDOC(ACRDOCDA,0)),ACRREQ=$G(^ACRDOC(ACRDOCDA,"REQ")),ACRREQ2=$G(^ACRDOC(ACRDOCDA,"REQ2")),ACRPO=$G(^ACRDOC(ACRDOCDA,"PO"))
.S ACRDATE=$P(ACRREQ,U,11)
.S ACRAPV=$P($G(^ACROBL(ACRDOCDA,"APV")),U)
.D:ACRAPV="A"
..I ACRDUZ,ACRDUZ'=$P(ACRDOC0,U,25) Q
..I ACRBEGIN,ACRDATE<ACRBEGIN Q
..I ACREND,ACRDATE>ACREND Q
..Q:'$P(ACRPO,U,5)
..K ACRCAN
..I '$D(ACRBYCAN) S ACRCAN="ACRCAN"
..I $D(ACRBYCAN) D Q:'$D(ACRCAN)
...S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,0))
...Q:'ACRSSDA
...Q:'$D(^ACRSS(ACRSSDA,0))
...S ACRCANDA=$P(^ACRSS(ACRSSDA,0),U,5)
...Q:'ACRCANDA
...Q:'$D(^AUTTCAN(ACRCANDA,0)) S ACRCAN=$P(^(0),U)
..S ^TMP("ACRD",$J,35,ACRCAN,$S($P(ACRDOC0,U,25):$P(ACRDOC0,U,25),1:99999999),$P(ACRDOC0,U))=ACRDOCDA
Q
CANTOT ;PRINT TOTAL FOR EACH CAN
W !!?20,"TOTAL CREDIT CARD PURCHASES FOR CAN NO.: ",ACRX
W ?90,$J($FN($P(ACR(ACRX),U),"P",2),12)
W ?113,$J($FN($P(ACR(ACRX),U,2),"P",2),12)
D PAUSE^ACRFWARN
Q
DASH W !
N I
F I=1:1:132 W "-"
Q
ACRFCCP1 ;IHS/OIRM/DSD/THL,AEF - CREDIT CARD PURCHASE MANAGEMENT REPORTS - CONT; [ 09/23/2005 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
+2 ;;ROUTINE TO PRINT THE CREDIT CARD REPORT
PRINT ;EP;TO PRINT CREDIT CARD REPORT
+1 DO CH
+2 SET ACRX=""
+3 FOR
SET ACRX=$ORDER(^TMP("ACRD",$JOB,35,ACRX))
IF ACRX=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+4 SET (ACR(ACRX),ACRDUZ,ACRT,ACRP)=0
+5 FOR
SET ACRDUZ=$ORDER(^TMP("ACRD",$JOB,35,ACRX,ACRDUZ))
IF 'ACRDUZ!$DATA(ACRQUIT)
QUIT
DO P1
+6 IF $DATA(ACRBYCAN)
DO CANTOT
End DoDot:1
+7 QUIT
P1 DO H1
+1 SET (ACRTOTAL,ACRTOTPD)=0
SET ACRDOC=""
+2 FOR
SET ACRDOC=$ORDER(^TMP("ACRD",$JOB,35,ACRX,ACRDUZ,ACRDOC))
IF ACRDOC=""!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+3 SET ACRDOCDA=^TMP("ACRD",$JOB,35,ACRX,ACRDUZ,ACRDOC)
+4 SET ACRDOC0=^ACRDOC(ACRDOCDA,0)
SET ACRREQ=^ACRDOC(ACRDOCDA,"REQ")
SET ACRREQ2=$GET(^ACRDOC(ACRDOCDA,"REQ2"))
SET ACRPO=^ACRDOC(ACRDOCDA,"PO")
+5 SET ACRDATE=$PIECE(ACRREQ,U,11)
+6 DO P11
End DoDot:1
+7 ;I ACRDUZ'=99999999 S X=$P(^VA(200,ACRDUZ,0),U) ;ACR*2.1*19.02 IM16848
+8 ;ACR*2.1*19.02 IM16848
IF ACRDUZ'=99999999
SET X=$$NAME2^ACRFUTL1(ACRDUZ)
+9 IF '$TEST
SET X="NOT STATED,CARDHOLDER"
+10 DO DASH
+11 WRITE !?20,"TOTAL CREDIT CARD PURCHASES FOR: "
+12 WRITE $PIECE($PIECE(X,",",2)," ")," ",$PIECE(X,",")
+13 WRITE ?90,$JUSTIFY($FNUMBER(ACRTOTAL,"P",2),12)
+14 WRITE ?113,$JUSTIFY($FNUMBER(ACRTOTPD,"P",2),12)
+15 IF ACRT'=ACRTOTAL
Begin DoDot:1
+16 DO DASH
+17 WRITE !?20,"TOTAL OF ALL CREDIT CARD PURCHASES:"
+18 WRITE ?90,$JUSTIFY($FNUMBER(ACRT,"P",2),12)
+19 WRITE ?113,$JUSTIFY($FNUMBER(ACRP,"P",2),12)
End DoDot:1
+20 DO PAUSE^ACRFWARN
+21 WRITE @IOF
+22 QUIT
P11 ;
+1 KILL DXS,DIP,DC
+2 SET D0=$PIECE(ACRPO,U,5)
+3 DO HEAD
+4 DO ^ACRPCCV
+5 KILL DXS,DIP,DC
+6 SET (ACRSSDA,ACRTOT,ACRTOTP,ACRI)=0
+7 FOR
SET ACRSSDA=$ORDER(^ACRSS("J",ACRDOCDA,ACRSSDA))
IF 'ACRSSDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+8 SET ACRI=ACRI+1
+9 DO ITEM
+10 IF $ORDER(^ACRSS("J",ACRDOCDA,ACRSSDA))
DO HEAD
End DoDot:1
+11 IF ACRI>1
Begin DoDot:1
+12 WRITE !?90,"-----------"
+13 WRITE ?113,"-----------"
+14 WRITE !?20,"TOTAL FOR ",$PIECE(ACRDOC0,U)
+15 WRITE ?90,$JUSTIFY($FNUMBER(ACRTOT,"P",2),12)
+16 WRITE ?113,$JUSTIFY($FNUMBER(ACRTOTP,"P",2),12)
End DoDot:1
+17 IF $ORDER(^TMP("ACRD",$JOB,35,ACRX,ACRDUZ,ACRDOC))]""
DO DASH
+18 DO HEAD
+19 QUIT
HEAD IF IOSL-4<$Y
DO HEAD1
+1 QUIT
HEAD1 ;
+1 DO PAUSE^ACRFWARN
H1 IF $DATA(ACRQUIT)
QUIT
+1 WRITE @IOF
+2 WRITE !,"RECORD OF CREDIT CARD ORDERS"
+3 WRITE ?55,"FROM......: "
+4 SET Y=ACRBEGIN
+5 XECUTE ^DD("DD")
+6 ;I ACRDUZ'=99999999 S X=$P(^VA(200,ACRDUZ,0),U) ;ACR*2.1*19.02 IM16848
+7 ;ACR*2.1*19.02 IM16848
IF ACRDUZ'=99999999
SET X=$$NAME2^ACRFUTL1(ACRDUZ)
+8 IF '$TEST
SET X="NOT STATED,CARDHOLDER"
+9 WRITE Y
+10 WRITE !,"CARDHOLDER: ",$PIECE($PIECE(X,",",2)," ")," ",$PIECE(X,",")
+11 WRITE ?55,"TO........: "
+12 SET Y=ACREND
+13 XECUTE ^DD("DD")
+14 WRITE Y
+15 DO DASH
+16 DO ^ACRPCCH
+17 QUIT
ITEM ;PRINT EACH ITEM
+1 NEW X,Y,Z
+2 SET X=^ACRSS(ACRSSDA,0)
SET Y=^ACRSS(ACRSSDA,"DT")
SET Z=$GET(^ACRSS(ACRSSDA,"DESC"))
+3 SET ACRCAN=$PIECE(^AUTTCAN($PIECE(X,U,5),0),U)
+4 SET ACROBJ=$PIECE(^AUTTOBJC($PIECE(X,U,4),0),U)
+5 SET ACRUI=$PIECE(Y,U,2)
+6 SET ACRUI=$SELECT($DATA(^ACRUI(+ACRUI,0)):$PIECE(^(0),U),1:"**")
+7 SET ACRQUAN=$PIECE(Y,U)
+8 SET ACRUC=$PIECE(Y,U,3)
+9 SET ACRTP=$PIECE(Y,U,4)
+10 SET ACRRCD=$PIECE(Y,U,11)
+11 SET ACRPAID=$PIECE(Y,U,21)
+12 SET ACRTOT=ACRTOT+ACRTP
+13 SET ACRTOTAL=ACRTOTAL+ACRTP
+14 SET ACRTOTP=ACRTOTP+ACRPAID
+15 SET ACRTOTPD=ACRTOTPD+ACRPAID
+16 SET ACRT=ACRT+ACRTP
+17 SET ACRP=ACRP+ACRPAID
+18 SET $PIECE(ACR(ACRX),U)=$PIECE(ACR(ACRX),U)+ACRTP
+19 SET $PIECE(ACR(ACRX),U,2)=$PIECE(ACR(ACRX),U,2)+ACRPAID
+20 IF ACRI=1
Begin DoDot:1
+21 SET Y=ACRDATE
+22 XECUTE ^DD("DD")
+23 WRITE !,Y
+24 WRITE !,$PIECE(ACRDOC0,U)
End DoDot:1
IF 1
+25 IF '$TEST
WRITE !
+26 WRITE ?16,$PIECE(Z,U)
+27 WRITE ?48,ACRCAN
+28 WRITE ?57,ACROBJ
+29 WRITE ?63,$JUSTIFY(ACRQUAN,6)
+30 WRITE ?71,ACRUI
+31 WRITE ?78,$JUSTIFY($FNUMBER(ACRUC,"P",2),11)
+32 WRITE ?90,$JUSTIFY($FNUMBER(ACRTP,"P",2),12)
+33 WRITE ?103,ACRRCD
+34 WRITE ?113,$JUSTIFY($FNUMBER(ACRPAID,"P",2),12)
+35 FOR ACRJ=2:1:5
IF $PIECE(Z,U,ACRJ)]""
WRITE !?16,$PIECE(Z,U,ACRJ)
DO HEAD
+36 QUIT
CH ;SET ARRAY FOR ALL CARD HOLDERS
+1 KILL ^TMP("ACRD",$JOB)
+2 SET ACRDOCDA=0
+3 FOR
SET ACRDOCDA=$ORDER(^ACRDOC("D",35,ACRDOCDA))
IF 'ACRDOCDA!$DATA(ACRQUIT)
QUIT
Begin DoDot:1
+4 SET ACRDOC0=$GET(^ACRDOC(ACRDOCDA,0))
SET ACRREQ=$GET(^ACRDOC(ACRDOCDA,"REQ"))
SET ACRREQ2=$GET(^ACRDOC(ACRDOCDA,"REQ2"))
SET ACRPO=$GET(^ACRDOC(ACRDOCDA,"PO"))
+5 SET ACRDATE=$PIECE(ACRREQ,U,11)
+6 SET ACRAPV=$PIECE($GET(^ACROBL(ACRDOCDA,"APV")),U)
+7 IF ACRAPV="A"
Begin DoDot:2
+8 IF ACRDUZ
IF ACRDUZ'=$PIECE(ACRDOC0,U,25)
QUIT
+9 IF ACRBEGIN
IF ACRDATE<ACRBEGIN
QUIT
+10 IF ACREND
IF ACRDATE>ACREND
QUIT
+11 IF '$PIECE(ACRPO,U,5)
QUIT
+12 KILL ACRCAN
+13 IF '$DATA(ACRBYCAN)
SET ACRCAN="ACRCAN"
+14 IF $DATA(ACRBYCAN)
Begin DoDot:3
+15 SET ACRSSDA=$ORDER(^ACRSS("J",ACRDOCDA,0))
+16 IF 'ACRSSDA
QUIT
+17 IF '$DATA(^ACRSS(ACRSSDA,0))
QUIT
+18 SET ACRCANDA=$PIECE(^ACRSS(ACRSSDA,0),U,5)
+19 IF 'ACRCANDA
QUIT
+20 IF '$DATA(^AUTTCAN(ACRCANDA,0))
QUIT
SET ACRCAN=$PIECE(^(0),U)
End DoDot:3
IF '$DATA(ACRCAN)
QUIT
+21 SET ^TMP("ACRD",$JOB,35,ACRCAN,$SELECT($PIECE(ACRDOC0,U,25):$PIECE(ACRDOC0,U,25),1:99999999),$PIECE(ACRDOC0,U))=ACRDOCDA
End DoDot:2
End DoDot:1
+22 QUIT
CANTOT ;PRINT TOTAL FOR EACH CAN
+1 WRITE !!?20,"TOTAL CREDIT CARD PURCHASES FOR CAN NO.: ",ACRX
+2 WRITE ?90,$JUSTIFY($FNUMBER($PIECE(ACR(ACRX),U),"P",2),12)
+3 WRITE ?113,$JUSTIFY($FNUMBER($PIECE(ACR(ACRX),U,2),"P",2),12)
+4 DO PAUSE^ACRFWARN
+5 QUIT
DASH WRITE !
+1 NEW I
+2 FOR I=1:1:132
WRITE "-"
+3 QUIT
