Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACRFCCP1

ACRFCCP1.m

Go to the documentation of this file.
  1. 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
  1. ;;ROUTINE TO PRINT THE CREDIT CARD REPORT
  1. PRINT ;EP;TO PRINT CREDIT CARD REPORT
  1. D CH
  1. S ACRX=""
  1. F S ACRX=$O(^TMP("ACRD",$J,35,ACRX)) Q:ACRX=""!$D(ACRQUIT) D
  1. .S (ACR(ACRX),ACRDUZ,ACRT,ACRP)=0
  1. .F S ACRDUZ=$O(^TMP("ACRD",$J,35,ACRX,ACRDUZ)) Q:'ACRDUZ!$D(ACRQUIT) D P1
  1. .D:$D(ACRBYCAN) CANTOT
  1. Q
  1. P1 D H1
  1. S (ACRTOTAL,ACRTOTPD)=0,ACRDOC=""
  1. F S ACRDOC=$O(^TMP("ACRD",$J,35,ACRX,ACRDUZ,ACRDOC)) Q:ACRDOC=""!$D(ACRQUIT) D
  1. .S ACRDOCDA=^TMP("ACRD",$J,35,ACRX,ACRDUZ,ACRDOC)
  1. .S ACRDOC0=^ACRDOC(ACRDOCDA,0),ACRREQ=^ACRDOC(ACRDOCDA,"REQ"),ACRREQ2=$G(^ACRDOC(ACRDOCDA,"REQ2")),ACRPO=^ACRDOC(ACRDOCDA,"PO")
  1. .S ACRDATE=$P(ACRREQ,U,11)
  1. .D P11
  1. ;I ACRDUZ'=99999999 S X=$P(^VA(200,ACRDUZ,0),U) ;ACR*2.1*19.02 IM16848
  1. I ACRDUZ'=99999999 S X=$$NAME2^ACRFUTL1(ACRDUZ) ;ACR*2.1*19.02 IM16848
  1. E S X="NOT STATED,CARDHOLDER"
  1. D DASH
  1. W !?20,"TOTAL CREDIT CARD PURCHASES FOR: "
  1. W $P($P(X,",",2)," ")," ",$P(X,",")
  1. W ?90,$J($FN(ACRTOTAL,"P",2),12)
  1. W ?113,$J($FN(ACRTOTPD,"P",2),12)
  1. I ACRT'=ACRTOTAL D
  1. .D DASH
  1. .W !?20,"TOTAL OF ALL CREDIT CARD PURCHASES:"
  1. .W ?90,$J($FN(ACRT,"P",2),12)
  1. .W ?113,$J($FN(ACRP,"P",2),12)
  1. D PAUSE^ACRFWARN
  1. W @IOF
  1. Q
  1. P11 ;
  1. K DXS,DIP,DC
  1. S D0=$P(ACRPO,U,5)
  1. D HEAD
  1. D ^ACRPCCV
  1. K DXS,DIP,DC
  1. S (ACRSSDA,ACRTOT,ACRTOTP,ACRI)=0
  1. F S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,ACRSSDA)) Q:'ACRSSDA!$D(ACRQUIT) D
  1. .S ACRI=ACRI+1
  1. .D ITEM
  1. .D HEAD:$O(^ACRSS("J",ACRDOCDA,ACRSSDA))
  1. I ACRI>1 D
  1. .W !?90,"-----------"
  1. .W ?113,"-----------"
  1. .W !?20,"TOTAL FOR ",$P(ACRDOC0,U)
  1. .W ?90,$J($FN(ACRTOT,"P",2),12)
  1. .W ?113,$J($FN(ACRTOTP,"P",2),12)
  1. D DASH:$O(^TMP("ACRD",$J,35,ACRX,ACRDUZ,ACRDOC))]""
  1. D HEAD
  1. Q
  1. Q
  1. HEAD1 ;
  1. D PAUSE^ACRFWARN
  1. H1 Q:$D(ACRQUIT)
  1. W @IOF
  1. W !,"RECORD OF CREDIT CARD ORDERS"
  1. W ?55,"FROM......: "
  1. S Y=ACRBEGIN
  1. X ^DD("DD")
  1. ;I ACRDUZ'=99999999 S X=$P(^VA(200,ACRDUZ,0),U) ;ACR*2.1*19.02 IM16848
  1. I ACRDUZ'=99999999 S X=$$NAME2^ACRFUTL1(ACRDUZ) ;ACR*2.1*19.02 IM16848
  1. E S X="NOT STATED,CARDHOLDER"
  1. W Y
  1. W !,"CARDHOLDER: ",$P($P(X,",",2)," ")," ",$P(X,",")
  1. W ?55,"TO........: "
  1. S Y=ACREND
  1. X ^DD("DD")
  1. W Y
  1. D DASH
  1. D ^ACRPCCH
  1. Q
  1. ITEM ;PRINT EACH ITEM
  1. N X,Y,Z
  1. S X=^ACRSS(ACRSSDA,0),Y=^ACRSS(ACRSSDA,"DT"),Z=$G(^ACRSS(ACRSSDA,"DESC"))
  1. S ACRCAN=$P(^AUTTCAN($P(X,U,5),0),U)
  1. S ACROBJ=$P(^AUTTOBJC($P(X,U,4),0),U)
  1. S ACRUI=$P(Y,U,2)
  1. S ACRUI=$S($D(^ACRUI(+ACRUI,0)):$P(^(0),U),1:"**")
  1. S ACRQUAN=$P(Y,U)
  1. S ACRUC=$P(Y,U,3)
  1. S ACRTP=$P(Y,U,4)
  1. S ACRRCD=$P(Y,U,11)
  1. S ACRPAID=$P(Y,U,21)
  1. S ACRTOT=ACRTOT+ACRTP
  1. S ACRTOTAL=ACRTOTAL+ACRTP
  1. S ACRTOTP=ACRTOTP+ACRPAID
  1. S ACRTOTPD=ACRTOTPD+ACRPAID
  1. S ACRT=ACRT+ACRTP
  1. S ACRP=ACRP+ACRPAID
  1. S $P(ACR(ACRX),U)=$P(ACR(ACRX),U)+ACRTP
  1. S $P(ACR(ACRX),U,2)=$P(ACR(ACRX),U,2)+ACRPAID
  1. I ACRI=1 D I 1
  1. .S Y=ACRDATE
  1. .X ^DD("DD")
  1. .W !,Y
  1. .W !,$P(ACRDOC0,U)
  1. E W !
  1. W ?16,$P(Z,U)
  1. W ?48,ACRCAN
  1. W ?57,ACROBJ
  1. W ?63,$J(ACRQUAN,6)
  1. W ?71,ACRUI
  1. W ?78,$J($FN(ACRUC,"P",2),11)
  1. W ?90,$J($FN(ACRTP,"P",2),12)
  1. W ?103,ACRRCD
  1. W ?113,$J($FN(ACRPAID,"P",2),12)
  1. F ACRJ=2:1:5 I $P(Z,U,ACRJ)]"" W !?16,$P(Z,U,ACRJ) D HEAD
  1. Q
  1. CH ;SET ARRAY FOR ALL CARD HOLDERS
  1. K ^TMP("ACRD",$J)
  1. S ACRDOCDA=0
  1. F S ACRDOCDA=$O(^ACRDOC("D",35,ACRDOCDA)) Q:'ACRDOCDA!$D(ACRQUIT) D
  1. .S ACRDOC0=$G(^ACRDOC(ACRDOCDA,0)),ACRREQ=$G(^ACRDOC(ACRDOCDA,"REQ")),ACRREQ2=$G(^ACRDOC(ACRDOCDA,"REQ2")),ACRPO=$G(^ACRDOC(ACRDOCDA,"PO"))
  1. .S ACRDATE=$P(ACRREQ,U,11)
  1. .S ACRAPV=$P($G(^ACROBL(ACRDOCDA,"APV")),U)
  1. .D:ACRAPV="A"
  1. ..I ACRDUZ,ACRDUZ'=$P(ACRDOC0,U,25) Q
  1. ..I ACRBEGIN,ACRDATE<ACRBEGIN Q
  1. ..I ACREND,ACRDATE>ACREND Q
  1. ..Q:'$P(ACRPO,U,5)
  1. ..K ACRCAN
  1. ..I '$D(ACRBYCAN) S ACRCAN="ACRCAN"
  1. ..I $D(ACRBYCAN) D Q:'$D(ACRCAN)
  1. ...S ACRSSDA=$O(^ACRSS("J",ACRDOCDA,0))
  1. ...Q:'ACRSSDA
  1. ...Q:'$D(^ACRSS(ACRSSDA,0))
  1. ...S ACRCANDA=$P(^ACRSS(ACRSSDA,0),U,5)
  1. ...Q:'ACRCANDA
  1. ...Q:'$D(^AUTTCAN(ACRCANDA,0)) S ACRCAN=$P(^(0),U)
  1. ..S ^TMP("ACRD",$J,35,ACRCAN,$S($P(ACRDOC0,U,25):$P(ACRDOC0,U,25),1:99999999),$P(ACRDOC0,U))=ACRDOCDA
  1. Q
  1. CANTOT ;PRINT TOTAL FOR EACH CAN
  1. W !!?20,"TOTAL CREDIT CARD PURCHASES FOR CAN NO.: ",ACRX
  1. W ?90,$J($FN($P(ACR(ACRX),U),"P",2),12)
  1. W ?113,$J($FN($P(ACR(ACRX),U,2),"P",2),12)
  1. D PAUSE^ACRFWARN
  1. Q
  1. DASH W !
  1. N I
  1. F I=1:1:132 W "-"
  1. Q