BARDYSV4 ; IHS/SD/MAS,TPF - OMB - DAYS TO COLLECTION ; 02/09/2009
;;1.8;IHS ACCOUNTS RECEIVABLE;**12,13,14,16**;OCT 22,2008
;
;
; IHS/SD/TMM 07/02/2009 M1 Routine ^BARDYSV2 created as a continuation of ^BARDYSVZ
; due to large routine size for SAC checker.
; IHS/SD/TMM 10/20/2009 M2 OMB Phase II modifications. (Create/copy from ^BARDYSV2)
; IHS/SD/TMM 01/10/2010 M3 Record XBFLG value returned from ^XBGSAVE
; IHS/SD/TMM 01/29/2010 M4 Tag TRANS moved from ^BARDYSV3 to ^BARDYSV5 due to
; routine size of ^BARDYSV3 and SAC checker requirement
; IHS/SD/TMM 01/29/2010 M5 Run install report twice using diff date ranges
Q
;
SENDFILE(XBGL,XBFN) ; EP - CREATE FLAT FILE FOR UFMS USING XBGSAVE
S:$G(XBFN)="" XBFN="OMB.TST"
S:$G(XBGL)="" XBGL="BAROMB(" ;TEMP FILE KILLED AFTER FTP SEND. CAN'T USE ^XTMP($J
S XBQSHO=""
S XBF=$J ; Beginning 1st level numeric subscript
S XBE=$J ; Ending 1st level numeric subscript
S XBFLT=1 ; indicates flat file
S XBMED="F" ; Flag indicates file as media
S XBCON=1 ; Q if non-cononic
S XBS1="BAR OMB F" ; ZISH SEND PARAMETERS entry
I $D(ZTQUEUED) S XBS1="BAR OMB B"
S XBQ="N"
S XBUF=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),16)),U) ;A/R SITE PARAMETER FILE, OMB DIRECTORY
I XBUF="" D Q
.W !!,"Before OMB files can be created a non-public directory must be created"
.W !,"on the Host File System. This directory must be entered in to A/R Site Parameter"
.W !,"field OMB DIRECTORY using the 'SPE Site Parameter Edit' option"
.D ASKFORRT^BARUFUT
S XBFLG=0
;
;S XBS1="" ;IF SET TO "" IT WON'T FTP ACROSS
;
I XBUF="" D Q
. S XBFLG=-1
. S XBFLG(1)="Missing OMB REPORT storage directory. Please check A/R OMB Parameters"
I IO=IO(0) W !!
;
D ^XBGSAVE
Q
;
WRITE ;TEMP WRITE WHILE TESTING
N BARVLOC,BARVDA,BARBIL,VISITREC,BILLREC,TRANDT,TRANREC
S BARVLOC=0
F S BARVLOC=$O(^BAROMB($J,BARVLOC)) Q:'BARVLOC D
.S BARVDA=0
.F S BARVDA=$O(^BAROMB($J,BARVLOC,BARVDA)) Q:'BARVDA D
..S VISITREC=^BAROMB($J,BARVLOC,BARVDA,"A VISITREC")
..W !,BARVLOC,U,BARVDA,U,VISITREC
..S BARBIL=0
..F S BARBIL=$O(^BAROMB($J,BARVLOC,BARVDA,"BILLREC",BARBIL)) Q:BARBIL="" D
...S BILLREC=^BAROMB($J,BARVLOC,BARVDA,"BILLREC",BARBIL)
...W !,BARVLOC,U,BARVDA,U,BILLREC
...S TRANDT=0
...F S BARBIL=$O(^BAROMB($J,BARVLOC,BARVDA,"TRANS REC",TRANDT)) Q:TRANDT="" D
....S TRANREC=^BAROMB($J,BARVLOC,BARVDA,"TRANS REC",TRANDT)
....W !,BARVLOC,U,BARVDA,U,TRANREC
Q
;
ASKFNAME(BARFILE,BEGDATE,ENDDATE) ;EP - ASK FOR FILENAME (COPIED FROM BARUFUT1)
S BARFILE=$$GETFILNM(BEGDATE,ENDDATE)
W !!,"File will be created using the following name: ",BARFILE
Q 1
;
GETFILNM(BEGDATE,ENDDATE) ;EP - CREATE FILE NAME (COPIED FROM BARUFUT1)
N FNROOT,FNEXT,FN,YR,DATE,TIME,DATETIME,BARPK,BARPT,BARP2,BARP3,DATERANG
S FNROOT="IHS_AR_OMB_"_DUZ_"_"_$$GETSUFAC()
S FNXREF=DUZ_"_"_$$GETSUFAC()
S BARV=$$VERSION^XPDUTL("BAR")
S BARP2=$$FILLSTR^BARUFUT1($P(BARV,".",2),2,"R","0")
S BARPK=$O(^DIC(9.4,"C","BAR",0))
S BARPK="IHS ACCOUNTS RECEIVABLE"
S BARPT=$$LAST^XPDUTL(BARPK,BARV)
S BARP3=$$FILLSTR^BARUFUT1(+BARPT,2,"R","0")
S FNXT=$P(BARV,".",1)_"."_BARP2_"."_BARP3
S FNEXT="_"_FNXT_".DAT"
S FN=FNROOT
GETFILAG ;CHECK FOR FILE NAME ALREADY USED (COPIED FROM BARUFUT1)
D NOW^%DTC
S YR=1700+$E(%,1,3)
S DATE=YR_$E(%,4,7)
S Y=% X ^DD("DD")
S TIME=$TR($P(Y,"@",2),":")
S:$L(TIME)=4 TIME=TIME_"00"
S DATETIME=DATE_"_"_TIME
S DATERANG="-"_BEGDATE_"-"_ENDDATE_"-"
S FN=FNROOT_"_"_DATETIME_DATERANG
S FN=FN_FNEXT
Q FN
;
GETSUFAC() ;EP;GIVEN DUZ(2) (COPIED FROM BARUFUT1)
; get parent from parent/satellite file
N BARSAT,BARPAR,DA,ASUFAC
S BARSAT=DUZ(2)
S BARPAR=0 ; Parent
; check site active at DOS to ensure bill added to correct site
S DA=0
F S DA=$O(^BAR(90052.06,DA)) Q:DA'>0 D Q:BARPAR
. Q:'$D(^BAR(90052.06,DA,DA)) ; Pos Parent UNDEF Site Parameter
. Q:'$D(^BAR(90052.05,DA,BARSAT)) ; Satellite UNDEF Parent/Satellit
. Q:+$P($G(^BAR(90052.05,DA,BARSAT,0)),U,5) ; Par/Sat not usable
. ; Q if sat NOT active at DT
. I DT<$P($G(^BAR(90052.05,DA,BARSAT,0)),U,6) Q
. ; Q if sat became NOT active before DT
. I $P($G(^BAR(90052.05,DA,BARSAT,0)),U,7),(DT>$P($G(^BAR(90052.05,DA,BARSAT,0)),U,7)) Q
. S BARPAR=$S(BARSAT:$P($G(^BAR(90052.05,DA,BARSAT,0)),U,3),1:"")
S ASUFAC=$$CURASUFC(BARPAR,DT)
Q ASUFAC
;
CURASUFC(LOCIEN,BARDOS) ;EP - GET CURRENT ASUFAC BASED ON 'DOS BEGIN' (#102) IN A/R BILL FILE (COPIED FROM BARUFUT1)
Q:LOCIEN="" "UNPOPL"
Q:BARDOS="" "UNPOPD"
N ASUFAC,BARDT,BARDTFLG
S ASUFAC=""
S BARDT=0
S BARDTFLG=0
S ASUFAC=$$GET1^DIQ(9999999.06,DUZ(2)_",",.12) ;First take it from 'asufac index" field
;if not, check class multiple
I 'ASUFAC D
.F S BARDT=$O(^AUTTLOC(LOCIEN,11,BARDT)) Q:BARDT=""!(BARDTFLG=1) D
..I BARDOS>$P($G(^AUTTLOC(LOCIEN,11,BARDT,0)),U) D
...S ASUFAC=$P($G(^AUTTLOC(LOCIEN,11,BARDT,0)),U,6)
...S BARDTFLG=1
;S:ASUFAC="" ASUFAC=$$GET1^DIQ(9999999.06,DUZ(2)_",",.12)
Q ASUFAC
;
INSTALL ;EP - Run two times using different date range when BAR*1.8*16 installed ;M5*ADD*TMM
S BEGDATE=3081001 ;M5*ADD*TMM
S ENDDATE=3090930 ;M5*ADD*TMM
D INST ;M5*ADD*TMM
S BEGDATE=3091001 ;M5*ADD*TMM
S ENDDATE=3100131 ;M5*ADD*TMM
D INST ;M5*ADD*TMM
Q
;
INST ;EP - Run once when patch installed BAR*1.8*14 ;M5*ADD*TMM
;INSTALL ;EP - Run once when patch installed BAR*1.8*14 ;M5*DEL*TMM
I '$$IHS^BARDYSV3(DUZ(2)) Q ;***Should this be installed at non-IHS facilities?
D INIT^BARDYSV3
;S BEGDATE=3081001 ;M5*DEL*TMM
;S ENDDATE=3090930 ;M5*DEL*TMM
D NOW^%DTC
S ^BARTMP("BARDYSV3",0,"INSTALL STARTED",DUZ(2),%)=BEGDATE_U_ENDDATE
D VISITS^BARDYSV5(BEGDATE,ENDDATE)
D BILLS^BARDYSV3(BEGDATE,ENDDATE) ;M2
;D TRANS^BARDYSV3(BEGDATE,ENDDATE) ;M2 ;M4*DEL*TMM
D TRANS^BARDYSV5(BEGDATE,ENDDATE) ;M2 ;M4*ADD*TMM
S ^BARTMP("BARDYSV3",0,"INSTALL COMPLETED",DUZ(2),%)="OMB PHASE II - Data Extracted, Ready to send"
S RC=$$ASKFNAME(.BARFILE,BEGDATE,ENDDATE)
D SENDFILE("BAROMB(",BARFILE) ;M1 BAR*1.8*13 TMM
D NOW^%DTC
;I $G(XBFLG)'=0 S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETED",DUZ(2),%,1)="Global copy of ^BAROMB Failed"_"^"_$G(XBFLG(1)) ;M2 ;M3*DEL*TMM
;I $G(XBFLG)=-1 S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETED",DUZ(2),%,2)=$G(XBFLG(1)) ;M2 ;M3*DEL*TMM
;I $G(XBFLG)=0 S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETE",DUZ(2),%,3)="Global copy ^BAROMB successful" ;M2 ;M3*DEL*TMM
I $G(XBFLG)'=0 S ^BARTMP("BARDYSV3",0,"INSTALL COMPLETED",DUZ(2),%,1)="Global copy of ^BAROMB Failed"_"^"_XBFLG_"^"_$G(XBFLG(1)) ;M2 ;M3*ADD*TMM
I $G(XBFLG)=-1 S ^BARTMP("BARDYSV3",0,"INSTALL COMPLETED",DUZ(2),%,2)=$G(XBFLG)_"^"_$G(XBFLG(1)) ;M2 ;M3*ADD*TMM
I $G(XBFLG)=0 S ^BARTMP("BARDYSV3",0,"INSTALL COMPLETE",DUZ(2),%,3)="Global copy ^BAROMB successful" ;M2 ;M3*ADD*TMM
Q
BARDYSV4 ; IHS/SD/MAS,TPF - OMB - DAYS TO COLLECTION ; 02/09/2009
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;**12,13,14,16**;OCT 22,2008
+2 ;
+3 ;
+4 ; IHS/SD/TMM 07/02/2009 M1 Routine ^BARDYSV2 created as a continuation of ^BARDYSVZ
+5 ; due to large routine size for SAC checker.
+6 ; IHS/SD/TMM 10/20/2009 M2 OMB Phase II modifications. (Create/copy from ^BARDYSV2)
+7 ; IHS/SD/TMM 01/10/2010 M3 Record XBFLG value returned from ^XBGSAVE
+8 ; IHS/SD/TMM 01/29/2010 M4 Tag TRANS moved from ^BARDYSV3 to ^BARDYSV5 due to
+9 ; routine size of ^BARDYSV3 and SAC checker requirement
+10 ; IHS/SD/TMM 01/29/2010 M5 Run install report twice using diff date ranges
+11 QUIT
+12 ;
SENDFILE(XBGL,XBFN) ; EP - CREATE FLAT FILE FOR UFMS USING XBGSAVE
+1 IF $GET(XBFN)=""
SET XBFN="OMB.TST"
+2 ;TEMP FILE KILLED AFTER FTP SEND. CAN'T USE ^XTMP($J
IF $GET(XBGL)=""
SET XBGL="BAROMB("
+3 SET XBQSHO=""
+4 ; Beginning 1st level numeric subscript
SET XBF=$JOB
+5 ; Ending 1st level numeric subscript
SET XBE=$JOB
+6 ; indicates flat file
SET XBFLT=1
+7 ; Flag indicates file as media
SET XBMED="F"
+8 ; Q if non-cononic
SET XBCON=1
+9 ; ZISH SEND PARAMETERS entry
SET XBS1="BAR OMB F"
+10 IF $DATA(ZTQUEUED)
SET XBS1="BAR OMB B"
+11 SET XBQ="N"
+12 ;A/R SITE PARAMETER FILE, OMB DIRECTORY
SET XBUF=$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),16)),U)
+13 IF XBUF=""
Begin DoDot:1
+14 WRITE !!,"Before OMB files can be created a non-public directory must be created"
+15 WRITE !,"on the Host File System. This directory must be entered in to A/R Site Parameter"
+16 WRITE !,"field OMB DIRECTORY using the 'SPE Site Parameter Edit' option"
+17 DO ASKFORRT^BARUFUT
End DoDot:1
QUIT
+18 SET XBFLG=0
+19 ;
+20 ;S XBS1="" ;IF SET TO "" IT WON'T FTP ACROSS
+21 ;
+22 IF XBUF=""
Begin DoDot:1
+23 SET XBFLG=-1
+24 SET XBFLG(1)="Missing OMB REPORT storage directory. Please check A/R OMB Parameters"
End DoDot:1
QUIT
+25 IF IO=IO(0)
WRITE !!
+26 ;
+27 DO ^XBGSAVE
+28 QUIT
+29 ;
WRITE ;TEMP WRITE WHILE TESTING
+1 NEW BARVLOC,BARVDA,BARBIL,VISITREC,BILLREC,TRANDT,TRANREC
+2 SET BARVLOC=0
+3 FOR
SET BARVLOC=$ORDER(^BAROMB($JOB,BARVLOC))
IF 'BARVLOC
QUIT
Begin DoDot:1
+4 SET BARVDA=0
+5 FOR
SET BARVDA=$ORDER(^BAROMB($JOB,BARVLOC,BARVDA))
IF 'BARVDA
QUIT
Begin DoDot:2
+6 SET VISITREC=^BAROMB($JOB,BARVLOC,BARVDA,"A VISITREC")
+7 WRITE !,BARVLOC,U,BARVDA,U,VISITREC
+8 SET BARBIL=0
+9 FOR
SET BARBIL=$ORDER(^BAROMB($JOB,BARVLOC,BARVDA,"BILLREC",BARBIL))
IF BARBIL=""
QUIT
Begin DoDot:3
+10 SET BILLREC=^BAROMB($JOB,BARVLOC,BARVDA,"BILLREC",BARBIL)
+11 WRITE !,BARVLOC,U,BARVDA,U,BILLREC
+12 SET TRANDT=0
+13 FOR
SET BARBIL=$ORDER(^BAROMB($JOB,BARVLOC,BARVDA,"TRANS REC",TRANDT))
IF TRANDT=""
QUIT
Begin DoDot:4
+14 SET TRANREC=^BAROMB($JOB,BARVLOC,BARVDA,"TRANS REC",TRANDT)
+15 WRITE !,BARVLOC,U,BARVDA,U,TRANREC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
ASKFNAME(BARFILE,BEGDATE,ENDDATE) ;EP - ASK FOR FILENAME (COPIED FROM BARUFUT1)
+1 SET BARFILE=$$GETFILNM(BEGDATE,ENDDATE)
+2 WRITE !!,"File will be created using the following name: ",BARFILE
+3 QUIT 1
+4 ;
GETFILNM(BEGDATE,ENDDATE) ;EP - CREATE FILE NAME (COPIED FROM BARUFUT1)
+1 NEW FNROOT,FNEXT,FN,YR,DATE,TIME,DATETIME,BARPK,BARPT,BARP2,BARP3,DATERANG
+2 SET FNROOT="IHS_AR_OMB_"_DUZ_"_"_$$GETSUFAC()
+3 SET FNXREF=DUZ_"_"_$$GETSUFAC()
+4 SET BARV=$$VERSION^XPDUTL("BAR")
+5 SET BARP2=$$FILLSTR^BARUFUT1($PIECE(BARV,".",2),2,"R","0")
+6 SET BARPK=$ORDER(^DIC(9.4,"C","BAR",0))
+7 SET BARPK="IHS ACCOUNTS RECEIVABLE"
+8 SET BARPT=$$LAST^XPDUTL(BARPK,BARV)
+9 SET BARP3=$$FILLSTR^BARUFUT1(+BARPT,2,"R","0")
+10 SET FNXT=$PIECE(BARV,".",1)_"."_BARP2_"."_BARP3
+11 SET FNEXT="_"_FNXT_".DAT"
+12 SET FN=FNROOT
GETFILAG ;CHECK FOR FILE NAME ALREADY USED (COPIED FROM BARUFUT1)
+1 DO NOW^%DTC
+2 SET YR=1700+$EXTRACT(%,1,3)
+3 SET DATE=YR_$EXTRACT(%,4,7)
+4 SET Y=%
XECUTE ^DD("DD")
+5 SET TIME=$TRANSLATE($PIECE(Y,"@",2),":")
+6 IF $LENGTH(TIME)=4
SET TIME=TIME_"00"
+7 SET DATETIME=DATE_"_"_TIME
+8 SET DATERANG="-"_BEGDATE_"-"_ENDDATE_"-"
+9 SET FN=FNROOT_"_"_DATETIME_DATERANG
+10 SET FN=FN_FNEXT
+11 QUIT FN
+12 ;
GETSUFAC() ;EP;GIVEN DUZ(2) (COPIED FROM BARUFUT1)
+1 ; get parent from parent/satellite file
+2 NEW BARSAT,BARPAR,DA,ASUFAC
+3 SET BARSAT=DUZ(2)
+4 ; Parent
SET BARPAR=0
+5 ; check site active at DOS to ensure bill added to correct site
+6 SET DA=0
+7 FOR
SET DA=$ORDER(^BAR(90052.06,DA))
IF DA'>0
QUIT
Begin DoDot:1
+8 ; Pos Parent UNDEF Site Parameter
IF '$DATA(^BAR(90052.06,DA,DA))
QUIT
+9 ; Satellite UNDEF Parent/Satellit
IF '$DATA(^BAR(90052.05,DA,BARSAT))
QUIT
+10 ; Par/Sat not usable
IF +$PIECE($GET(^BAR(90052.05,DA,BARSAT,0)),U,5)
QUIT
+11 ; Q if sat NOT active at DT
+12 IF DT<$PIECE($GET(^BAR(90052.05,DA,BARSAT,0)),U,6)
QUIT
+13 ; Q if sat became NOT active before DT
+14 IF $PIECE($GET(^BAR(90052.05,DA,BARSAT,0)),U,7)
IF (DT>$PIECE($GET(^BAR(90052.05,DA,BARSAT,0)),U,7))
QUIT
+15 SET BARPAR=$SELECT(BARSAT:$PIECE($GET(^BAR(90052.05,DA,BARSAT,0)),U,3),1:"")
End DoDot:1
IF BARPAR
QUIT
+16 SET ASUFAC=$$CURASUFC(BARPAR,DT)
+17 QUIT ASUFAC
+18 ;
CURASUFC(LOCIEN,BARDOS) ;EP - GET CURRENT ASUFAC BASED ON 'DOS BEGIN' (#102) IN A/R BILL FILE (COPIED FROM BARUFUT1)
+1 IF LOCIEN=""
QUIT "UNPOPL"
+2 IF BARDOS=""
QUIT "UNPOPD"
+3 NEW ASUFAC,BARDT,BARDTFLG
+4 SET ASUFAC=""
+5 SET BARDT=0
+6 SET BARDTFLG=0
+7 ;First take it from 'asufac index" field
SET ASUFAC=$$GET1^DIQ(9999999.06,DUZ(2)_",",.12)
+8 ;if not, check class multiple
+9 IF 'ASUFAC
Begin DoDot:1
+10 FOR
SET BARDT=$ORDER(^AUTTLOC(LOCIEN,11,BARDT))
IF BARDT=""!(BARDTFLG=1)
QUIT
Begin DoDot:2
+11 IF BARDOS>$PIECE($GET(^AUTTLOC(LOCIEN,11,BARDT,0)),U)
Begin DoDot:3
+12 SET ASUFAC=$PIECE($GET(^AUTTLOC(LOCIEN,11,BARDT,0)),U,6)
+13 SET BARDTFLG=1
End DoDot:3
End DoDot:2
End DoDot:1
+14 ;S:ASUFAC="" ASUFAC=$$GET1^DIQ(9999999.06,DUZ(2)_",",.12)
+15 QUIT ASUFAC
+16 ;
INSTALL ;EP - Run two times using different date range when BAR*1.8*16 installed ;M5*ADD*TMM
+1 ;M5*ADD*TMM
SET BEGDATE=3081001
+2 ;M5*ADD*TMM
SET ENDDATE=3090930
+3 ;M5*ADD*TMM
DO INST
+4 ;M5*ADD*TMM
SET BEGDATE=3091001
+5 ;M5*ADD*TMM
SET ENDDATE=3100131
+6 ;M5*ADD*TMM
DO INST
+7 QUIT
+8 ;
INST ;EP - Run once when patch installed BAR*1.8*14 ;M5*ADD*TMM
+1 ;INSTALL ;EP - Run once when patch installed BAR*1.8*14 ;M5*DEL*TMM
+2 ;***Should this be installed at non-IHS facilities?
IF '$$IHS^BARDYSV3(DUZ(2))
QUIT
+3 DO INIT^BARDYSV3
+4 ;S BEGDATE=3081001 ;M5*DEL*TMM
+5 ;S ENDDATE=3090930 ;M5*DEL*TMM
+6 DO NOW^%DTC
+7 SET ^BARTMP("BARDYSV3",0,"INSTALL STARTED",DUZ(2),%)=BEGDATE_U_ENDDATE
+8 DO VISITS^BARDYSV5(BEGDATE,ENDDATE)
+9 ;M2
DO BILLS^BARDYSV3(BEGDATE,ENDDATE)
+10 ;D TRANS^BARDYSV3(BEGDATE,ENDDATE) ;M2 ;M4*DEL*TMM
+11 ;M2 ;M4*ADD*TMM
DO TRANS^BARDYSV5(BEGDATE,ENDDATE)
+12 SET ^BARTMP("BARDYSV3",0,"INSTALL COMPLETED",DUZ(2),%)="OMB PHASE II - Data Extracted, Ready to send"
+13 SET RC=$$ASKFNAME(.BARFILE,BEGDATE,ENDDATE)
+14 ;M1 BAR*1.8*13 TMM
DO SENDFILE("BAROMB(",BARFILE)
+15 DO NOW^%DTC
+16 ;I $G(XBFLG)'=0 S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETED",DUZ(2),%,1)="Global copy of ^BAROMB Failed"_"^"_$G(XBFLG(1)) ;M2 ;M3*DEL*TMM
+17 ;I $G(XBFLG)=-1 S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETED",DUZ(2),%,2)=$G(XBFLG(1)) ;M2 ;M3*DEL*TMM
+18 ;I $G(XBFLG)=0 S ^BARTMP("BARDYSV3",0,"INTERACT COMPLETE",DUZ(2),%,3)="Global copy ^BAROMB successful" ;M2 ;M3*DEL*TMM
+19 ;M2 ;M3*ADD*TMM
IF $GET(XBFLG)'=0
SET ^BARTMP("BARDYSV3",0,"INSTALL COMPLETED",DUZ(2),%,1)="Global copy of ^BAROMB Failed"_"^"_XBFLG_"^"_$GET(XBFLG(1))
+20 ;M2 ;M3*ADD*TMM
IF $GET(XBFLG)=-1
SET ^BARTMP("BARDYSV3",0,"INSTALL COMPLETED",DUZ(2),%,2)=$GET(XBFLG)_"^"_$GET(XBFLG(1))
+21 ;M2 ;M3*ADD*TMM
IF $GET(XBFLG)=0
SET ^BARTMP("BARDYSV3",0,"INSTALL COMPLETE",DUZ(2),%,3)="Global copy ^BAROMB successful"
+22 QUIT
