BARMPAS5 ;IHS/SD/PKD - Patient Account Statement ;
;;1.8;IHS ACCOUNTS RECEIVABLE;**23**;OCT 26, 2005
;P.OTT NEW ROUTINE APR 2013 CALLED FROM BARFX001
;re-indexing old staments in ^XTMP('BARPAS' is needed
;due to PAS sorting introduced in P23
;
Q
FIXPAS ;
L +^TMP($J,"BARPAS_REINDEX"):600
I '$T W !,"Cannot get lock on ^TMP($J,'BARPAS_REINDEX') - cannot reindex." Q
S BARCNT=0
S BARFILE="BARPAS" F S BARFILE=$O(^XTMP(BARFILE)) Q:BARFILE="" Q:BARFILE'["BARPAS" D
. S BARCNT=BARCNT+1 W !,BARCNT,". ",BARFILE
. S BARSRTBY=$G(^XTMP(BARFILE,0,"SORTBY"),-1)
. I BARSRTBY<0 D REINDEX(BARFILE) Q
. I BARSRTBY>1 D DELETE(BARFILE) Q
. W " file is ok - no re-indexing needed"
L -^TMP($J,"BARPAS_REINDEX")
Q
REINDEX(BARFILE) ;
D DOIT
Q
DOIT ;
K ^TMP($J,"BARPAS_REINDEX")
L +^XTMP(BARFILE):360 E W !,"CANNOT GET LOCK OF ^XTMP(",BARFILE QUIT
W !,"FILE ",BARFILE," WILL BE NOW RE-INDEXED"
M ^TMP($J,"BARPAS_REINDEX",BARFILE,0)=^XTMP(BARFILE,0)
S BARLOC=0 F S BARLOC=$O(^XTMP(BARFILE,BARLOC)) Q:+BARLOC=0 D
. M ^TMP($J,"BARPAS_REINDEX",BARFILE,BARLOC,0,"BARFILE")=^XTMP(BARFILE,BARLOC)
. ;;;M ^TMP($J,"BARPAS_REINDEX",BARFILE,BARLOC)=^XTMP(BARFILE,BARLOC)
S ^TMP($J,"BARPAS_REINDEX",BARFILE,0,"SORTBY")=0
S ^TMP($J,"BARPAS_REINDEX",BARFILE,0,"REINDEXED")=$H
K ^XTMP(BARFILE)
M ^XTMP(BARFILE)=^TMP($J,"BARPAS_REINDEX",BARFILE)
K ^TMP($J,"BARPAS_REINDEX",BARFILE)
L -^XTMP(BARFILE)
W " .... DONE"
Q
DELETE(BARFILE) ;
W !,"FILE ",BARFILE," WILL BE REMOVED. HAS INVALID SORTING ORDER: ",BARSRTBY
K ^XTMP(BARFILE)
Q
TEST ;TEST - NO RE-NDEXING
W !,"THIS IS A TEST RUN TO SIMULATE RE-IDEXING."
W !,"NO CHANGES IN ^XTMP WILL BE DONE."
S BARCNT=0
S BARFILE="BARPAS" F S BARFILE=$O(^XTMP(BARFILE)) Q:BARFILE="" Q:BARFILE'["BARPAS" D
. S BARCNT=BARCNT+1 W !,BARCNT,". ",BARFILE
. S BARSRTBY=$G(^XTMP(BARFILE,0,"SORTBY"),-1) ;P.OTT
. I BARSRTBY<0 D Q
. . W !,"FILE ",BARFILE," SHOULD BE NOW RE-INDEXED" ;R ASD
. I BARSRTBY>1 D Q
. . W !,"FILE ",BARFILE," SHOULD BE NOW RE-INDEXED" ;R ASD
. W " NO ADJUSTMENT NEEDED"
W !,"ALL DONE"
Q
BARMPAS5 ;IHS/SD/PKD - Patient Account Statement ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**23**;OCT 26, 2005
+2 ;P.OTT NEW ROUTINE APR 2013 CALLED FROM BARFX001
+3 ;re-indexing old staments in ^XTMP('BARPAS' is needed
+4 ;due to PAS sorting introduced in P23
+5 ;
+6 QUIT
FIXPAS ;
+1 LOCK +^TMP($JOB,"BARPAS_REINDEX"):600
+2 IF '$TEST
WRITE !,"Cannot get lock on ^TMP($J,'BARPAS_REINDEX') - cannot reindex."
QUIT
+3 SET BARCNT=0
+4 SET BARFILE="BARPAS"
FOR
SET BARFILE=$ORDER(^XTMP(BARFILE))
IF BARFILE=""
QUIT
IF BARFILE'["BARPAS"
QUIT
Begin DoDot:1
+5 SET BARCNT=BARCNT+1
WRITE !,BARCNT,". ",BARFILE
+6 SET BARSRTBY=$GET(^XTMP(BARFILE,0,"SORTBY"),-1)
+7 IF BARSRTBY<0
DO REINDEX(BARFILE)
QUIT
+8 IF BARSRTBY>1
DO DELETE(BARFILE)
QUIT
+9 WRITE " file is ok - no re-indexing needed"
End DoDot:1
+10 LOCK -^TMP($JOB,"BARPAS_REINDEX")
+11 QUIT
REINDEX(BARFILE) ;
+1 DO DOIT
+2 QUIT
DOIT ;
+1 KILL ^TMP($JOB,"BARPAS_REINDEX")
+2 LOCK +^XTMP(BARFILE):360
IF '$TEST
WRITE !,"CANNOT GET LOCK OF ^XTMP(",BARFILE
QUIT
+3 WRITE !,"FILE ",BARFILE," WILL BE NOW RE-INDEXED"
+4 MERGE ^TMP($JOB,"BARPAS_REINDEX",BARFILE,0)=^XTMP(BARFILE,0)
+5 SET BARLOC=0
FOR
SET BARLOC=$ORDER(^XTMP(BARFILE,BARLOC))
IF +BARLOC=0
QUIT
Begin DoDot:1
+6 MERGE ^TMP($JOB,"BARPAS_REINDEX",BARFILE,BARLOC,0,"BARFILE")=^XTMP(BARFILE,BARLOC)
+7 ;;;M ^TMP($J,"BARPAS_REINDEX",BARFILE,BARLOC)=^XTMP(BARFILE,BARLOC)
End DoDot:1
+8 SET ^TMP($JOB,"BARPAS_REINDEX",BARFILE,0,"SORTBY")=0
+9 SET ^TMP($JOB,"BARPAS_REINDEX",BARFILE,0,"REINDEXED")=$HOROLOG
+10 KILL ^XTMP(BARFILE)
+11 MERGE ^XTMP(BARFILE)=^TMP($JOB,"BARPAS_REINDEX",BARFILE)
+12 KILL ^TMP($JOB,"BARPAS_REINDEX",BARFILE)
+13 LOCK -^XTMP(BARFILE)
+14 WRITE " .... DONE"
+15 QUIT
DELETE(BARFILE) ;
+1 WRITE !,"FILE ",BARFILE," WILL BE REMOVED. HAS INVALID SORTING ORDER: ",BARSRTBY
+2 KILL ^XTMP(BARFILE)
+3 QUIT
TEST ;TEST - NO RE-NDEXING
+1 WRITE !,"THIS IS A TEST RUN TO SIMULATE RE-IDEXING."
+2 WRITE !,"NO CHANGES IN ^XTMP WILL BE DONE."
+3 SET BARCNT=0
+4 SET BARFILE="BARPAS"
FOR
SET BARFILE=$ORDER(^XTMP(BARFILE))
IF BARFILE=""
QUIT
IF BARFILE'["BARPAS"
QUIT
Begin DoDot:1
+5 SET BARCNT=BARCNT+1
WRITE !,BARCNT,". ",BARFILE
+6 ;P.OTT
SET BARSRTBY=$GET(^XTMP(BARFILE,0,"SORTBY"),-1)
+7 IF BARSRTBY<0
Begin DoDot:2
+8 ;R ASD
WRITE !,"FILE ",BARFILE," SHOULD BE NOW RE-INDEXED"
End DoDot:2
QUIT
+9 IF BARSRTBY>1
Begin DoDot:2
+10 ;R ASD
WRITE !,"FILE ",BARFILE," SHOULD BE NOW RE-INDEXED"
End DoDot:2
QUIT
+11 WRITE " NO ADJUSTMENT NEEDED"
End DoDot:1
+12 WRITE !,"ALL DONE"
+13 QUIT
