Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BARMPAS

BARMPAS.m

Go to the documentation of this file. 
  1. BARMPAS ; IHS/SD/LSL - Patient Account Statement ;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;**2,4,5,19,20,23,24**;OCT 26, 2005;Build 69
  1.  ;
  1.  ; IHS/SD/LSL - 04/22/03 - V1.7 Patch 2
  1.  ; IHS/SD/LSL - 12/04/04 - V17 Patch 4 - IM11692
  1.  ;      Modify code to allow tasked option to catch all facilities.
  1.  ; IHS/SD/LSL - 02/11/04 - V1.7 Patch 5 - IM12222
  1.  ;      Modify MARKACC to allow marking of patient's registered
  1.  ;      at the parents satellite. 
  1.  ; IHS/SD/POTT HEAT80718 ADDED SORTING OPTION BY PATNAME ;BAR1.8*23
  1.  ; IHS/SD/POTT HEAT95153 BAR1.8*23
  1.  ; IHS/SD/POTT HEAT63286 added call to populate array BARPSAT ;BAR1.8*23
  1.  ; IHS/SD/POTT HEAT91646 added OPTION 'PUR' & 'REB' ;BAR1.8*23
  1.  ; IHS/SD/POTT HEAT106730 BAR1.8*23
  1.  ; IHS/SD/POTT HEAT152220 2/11/2014 FIX PRO PRINT AND CLEANUP ;BAR1.8*24
  1.  ; IHS/SD/POTT HEAT100207 FIXED AGE 2/18/2014 ;BAR1.8*24
  1.  ; ********************************************************************
  1.  Q
  1. TASK ; EP
  1.  ; Called from SCHEDULED OPTION BAR MAN ACCOUNT STATEMENT
  1.  ; Start with last run date and go to Today.
  1.  ; Find BAR ACCOUNT STATEMENT in Option Scheduling File
  1.  N BARXXX
  1.  D INIT^BARUTL
  1.  S BARXXX=$$GETX() ;
  1.  I BARXXX<0 QUIT
  1.  S BARSRTBY=$$GETSRTBY() ;GET SORT-BY
  1.  D INITXTMP(BARXXX,BARDTB,BARDTE,BARSRTBY,BARRUNDT) ;;BAR1.8*23
  1.  D BARPSAT^BARUTL0 ;;BAR1.8*23 HEAT #63286  added call to populate array BARPSAT
  1.  S BARHOLD=DUZ(2)
  1.  S DUZ(2)=0 F  S DUZ(2)=$O(^BARAC(DUZ(2))) Q:'+DUZ(2)  D
  1.  . S BARACDA=0 F  S BARACDA=$O(^BARAC(DUZ(2),"PAS","Y",BARACDA)) Q:'BARACDA  D ACCOUNT(BARACDA)
  1.  S DUZ(2)=BARHOLD
  1.  D MAIL^XBMAIL("BARZ MANAGER","MAIL^BARMPAS")
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. GETX() ;
  1.  K DIC,DR,DIE,DA
  1.  S DIC=19.2                                    ; Option Scheduling File
  1.  S X="BAR ACCOUNT STATEMENT"
  1.  S DIC(0)="ZM"
  1.  D ^DIC
  1.  I Y<1 Q -1  ;NO SETUP
  1.  S BARSCHED=+Y                                 ; Option IEN
  1.  S BARFREQ=$$GET1^DIQ(19.2,BARSCHED,6)         ; Option schedule freq
  1.  S X1=DT
  1.  S X2=-90
  1.  D C^%DTC
  1.  F  S X=$$SCH^XLFDT(BARFREQ,X) Q:X>DT  S BARDTB=X  ;Last run date
  1.  S BARDTE=DT                                    ; Today
  1.  D NOW^%DTC
  1.  S BARRUNDT=%
  1.  S X1=DT
  1.  S X2=+15
  1.  D C^%DTC
  1.  Q X
  1. ACCOUNT(BARACDA) ;
  1.  ; Find Bills where the AR Account is marked for
  1.  ; Patient Account Statement
  1.  ;D INIT^BARUTL  ; this keeps it from printing to a slave printer
  1.  S (BARBL,BARTOT,BARVISL,BARDOSV)=0
  1.  D BARPSAT^BARUTL0 ;;BAR1.8*23 HEAT63286 16-MAR-2012 added call to populate array BARPSAT
  1.  S BARPATNM=$$PATNAME(BARACDA)   ;BAR1.8*23
  1.  I BARSRTBY=0 S BARPATNM="X" ;NOT SORTED BY NAMES - CREATE DUMMY NAME BAR1.8*23
  1.  F  S BARBL=$O(^BARBL(DUZ(2),"ABAL",BARACDA,BARBL)) Q:'+BARBL  D
  1.  . S BARBAL=$$GET1^DIQ(90050.01,BARBL,15)  ;CURRENT BILL AMOUNT
  1.  . Q:BARBAL'>0
  1.  . S BARVISL=$$GET1^DIQ(90050.01,BARBL,108)  ; VisitLoc
  1.  . I BARVISL="" S BARVISL=BARPSAT(DUZ(2),.01)  ; if not listed, default to DUZ(2)
  1.  . S BARDOSV=$P(^BARBL(DUZ(2),BARBL,1),U,2)  ; DOS - VA format
  1.  . I BARVISL="" S BARVISL="??"
  1.  . I BARDOSV="" S BARDOSV="??"
  1.  . S BARTOT=BARTOT+BARBAL
  1.  . S ^XTMP("BARPAS"_BARRUNDT,DUZ(2),1,BARPATNM,BARACDA,"OB",BARBL)="" ;NODE 1 FOR 'OB'
  1.  . S ^XTMP("BARPAS"_BARRUNDT,DUZ(2),1,BARPATNM,BARACDA,BARVISL,BARDOSV,"OB",BARBL)="" ;NODE 1 FOR 'OB'
  1.  . S ^XTMP("BARPAS"_BARRUNDT,DUZ(2),0,BARPATNM,BARACDA,BARVISL,BARDOSV,BARBL,"A")=""
  1.  ; 
  1.  S ^XTMP("BARPAS"_BARRUNDT,DUZ(2),1,BARPATNM,BARACDA,"OB")=BARTOT
  1.  ;
  1.  ;   It currently kills all previous entries if the Balance = 0
  1.  I BARTOT=0 K ^XTMP("BARPAS"_BARRUNDT,DUZ(2),0,BARPATNM,BARACDA)
  1.  ; -------------------------------------------------------------------------
  1.  ; Find bills by patient balance
  1.  ; -------------------------------------------------------------------------
  1.  S BARPAT=$$GET1^DIQ(90050.02,BARACDA,1.001)
  1.  S BARBL=0 F  S BARBL=$O(^BARBL(DUZ(2),"APBAL",BARPAT,BARBL)) Q:'+BARBL  D
  1.  . ; Add sorts:  VisitLocation and DOS
  1.  . S BARVISL=$$GET1^DIQ(90050.01,BARBL,108)  ; VisitLoc
  1.  . I BARVISL="" S BARVISL=BARPSAT(DUZ(2),.01)  ; if not listed, default to DUZ(2)
  1.  . S BARDOSV=$P(^BARBL(DUZ(2),BARBL,1),U,2)  ; DOS
  1.  . S ^XTMP("BARPAS"_BARRUNDT,DUZ(2),0,BARPATNM,BARACDA,BARVISL,BARDOSV,BARBL,"P")=""
  1.  . Q
  1.  ; -------------------------------------------------------------------------
  1.  ; Find bills by patient
  1.  ; -------------------------------------------------------------------------
  1.  S BARBL=0 F  S BARBL=$O(^BARBL(DUZ(2),"C",BARPAT,BARBL)) Q:'+BARBL  D
  1.  . S BARBAL=$$GET1^DIQ(90050.01,BARBL,15)
  1.  . Q:BARBAL'>0
  1.  . ; IHS/SD/PKD 1.8*19 9/10/10
  1.  . ; Add sorts:  VisitLocation and DOS
  1.  . S BARVISL=$$GET1^DIQ(90050.01,BARBL,108)  ; VisitLoc
  1.  . I BARVISL="" S BARVISL=BARPSAT(DUZ(2),.01)  ; if not listed, default to DUZ(2)
  1.  . S BARDOSV=$P(^BARBL(DUZ(2),BARBL,1),U,2)  ; DOS
  1.  . ;STANDARD SORTING (NO PATNAME)
  1.  . I BARVISL="" S BARVISL="??"
  1.  . I BARDOSV="" S BARDOSV="??"
  1.  . S ^XTMP("BARPAS"_BARRUNDT,DUZ(2),0,BARPATNM,BARACDA,BARVISL,BARDOSV,BARBL,"P")=""
  1.  . D ABAL(BARBL)
  1.  ;
  1.  ; -------------------------------------------------------------------------
  1.  ; Find bills by transaction
  1.  ; -------------------------------------------------------------------------
  1.  S BARTR=BARDTB
  1.  F  S BARTR=$O(^BARTR(DUZ(2),"AE",BARACDA,BARTR)) Q:BARTR\1>BARDTE  Q:'+BARTR  D
  1.  . S BARBL=$$GET1^DIQ(90050.03,BARTR,4,"I")
  1.  . Q:'+BARBL                                   ; No bill on transaction
  1.  . ; IHS/SD/PKD 1.8*19 9/10/10
  1.  . ; Add sorts:  VisitLocation and DOS
  1.  . S BARVISL=$$GET1^DIQ(90050.01,BARBL,108)  ; VisitLoc
  1.  . I BARVISL="" S BARVISL=BARPSAT(DUZ(2),.01)  ; if not listed, default to DUZ(2)
  1.  . S BARDOSV=$P(^BARBL(DUZ(2),BARBL,1),U,2)  ; DOS
  1.  . ;STANDARD SORTING (NO PATNAME)
  1.  . I BARVISL="" S BARVISL="??"
  1.  . I BARDOSV="" S BARDOSV="??"
  1.  . S ^XTMP("BARPAS"_BARRUNDT,DUZ(2),0,BARPATNM,BARACDA,BARVISL,BARDOSV,BARBL,"T")=""
  1.  . D ABAL(BARBL)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. MAIL ; EP - MAIL MESSAGE TEXT
  1.  ;;A/R ACCOUNTS (PATIENTS) MONTHLY STATEMENTS
  1.  ;;This is to notify you that an automatic generation
  1.  ;;of statements for A/R Patient Accounts has completed.
  1.  ;;..
  1.  ;;Please use the Print Patient Account Statement option
  1.  ;;to print the statements to a printer.
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. MANUAL ; EP
  1.  ; Called from Print Adhoc Patient Account Statement AR Menu Option
  1.  ; Ask user to select AR Account marked for Patient Account Statement
  1.  D ASKACCT                     ; Ask AR Account
  1.  Q:Y'>0
  1.  Q:'$D(BARACDA)                ; No acct selected
  1.  D DATE(1)                     ; Ask date range AND init ^XTMP
  1.  I +BARDTB<1 Q                 ; Dates answered wrong
  1.  D GETHDR^BARMPAS3             ; MOVED INTO LOOP
  1.  Q:'$D(BARHDRDA)
  1.  S BARQ("RC")="LOOP^BARMPAS"   ; Build tmp global with data
  1.  S BARQ("RP")="PRINT^BARMPAS3,CLEANUP^BARMPAS" ;HEAT#152220 BAR1.8*24
  1.  S BARQ("NS")="BAR"            ; Namespace for variables
  1.  S BARQ("RX")="POUT^BARRUTL"   ; HEAT#152220 BAR1.8*24
  1.  D GETMSG
  1.  D ^BARDBQUE                   ; Double queuing
  1.  ;D CLEANUP^BARMPAS            ; Clean-up routine 11/05/2013 LINE COMMENTED OUT: HEAT#152220 BAR1.8*24
  1.  D PAZ^BARRUTL                 ; Press return to continue
  1.  Q
  1. CLEANUP K ^XTMP("BARPAS"_BARRUNDT)   ; cleanup scratch global for option PRO 10/10/2013
  1.  Q
  1.  ; ********************************************************************
  1.  ;^XTMP("BARPAS3130904.070754",0,"DT")="2991227^3130904"
  1.  ;                           "SCOPE")="PRO"
  1.  ;                           "SORTBY")=1
  1.  ;
  1.  ;IHS/SD/AR PATCH 19 06/01/2010
  1. GETMSG ;
  1.  ; ASK USER TO INCLUDE A MESSAGE WITH REPORTS
  1.  K BARPTMSG
  1.  S BARPTMSG=""
  1.  W !!
  1.  K DIR
  1.  S DIR("A")="Add a patient statement message"
  1.  S DIR("?")="Enter up to 80 characters as a message appended to statement."
  1.  S DIR(0)="FO^0:80^"
  1.  D ^DIR
  1.  Q:Y=""
  1.  S BARPTMSG=X
  1.  Q
  1. ASKACCT ;
  1.  ; Ask user to select AR Account marked for Patient Account Statement
  1.  W !!
  1.  K DIC
  1.  S DIC("A")="Select Patient-Account: "
  1.  S DIC=90050.02
  1.  S DIC(0)="AEQM"
  1.  S DIC("S")="I $D(^BARAC(DUZ(2),""PAS"",""Y"",+Y))"
  1.  D ^DIC
  1.  Q:Y'>0
  1.  S BARACDA=+Y
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. DATE(BARMODE) ;
  1.  ; Select date range
  1. DT1 ;
  1.  S BARDTB=$$DATE^BARDUTL(1)
  1.  I BARDTB<1 Q
  1.  S BARDTE=$$DATE^BARDUTL(2)
  1.  I BARDTE<1 W ! G DT1
  1.  I BARDTE<BARDTB D  G DT1
  1.  . W *7
  1.  . W !!,"The END date must not be before the START date.",!
  1.  I BARMODE>1 QUIT  ;CALL W/O INIT
  1.  ;--------------------MANUAL (PRO) STATEMET --------------
  1.  D NOW^%DTC
  1.  S BARRUNDT=%
  1.  S X1=DT
  1.  S X2=+15
  1.  D C^%DTC
  1.  K ^XTMP("BARPAS"_BARRUNDT)
  1.  S ^XTMP("BARPAS"_BARRUNDT,0)=X_"^"_DT_"^"_"BAR ACCOUNT STATEMENT"
  1.  S ^XTMP("BARPAS"_BARRUNDT,0,"DT")=BARDTB_"^"_BARDTE
  1.  S BARSRTBY=$$GETSRTBY() ;GET SORT-BY
  1.  S ^XTMP("BARPAS"_BARRUNDT,0,"SORTBY")=BARSRTBY ;P.OTT
  1.  S ^XTMP("BARPAS"_BARRUNDT,0,"SCOPE")="PRO"
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. LOOP ; EP
  1.  ; Part of manual process
  1.  ; IHS/SD/PKD 1.8*20 2/24/11 Set XTMP date headers
  1.  ; If Device definition calls for Start Time, this will capture
  1.  ; Run Dates rather than having them blank
  1.  I $G(BARDTB)=""!($G(BARDTE)="") Q  ;Need dates
  1.  D ACCOUNT(BARACDA)
  1.  Q
  1.  ; ********************************************************************
  1.  ;
  1. MARKACC ; EP
  1.  ; Called from Patient Accounts for Statements AR Menu option
  1.  W !
  1.  F  D  Q:BARAC'>0
  1.  . W !
  1.  . K DIC,DIE,DA,DR,X,Y
  1.  . S DIC=90050.02
  1.  . S DIC(0)="AEQZM"
  1.  . S DIC("S")="I $$GET1^DIQ(90050.02,+Y,1)=9000001"
  1.  . S DIC("W")="W ?50,$$GET1^DIQ(90050.02,+Y,101)"
  1.  . D ^DIC
  1.  . S BARAC=+Y
  1.  . Q:Y'>0
  1.  . S DIE=DIC
  1.  . S DA=+Y
  1.  . S DR="101"
  1.  . D ^DIE
  1.  Q
  1. REBUILD ;EP P.OTT
  1.  S BARSRTBY=$$GETSRTBY() ;GET SORT-BY
  1.  W !!!,"NOTE: This procedure will *collect* statements for printing."
  1.  W !,"Statements will be sorted by ",$P("Billing location, Account Number;Billing location, Patient name",";",BARSRTBY+1)
  1.  W !,"When done use the PAS>PRA menu option to print the collected statements."
  1.  W !
  1. RBLD D NOW^%DTC
  1.  S BARRUNDT=%
  1.  D DATE(2)                                     ; Ask date range AND *do not* init ^XTMP
  1.  I +BARDTB<1 Q                                 ; Dates answered wrong
  1.  I BARDTE>(BARRUNDT\1) D  G RBLD
  1.  . W !!,"END date cannot be a future day",!
  1.  W !
  1.  S DIR("A")="OK to start the re-build process"
  1.  S DIR("B")="NO"
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  K DIR
  1.  I Y'=1 Q
  1.  ;---------------------
  1.  S BARTMPD1=BARDTB
  1.  S BARTMPD2=BARDTE
  1.  S BARXXX=$$GETX() I BARXXX<0 D  QUIT
  1.  . W !,"**WARNING: The Option Scheduling File for BAR ACCOUNT STATEMENT has not been set up."
  1.  . W !,"Cannot proceed."
  1.  . W !! H 2
  1.  S BARSRTBY=$$GETSRTBY() ;GET SORT-BY
  1.  S BARDTB=BARTMPD1
  1.  S BARDTE=BARTMPD2
  1.  D INITXTMP(BARXXX,BARDTB,BARDTE,BARSRTBY,BARRUNDT) ;P.OTT
  1.  D GETHDR^BARMPAS3
  1.  Q:'$D(BARHDRDA)
  1.  S BARHOLD=DUZ(2)
  1.  S DUZ(2)=0 F  S DUZ(2)=$O(^BARAC(DUZ(2))) Q:'+DUZ(2)  D
  1.  . S BARACDA=0 F  S BARACDA=$O(^BARAC(DUZ(2),"PAS","Y",BARACDA)) Q:'BARACDA  D ACCOUNT(BARACDA)
  1.  S DUZ(2)=BARHOLD
  1.  W !,"--- Statements collected."
  1.  S DIR("A")="Do you want to send e-mail notification"
  1.  S DIR("B")="NO"
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  K DIR
  1.  I Y=1 D MAIL^XBMAIL("BARZ MANAGER","MAIL^BARMPAS")
  1.  D PAZ^BARRUTL                       ; Press return to continue
  1.  Q
  1. ASKMODE() ;         
  1.  K DIRUT,DIR,Y
  1.  S Y=$$DIR^XBDIR("S^1:Print Statement for Individual Patient;2:Collect Statements for ALL Flagged Patients","Select Statement Type ","","","","",1)
  1.  K DA
  1.  Q Y
  1. PURGE ;
  1.  NEW BARTMP,BARTMP0,BARARR
  1.  S BARCNT=0,(BARTMP,BARTMP0)="BARPAS" F  S BARTMP=$O(^XTMP(BARTMP)) Q:BARTMP=""  Q:BARTMP'[BARTMP0  S BARCNT=BARCNT+1,BARARR(BARCNT)=BARTMP
  1.  I 'BARCNT W !!,"NO ENTRIES TO PURGE",!! QUIT
  1.  D LISTRUNS
  1.  I BARCNT=1 W !!,"CANNOT PURGE THE ONLY PAS RUN ON FILE.",!! QUIT
  1.  I BARCNT>2 W !,"Entries 1-",BARCNT-1," can be purged."
  1.  I BARCNT=2 W !,"Entry 1 can be purged."
  1.  S DIR("A")="OK to purge?"
  1.  S DIR("B")="NO"
  1.  S DIR(0)="Y"
  1.  D ^DIR
  1.  K DIR
  1.  I Y'=1 Q
  1.  F I=1:1:BARCNT-1 D
  1.  . W !,"PURGING ",BARARR(I)
  1.  . K ^XTMP(BARARR(I))
  1.  . Q
  1.  W !,"LAST ENTRY ",BARARR(BARCNT)," NOT PURGED."
  1.  D PAZ^BARRUTL                       ; Press return to continue
  1.  Q
  1. PATNAME(BARACDA) ;P.OTT
  1.  NEW BARDFN,BARRET,BARNAM
  1.  S BARDFN=$$GET1^DIQ(90050.02,BARACDA,1.001)   ; IEN to Patient file
  1.  S BARNAM=$$GET1^DIQ(9000001,BARDFN,.01)
  1.  I BARNAM="" S BARNAM="UNKN"
  1.  Q BARNAM_"^"_BARDFN ;TO SEPARATE BILLS FOR 2 PATIENTS WITH THE SAME NAME
  1.  ;
  1.  ;LIST EXISTING STATEENTS IN XTMP
  1. LIST S X="BARPAS" F  S X=$O(^XTMP(X)) Q:X=""  Q:X'["BARPAS"  W !,X
  1.  Q
  1. GETSRTBY() ;P.OTT
  1.  NEW BARSRT,X
  1.  ;BARSRTBY=0 - NO ALPHA SORTING
  1.  ;BARSRTBY=1 - ALPHA SORTING (PATNAME^PATEIN)
  1.  ;INTERNAL VALUES
  1.  ; 1        BILLING LOC, ACCOUNT NUMBER
  1.  ; 2        BILLING LOC, PATIENT NAME
  1.  S BARSRT=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),20)),U,4)
  1.  I +BARSRT=0 Q 0  ;IF NOT SET: 0
  1.  I BARSRT S BARSRT=BARSRT-1 ;1,2->0,1
  1.  Q BARSRT
  1.  ;
  1. INITXTMP(X,BARDTB,BARDTE,BARSRTBY,BARRUNDT) ;P.OTT
  1.  K ^XTMP("BARPAS"_BARRUNDT)
  1.  S ^XTMP("BARPAS"_BARRUNDT,0,"DT")=BARDTB_U_BARDTE
  1.  S ^XTMP("BARPAS"_BARRUNDT,0)=X_"^"_BARDTE_"^"_"BAR ACCOUNT STATEMENT"
  1.  S ^XTMP("BARPAS"_BARRUNDT,0,"SORTBY")=BARSRTBY ;P.OTT
  1.  S ^XTMP("BARPAS"_BARRUNDT,0,"SCOPE")="PRA"
  1.  Q
  1. LISTRUNS ;
  1.  S BARCNT=0
  1.  S BAR1="BARPAS"
  1.  F  S BAR1=$O(^XTMP(BAR1)) Q:BAR1'["BARPAS"  D
  1.  . S BARCNT=BARCNT+1                           ; Line counter
  1.  . S BARDT=$P(BAR1,"BARPAS",2,99)              ; Date of Run
  1.  . S BARRUN(BARCNT)=BARDT                      ; Array of runs
  1.  . S Y=BARDT
  1.  . D DD^%DT
  1.  . W !,$J(BARCNT,2),?5,Y                       ; Line count,date run
  1.  . I $G(^XTMP(BAR1,0,"SCOPE"))]"" W " (",$G(^XTMP(BAR1,0,"SCOPE")),") "
  1.  . S BARSRTBY=$G(^XTMP("BARPAS"_BARDT,0,"SORTBY"))+1
  1.  . I BARSRTBY W "  sorted by ",$P("Billing location, Account Number;Billing location, Patient name",";",BARSRTBY)
  1.  Q
  1. HELP ;
  1.  W !,"This parameter will allow you to choose how patient statements"
  1.  W !,"are sorted for printing.  Statements will first be sorted by "
  1.  W !,"(1) billing location and then by account number, or by"
  1.  W !,"(2) billing location and then alphabetically by the patient's last name"
  1.  W !,"based on which option is selected."
  1.  W !,"If nothing is selected, the print order will default to option 1."
  1.  Q
  1. ABAL(BARBL) ;P.OTT COLLECT BILLS WITH NONZERO BALANCE
  1.  N BARBAL
  1.  S BARBAL=$$GET1^DIQ(90050.01,BARBL,15)  ;CURRENT BILL AMOUNT
  1.  Q:BARBAL'>0
  1.  I '$D(^BARBL(DUZ(2),"ABAL",BARACDA,BARBL)) Q  ;HEAT#100207
  1.  S ^XTMP("BARPAS"_BARRUNDT,DUZ(2),1,BARACDA,"OB",BARBL)=""
  1.  Q
  1. LISTALL S BARCNT=0,(BARTMP,BARTMP0)="BARPAS" F  S BARTMP=$O(^XTMP(BARTMP)) Q:BARTMP=""  Q:BARTMP'[BARTMP0  D
  1.  . S BARCNT=BARCNT+1
  1.  . W !,BARCNT,".",?10,BARTMP," ",$G(^XTMP(BARTMP,0))
  1.   . F X="DT","SCOPE","SORTBY","REINDEXED" W !?10,X,": ",$G(^XTMP(BARTMP,0,X))
  1.  . Q
  1.  Q
  1. CLNUP ;
  1.  Q  ;--EOR-