- RCCPCSE ;WASH-ISC@ALTOONA,PA/LDB - CCPC Statements Errors;5/30/96 10:20 AM ;10/16/96 8:42 AM
- V ;;4.5;Accounts Receivable;**34**;Mar 20, 1995;
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- K ^TMP($J)
- N ADD,DIR,DIRUT,ERR,ERROR,HDR,LINE,LN,PG,POP,PT,X,X1,Y,%ZIS,Z,ZTRTN,ZTDESC
- I '$O(^RCPS(349.2,"AD","E",0)) W !,"THERE ARE NO CCPC STATEMENT ERRORS" Q
- E W !,"CCPC STATEMENTS ERROR REPORT"
- D HOME^%ZIS S %ZIS="QN" D ^%ZIS Q:POP
- I $D(IO("Q")) D Q
- .S ZTRTN="SORT^RCCPCSE",ZTDESC="CCPC PATIENT STATEMENT ERROR REPORT"
- .D ^%ZTLOAD
- 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
- .S HDR="CCPC PATIENT STATEMENT ERROR REPORT",LINE="",$P(LINE,"=",IOM)="",PG=1
- .S ERR=$G(^RCPS(349.2,+PT,5))
- .S ^TMP($J,"ERR",PT)=$P(^RCPS(349.2,+PT,0),"^",3)_"^"_$P(^(0),"^",2)
- .S ADD=$G(^RCPS(349.2,+PT,1))
- .F X=1:1:6 S ADD(X)=$P(ADD,"^",X),^TMP($J,"ERR",PT,1+X)=ADD(X)
- .F X=1:5 S X1=X+4,ERROR=$E(ERR,X,X1) Q:ERROR="" D
- ..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
- ;
- K ADD
- W:IOST?1"C-".E @IOF W !,?25,HDR,?75,PG,!,LINE
- PRNT K DIRUT S PT=0 F S PT=$O(^TMP($J,"ERR",PT)) Q:'PT Q:$D(DIRUT) D
- .I ($Y+12)>IOSL D
- ..I IOST?1"C-".E S DIR(0)="E" D ^DIR Q:$D(DIRUT)
- ..W @IOF,HDR,?75,PG S PG=PG+1
- .Q:$D(DIRUT) W !!,$E($P(^TMP($J,"ERR",+PT),"^"),1,25),?37,"ERROR CODES",!,$P(^(PT),"^",2),?37,$E(LINE,1,11)
- .F X=2:1:4 S:$G(^TMP($J,"ERR",PT,X))]"" ADD(X)=^(X)
- .S ADD(5)=$G(^TMP($J,"ERR",PT,5))_", "_$G(^(6))_" "_$G(^(7))
- .S X=7 F S X=$O(^TMP($J,"ERR",PT,X)) Q:'X S ERR(X-1)=^(X)
- .S (Z,Y)=0 F D Q:Y=""&(Z="")
- ..W !
- ..I Z'="" S Z=$O(ADD(Z)) I Z'="",(ADD(Z)]"") W ADD(Z)
- ..I Y'="" S Y=$O(ERR(Y)) I Y'="" W ?30,$P(ERR(Y),"^"),?40,$P(ERR(Y),"^",2)
- .W !,LINE
- K ^TMP($J)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCCPCSE 1905 printed Feb 18, 2025@23:09:37 Page 2
- RCCPCSE ;WASH-ISC@ALTOONA,PA/LDB - CCPC Statements Errors;5/30/96 10:20 AM ;10/16/96 8:42 AM
- V ;;4.5;Accounts Receivable;**34**;Mar 20, 1995;
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;
- +3 KILL ^TMP($JOB)
- +4 NEW ADD,DIR,DIRUT,ERR,ERROR,HDR,LINE,LN,PG,POP,PT,X,X1,Y,%ZIS,Z,ZTRTN,ZTDESC
- +5 IF '$ORDER(^RCPS(349.2,"AD","E",0))
- WRITE !,"THERE ARE NO CCPC STATEMENT ERRORS"
- QUIT
- +6 IF '$TEST
- WRITE !,"CCPC STATEMENTS ERROR REPORT"
- +7 DO HOME^%ZIS
- SET %ZIS="QN"
- DO ^%ZIS
- if POP
- QUIT
- +8 IF $DATA(IO("Q"))
- Begin DoDot:1
- +9 SET ZTRTN="SORT^RCCPCSE"
- SET ZTDESC="CCPC PATIENT STATEMENT ERROR REPORT"
- +10 DO ^%ZTLOAD
- End DoDot:1
- QUIT
- SORT SET (LN,PT)=0
- FOR
- SET PT=$ORDER(^RCPS(349.2,"AD","E",PT))
- if 'PT
- QUIT
- IF $GET(^RCPS(349.2,+PT,5))]""
- Begin DoDot:1
- +1 SET HDR="CCPC PATIENT STATEMENT ERROR REPORT"
- SET LINE=""
- SET $PIECE(LINE,"=",IOM)=""
- SET PG=1
- +2 SET ERR=$GET(^RCPS(349.2,+PT,5))
- +3 SET ^TMP($JOB,"ERR",PT)=$PIECE(^RCPS(349.2,+PT,0),"^",3)_"^"_$PIECE(^(0),"^",2)
- +4 SET ADD=$GET(^RCPS(349.2,+PT,1))
- +5 FOR X=1:1:6
- SET ADD(X)=$PIECE(ADD,"^",X)
- SET ^TMP($JOB,"ERR",PT,1+X)=ADD(X)
- +6 FOR X=1:5
- SET X1=X+4
- SET ERROR=$EXTRACT(ERR,X,X1)
- if ERROR=""
- QUIT
- Begin DoDot:2
- +7 SET ^TMP($JOB,"ERR",PT,X+10)=ERROR
- SET ERROR=$ORDER(^RCPSE(349.7,"B",$EXTRACT(ERROR,1,5),""))
- SET ERROR=$PIECE($GET(^RCPSE(349.7,+ERROR,0)),"^",4)
- SET ^TMP($JOB,"ERR",PT,X+10)=^TMP($JOB,"ERR",PT,X+10)_"^"_ERROR
- End DoDot:2
- End DoDot:1
- +8 ;
- +9 KILL ADD
- +10 if IOST?1"C-".E
- WRITE @IOF
- WRITE !,?25,HDR,?75,PG,!,LINE
- PRNT KILL DIRUT
- SET PT=0
- FOR
- SET PT=$ORDER(^TMP($JOB,"ERR",PT))
- if 'PT
- QUIT
- if $DATA(DIRUT)
- QUIT
- Begin DoDot:1
- +1 IF ($Y+12)>IOSL
- Begin DoDot:2
- +2 IF IOST?1"C-".E
- SET DIR(0)="E"
- DO ^DIR
- if $DATA(DIRUT)
- QUIT
- +3 WRITE @IOF,HDR,?75,PG
- SET PG=PG+1
- End DoDot:2
- +4 if $DATA(DIRUT)
- QUIT
- WRITE !!,$EXTRACT($PIECE(^TMP($JOB,"ERR",+PT),"^"),1,25),?37,"ERROR CODES",!,$PIECE(^(PT),"^",2),?37,$EXTRACT(LINE,1,11)
- +5 FOR X=2:1:4
- if $GET(^TMP($JOB,"ERR",PT,X))]""
- SET ADD(X)=^(X)
- +6 SET ADD(5)=$GET(^TMP($JOB,"ERR",PT,5))_", "_$GET(^(6))_" "_$GET(^(7))
- +7 SET X=7
- FOR
- SET X=$ORDER(^TMP($JOB,"ERR",PT,X))
- if 'X
- QUIT
- SET ERR(X-1)=^(X)
- +8 SET (Z,Y)=0
- FOR
- Begin DoDot:2
- +9 WRITE !
- +10 IF Z'=""
- SET Z=$ORDER(ADD(Z))
- IF Z'=""
- IF (ADD(Z)]"")
- WRITE ADD(Z)
- +11 IF Y'=""
- SET Y=$ORDER(ERR(Y))
- IF Y'=""
- WRITE ?30,$PIECE(ERR(Y),"^"),?40,$PIECE(ERR(Y),"^",2)
- End DoDot:2
- if Y=""&(Z="")
- QUIT
- +12 WRITE !,LINE
- End DoDot:1
- +13 KILL ^TMP($JOB)
- +14 QUIT