| [613] | 1 | RCCPCSE ;WASH-ISC@ALTOONA,PA/LDB - CCPC Statements Errors;5/30/96 10:20 AM ;10/16/96 8:42 AM
|
|---|
| 2 | V ;;4.5;Accounts Receivable;**34**;Mar 20, 1995;
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | K ^TMP($J)
|
|---|
| 6 | N ADD,DIR,DIRUT,ERR,ERROR,HDR,LINE,LN,PG,POP,PT,X,X1,Y,%ZIS,Z,ZTRTN,ZTDESC
|
|---|
| 7 | I '$O(^RCPS(349.2,"AD","E",0)) W !,"THERE ARE NO CCPC STATEMENT ERRORS" Q
|
|---|
| 8 | E W !,"CCPC STATEMENTS ERROR REPORT"
|
|---|
| 9 | D HOME^%ZIS S %ZIS="QN" D ^%ZIS Q:POP
|
|---|
| 10 | I $D(IO("Q")) D Q
|
|---|
| 11 | .S ZTRTN="SORT^RCCPCSE",ZTDESC="CCPC PATIENT STATEMENT ERROR REPORT"
|
|---|
| 12 | .D ^%ZTLOAD
|
|---|
| 13 | SORT S (LN,PT)=0 F S PT=$O(^RCPS(349.2,"AD","E",PT)) Q:'PT I $G(^RCPS(349.2,+PT,5))]"" D
|
|---|
| 14 | .S HDR="CCPC PATIENT STATEMENT ERROR REPORT",LINE="",$P(LINE,"=",IOM)="",PG=1
|
|---|
| 15 | .S ERR=$G(^RCPS(349.2,+PT,5))
|
|---|
| 16 | .S ^TMP($J,"ERR",PT)=$P(^RCPS(349.2,+PT,0),"^",3)_"^"_$P(^(0),"^",2)
|
|---|
| 17 | .S ADD=$G(^RCPS(349.2,+PT,1))
|
|---|
| 18 | .F X=1:1:6 S ADD(X)=$P(ADD,"^",X),^TMP($J,"ERR",PT,1+X)=ADD(X)
|
|---|
| 19 | .F X=1:5 S X1=X+4,ERROR=$E(ERR,X,X1) Q:ERROR="" D
|
|---|
| 20 | ..S ^TMP($J,"ERR",PT,X+10)=ERROR,ERROR=$O(^RCPSE(349.7,"B",$E(ERROR,1,5),"")),ERROR=$P($G(^RCPSE(349.7,+ERROR,0)),"^",4),^TMP($J,"ERR",PT,X+10)=^TMP($J,"ERR",PT,X+10)_"^"_ERROR
|
|---|
| 21 | ;
|
|---|
| 22 | K ADD
|
|---|
| 23 | W:IOST?1"C-".E @IOF W !,?25,HDR,?75,PG,!,LINE
|
|---|
| 24 | PRNT K DIRUT S PT=0 F S PT=$O(^TMP($J,"ERR",PT)) Q:'PT Q:$D(DIRUT) D
|
|---|
| 25 | .I ($Y+12)>IOSL D
|
|---|
| 26 | ..I IOST?1"C-".E S DIR(0)="E" D ^DIR Q:$D(DIRUT)
|
|---|
| 27 | ..W @IOF,HDR,?75,PG S PG=PG+1
|
|---|
| 28 | .Q:$D(DIRUT) W !!,$E($P(^TMP($J,"ERR",+PT),"^"),1,25),?37,"ERROR CODES",!,$P(^(PT),"^",2),?37,$E(LINE,1,11)
|
|---|
| 29 | .F X=2:1:4 S:$G(^TMP($J,"ERR",PT,X))]"" ADD(X)=^(X)
|
|---|
| 30 | .S ADD(5)=$G(^TMP($J,"ERR",PT,5))_", "_$G(^(6))_" "_$G(^(7))
|
|---|
| 31 | .S X=7 F S X=$O(^TMP($J,"ERR",PT,X)) Q:'X S ERR(X-1)=^(X)
|
|---|
| 32 | .S (Z,Y)=0 F D Q:Y=""&(Z="")
|
|---|
| 33 | ..W !
|
|---|
| 34 | ..I Z'="" S Z=$O(ADD(Z)) I Z'="",(ADD(Z)]"") W ADD(Z)
|
|---|
| 35 | ..I Y'="" S Y=$O(ERR(Y)) I Y'="" W ?30,$P(ERR(Y),"^"),?40,$P(ERR(Y),"^",2)
|
|---|
| 36 | .W !,LINE
|
|---|
| 37 | K ^TMP($J)
|
|---|
| 38 | Q
|
|---|
