1 | RCRCAT1 ;ALB/CMS - AR/RC SEND AR TRANSACTION TO RC ;10/3/97 2:46 PM
|
---|
2 | V ;;4.5;Accounts Receivable;**63**;Mar 20, 1995
|
---|
3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | Q
|
---|
5 | ;
|
---|
6 | EN ;ENTRY POINT FROM RCRCAT
|
---|
7 | ;INPUT: PRCABN
|
---|
8 | ;OUTPUT:PRCABN,RCOUT,^TMP("RCRCAT",$J,"XM",PRCABN,PRCAEN)
|
---|
9 | N DIR,CNT,RCY,PRCA,PRCAT,PRCAEN,RCREF,RCST,SKIP,X,Y
|
---|
10 | S (RCST,RCOUT)=0
|
---|
11 | I '$D(^PRCA(430,+$G(PRCABN),0)) G ENQ
|
---|
12 | K ^TMP("RCRCAT",$J,"XM",PRCABN)
|
---|
13 | D BNVAR^RCRCUTL(PRCABN)
|
---|
14 | D DEBT^RCRCUTL(PRCABN)
|
---|
15 | S RCREF=$$REFST^RCRCUTL(PRCABN)
|
---|
16 | D HD
|
---|
17 | I '$O(^PRCA(433,"C",PRCABN,0)) D
|
---|
18 | . S X="",$P(X,"*",20)="" W !!,X," NO TRANSACTION INFORMATION AVAILABLE ",X
|
---|
19 | RD . R !!,"Press return to continue: ",X:DTIME S:('$T)!(X="^") RCOUT=1
|
---|
20 | . I X["?" W !!,"Press the return key to return to menu." G RD
|
---|
21 | . Q
|
---|
22 | I RCOUT=1 G ENQ
|
---|
23 | LOP S (PRCAEN,CNT)=0 F S PRCAEN=$O(^PRCA(433,"C",PRCABN,PRCAEN)) Q:('PRCAEN)!($G(RCOUT))!($G(SKIP)) D
|
---|
24 | .I ($Y+3)>IOSL,CNT D ASK Q:($G(SKIP))!($G(RCOUT)) D HD
|
---|
25 | .S X=$G(^PRCA(433,PRCAEN,1))
|
---|
26 | .Q:'X
|
---|
27 | .S CNT=CNT+1,PRCAT(CNT)=PRCAEN
|
---|
28 | .W !,CNT,". ",$S($P(^PRCA(433,PRCAEN,0),"^",4)=1!$P(^(0),"^",10):"(I)",1:""),?8,PRCAEN
|
---|
29 | .W ?17,$S($P($G(^PRCA(430.3,+$P(X,"^",2),0)),"^",3)=17:$P($G(^PRCA(433,PRCAEN,5)),"^",2),1:$P($G(^(0)),"^"))
|
---|
30 | .W ?52 S Y=+X I Y D D^DIQ W Y
|
---|
31 | .W ?65,$J($P(X,"^",5),9,2)
|
---|
32 | D ASK
|
---|
33 | I $G(RCST)=1 G ENQ
|
---|
34 | I '$O(^TMP("RCRCAT",$J,"XM",PRCABN,0)),'$G(RCOUT) D TRP I $G(RCST)=1 K SKIP,RCOUT,PRCAT D HD,LOP
|
---|
35 | ENQ Q
|
---|
36 | ;
|
---|
37 | ASK ;Ask user to select Tran from list
|
---|
38 | N DIR,DTOUT,DUOUT,DIRUT,DIROUT,PRCAEN1,RCI,RCY,SEL,X,Y S RCOUT=0
|
---|
39 | W ! S DIR("?")="Enter the list number(s) of the transaction(s) to be sent to RC"
|
---|
40 | I PRCAEN S DIR("A",1)="Press enter to continue list or "
|
---|
41 | S DIR(0)="LO^1:"_CNT,DIR("A")="Select Item #(s) to Transmit " D ^DIR
|
---|
42 | I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G ASKQ
|
---|
43 | I 'Y G ASKQ
|
---|
44 | S RCY=$G(Y)
|
---|
45 | F RCI=1:1:255 S SEL=$P(RCY,",",RCI) Q:'SEL D
|
---|
46 | .S PRCAEN=+$G(PRCAT(SEL)) D SET
|
---|
47 | ASKQ Q
|
---|
48 | ;
|
---|
49 | TRP ;Display Transaction Profile
|
---|
50 | N DIR,DTOUT,DUOUT,DIRUT,DIROUT,D0,RCI,RCY,PRCA,PRCABN,PRCAEN,PRCAIO,SEL,X,Y
|
---|
51 | W ! S DIR("A")="Do you want to see a Transaction Profile ",RCOUT=0
|
---|
52 | S DIR("?")="Enter Yes if you want to see a Transaction Profile "
|
---|
53 | D ASK^RCRCACP
|
---|
54 | I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G TRPQ
|
---|
55 | I $G(Y)'=1 G TRPQ
|
---|
56 | ;
|
---|
57 | K DIR W ! S DIR("?")="Enter the list number(s) of the transactions"
|
---|
58 | S DIR(0)="LO^1:"_CNT,DIR("A")="Select Item #(s) to View Transaction Profile " D ^DIR
|
---|
59 | I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G TRPQ
|
---|
60 | I 'Y G TRPQ
|
---|
61 | S RCY=Y,PRCAIO=IO,PRCAIO(0)=IO(0)
|
---|
62 | F RCI=1:1:255 S SEL=$P(RCY,",",RCI) Q:('SEL)!(X["^") S D0=PRCAT(SEL) D
|
---|
63 | .W @IOF S X="",$P(X,"=",30)="" W !,X," TRANSACTION PROFILE ",X,!!
|
---|
64 | .K DXS D ^PRCATR3 K DXS S X=D0 D ENF^IBOLK
|
---|
65 | .R !!,"PRESS <RETURN> TO CONTINUE: ",X:DTIME Q:X["^"
|
---|
66 | ;
|
---|
67 | S DIR("A")="Do you want to view list again ",RCST=0
|
---|
68 | S DIR("?")="Enter yes to see the list of Transactions again"
|
---|
69 | D ASK^RCRCACP I $G(Y)=1 S RCST=1 W @IOF
|
---|
70 | I $D(DTOUT)!$D(DUOUT)!$D(DIROUT) S RCOUT=1 G TRPQ
|
---|
71 | TRPQ Q
|
---|
72 | ;
|
---|
73 | SET ;Set the global to send AR Transaction via mail
|
---|
74 | ;Also called from RCRCRT
|
---|
75 | ;Input: PRCABN,PRCAEN,RCXCNT,PRCA("BNAME"),PRCA("DEBTNM")
|
---|
76 | ;Return: TMP("RCRCAT",$J,"XM",PRCABN,PRCAEN,RCXCNT)="DATA"
|
---|
77 | ;
|
---|
78 | N CT,DA,DIC,DIQ,DR,PRCAEN1,RC,RCFL,RCLN,RCLN2,RCTR,X,Y
|
---|
79 | S DA=PRCAEN,DR=".01:90",DIC="^PRCA(433,",DIQ="RCTR",DIQ(0)="EN" D EN^DIQ1
|
---|
80 | S PRCAEN1=$G(^PRCA(433,+$G(PRCAEN),1))
|
---|
81 | I ('PRCAEN1)!('$O(RCTR(0))) G SETQ
|
---|
82 | S CT=+$G(RCXCNT)
|
---|
83 | S CT=CT+1,RC(CT)="BN1^"_PRCA("BNAME")_U_PRCA("DEBTNM")
|
---|
84 | S CT=CT+1,RC(CT)="TR1^"_PRCAEN_U_$P(PRCAEN1,U,9)
|
---|
85 | S CT=CT+1,RC(CT)=" <TRANSACTION INFORMATION>"
|
---|
86 | S CT=CT+1,RC(CT)="BILL #: "_PRCA("BNAME")_" DEBTOR: "_PRCA("DEBTNM")
|
---|
87 | S CT=CT+1,RC(CT)="TYPE: "_$G(RCTR(433,PRCAEN,12,"E"),"UNK")_" TRAN. NO.: "_$G(RCTR(433,PRCAEN,.01,"E"))
|
---|
88 | S CT=CT+1,RC(CT)="DATE: "_$G(RCTR(433,PRCAEN,11,"E"))_" AMOUNT: $"_$J($G(RCTR(433,PRCAEN,15,"E")),2)
|
---|
89 | S CT=CT+1,RC(CT)="STATUS: "_$G(RCTR(433,PRCAEN,4,"E"))_" CREATED: "_$G(RCTR(433,PRCAEN,19,"E"))
|
---|
90 | S CT=CT+1,RC(CT)=" <OTHER TRANSACTION INFORMATION>"
|
---|
91 | F X=.01,.03,3,4,5,6,8,10,11,12,14,15,19 K RCTR(433,PRCAEN,X)
|
---|
92 | S RCFL=0,RCLN2="" F S RCFL=$O(RCTR(433,PRCAEN,RCFL)) Q:'RCFL D
|
---|
93 | .I (RCFL=41)!(RCFL=5.02)!(RCFL=5.03) S Y="COM" Q
|
---|
94 | .S RCLN=$$GET1^DID(433,RCFL,"","LABEL")_": "_RCTR(433,PRCAEN,RCFL,"E")_" "
|
---|
95 | .I ($L(RCLN)+$L(RCLN2)+3)>80 S CT=CT+1,RC(CT)=RCLN2,RCLN2=RCLN Q
|
---|
96 | .S RCLN2=RCLN2_RCLN
|
---|
97 | I 'RCFL,RCLN2]"" S CT=CT+1,RC(CT)=RCLN2
|
---|
98 | I $G(Y)="COM" D
|
---|
99 | .S CT=CT+1,RC(CT)=" <TRANSACTION COMMENT INFORMATION>"
|
---|
100 | .S CT=CT+1,RC(CT)="BRIEF COMMENT: "_$G(RCTR(433,PRCAEN,5.02,"E"),"None")
|
---|
101 | .S CT=CT+1,RC(CT)="FOLLOW-UP DATE: "_$G(RCTR(433,PRCAEN,5.03,"E"),"None")
|
---|
102 | .S CT=CT+1,RC(CT)="COMMENT: "
|
---|
103 | .S X=0 F S X=$O(RCTR(433,PRCAEN,41,X)) Q:'X D
|
---|
104 | ..S CT=CT+1,RC(CT)=RCTR(433,PRCAEN,41,X)
|
---|
105 | S RCXCNT=CT
|
---|
106 | M ^TMP("RCRCAT",$J,"XM",PRCABN,PRCAEN)=RC
|
---|
107 | SETQ Q
|
---|
108 | ;
|
---|
109 | HD ;Write Heading
|
---|
110 | N I,Y
|
---|
111 | W @IOF,!,PRCA("DEBTNM"),!,PRCA("DEBTAD1")
|
---|
112 | W:$G(PRCA("DEBTAD2"))]"" !,PRCA("DEBTAD2")
|
---|
113 | W !,PRCA("DEBTCT"),", ",PRCA("DEBTST")," ",PRCA("DEBTZIP")
|
---|
114 | W !,"Phone #: ",$P(PRCA("DEBTADD"),U,7)
|
---|
115 | W !!,"Bill #: ",PRCA("BNAME")
|
---|
116 | S Y=$P(RCREF,U,1) I Y D D^DIQ
|
---|
117 | W:+RCREF ?30,"Referred to ",$P(RCREF,U,2)," on ",Y," for $",$P(RCREF,U,3)
|
---|
118 | W !!,"Item",?8,"TR #",?17,"Tran. Type",?52,"Date",?68,"Amount"
|
---|
119 | W ! F I=1:1:(IOM-1) W "="
|
---|
120 | HDQ Q
|
---|
121 | ;RCRCAT1
|
---|