- 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