BARMEISS ; IHS/SD/LSL - Manually resend EISS files ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;
; IHS/SD/LSL - 05/03/04 - V1.8
; Routine created to manually resend EISS files left in the
; directory.
;
Q
; ********************************************************************
EP ;EP
D FINDFILE ; Find files in directory
Q:'$D(BARFILES) ; No files in directory
D DISPFILE ; Display files for choosing
I BARANS<1 D Q ; No file selected
. D PAZ^BARRUTL
D RUSURE ; Resend message.
I BARANS<1 D Q ; Don't resend
. D PAZ^BARRUTL
D RESEND ; Resend selected file
D PAZ^BARRUTL
Q
; ********************************************************************
;
FINDFILE ;
; Find files in EISS directory. List returned in BARFILES array
; BARFILES(#)=filename
S BARDIR=$P($G(^BAR(90052.06,DUZ(2),DUZ(2),2)),U,4)
Q:BARDIR="" ; No EISS local directory.
S BARLIST=$$LIST^%ZISH(BARDIR,"*",.BARFILES)
I '$D(BARFILES) D Q
. W !!,"No files in ",BARDIR," directory"
. D PAZ^BARRUTL
Q
; ********************************************************************
;
DISPFILE ;
W !!
S (BARA,BARCNT)=0
F S BARA=$O(BARFILES(BARA)) Q:'+BARA D
. S BARCNT=BARCNT+1
. W !,$J(BARCNT,2),?5,BARFILES(BARA)
. S BARTMP(BARCNT)=BARA
S BARANS=0
W !
K DIR
S DIR(0)="NAO^1:"_BARCNT
S DIR("A")="Please enter the LINE # of the EISS file to be resent: "
S DIR("?")="Enter a number between 1 and "_BARCNT
D ^DIR
S BARANS=Y
Q:BARANS<1
S BARFN=BARFILES(BARTMP(BARANS))
Q
; ***********************************************************************
;
RUSURE ;
W !
S BARANS=0
K DIR
S DIR(0)="Y^A"
S DIR("A")="Would you like to resend "_BARFN_" now"
S DIR("B")="Y"
D ^DIR
S:Y BARANS=1
K DIR
Q
; ********************************************************************
;
RESEND ;
; Resend selected file
S BAREISS=$G(^BAR(90052.06,DUZ(2),DUZ(2),2))
S XBFN=BARFN
S XBUF=BARDIR
S BARUNAM=$P(BAREISS,U,2) ; Username of system receiving file
S BARUPASS=$P(BAREISS,U,3) ; Password of system receiving file
S XBQTO=$P(BAREISS,U) ; System id to receive file
; Include username and password in system id
; Add i to XBQTO to send immediately rather than queue. Needed so can
; delete sent files. (A/R 1.8)
S XBQTO="-il """_BARUNAM_":"_BARUPASS_""" "_XBQTO
I XBUF=""!(BARUNAM="")!(BARUPASS="")!(XBQTO="") Q
I IO=IO(0) W !!
I $$VERSION^%ZOSV(1)["Windows" D UUCPQ^ZIBGSVEP
E D UUCPQ^ZIBGSVEM
D ^%ZISC,HOME^%ZIS
S:'$D(XBFLG) XBFLG=0
Q:+XBFLG ; Send not successful
; delete file from local, send successful
S BARDEL=$$DEL^%ZISH(BARDIR,BARFN)
Q
BARMEISS ; IHS/SD/LSL - Manually resend EISS files ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;
+3 ; IHS/SD/LSL - 05/03/04 - V1.8
+4 ; Routine created to manually resend EISS files left in the
+5 ; directory.
+6 ;
+7 QUIT
+8 ; ********************************************************************
EP ;EP
+1 ; Find files in directory
DO FINDFILE
+2 ; No files in directory
IF '$DATA(BARFILES)
QUIT
+3 ; Display files for choosing
DO DISPFILE
+4 ; No file selected
IF BARANS<1
Begin DoDot:1
+5 DO PAZ^BARRUTL
End DoDot:1
QUIT
+6 ; Resend message.
DO RUSURE
+7 ; Don't resend
IF BARANS<1
Begin DoDot:1
+8 DO PAZ^BARRUTL
End DoDot:1
QUIT
+9 ; Resend selected file
DO RESEND
+10 DO PAZ^BARRUTL
+11 QUIT
+12 ; ********************************************************************
+13 ;
FINDFILE ;
+1 ; Find files in EISS directory. List returned in BARFILES array
+2 ; BARFILES(#)=filename
+3 SET BARDIR=$PIECE($GET(^BAR(90052.06,DUZ(2),DUZ(2),2)),U,4)
+4 ; No EISS local directory.
IF BARDIR=""
QUIT
+5 SET BARLIST=$$LIST^%ZISH(BARDIR,"*",.BARFILES)
+6 IF '$DATA(BARFILES)
Begin DoDot:1
+7 WRITE !!,"No files in ",BARDIR," directory"
+8 DO PAZ^BARRUTL
End DoDot:1
QUIT
+9 QUIT
+10 ; ********************************************************************
+11 ;
DISPFILE ;
+1 WRITE !!
+2 SET (BARA,BARCNT)=0
+3 FOR
SET BARA=$ORDER(BARFILES(BARA))
IF '+BARA
QUIT
Begin DoDot:1
+4 SET BARCNT=BARCNT+1
+5 WRITE !,$JUSTIFY(BARCNT,2),?5,BARFILES(BARA)
+6 SET BARTMP(BARCNT)=BARA
End DoDot:1
+7 SET BARANS=0
+8 WRITE !
+9 KILL DIR
+10 SET DIR(0)="NAO^1:"_BARCNT
+11 SET DIR("A")="Please enter the LINE # of the EISS file to be resent: "
+12 SET DIR("?")="Enter a number between 1 and "_BARCNT
+13 DO ^DIR
+14 SET BARANS=Y
+15 IF BARANS<1
QUIT
+16 SET BARFN=BARFILES(BARTMP(BARANS))
+17 QUIT
+18 ; ***********************************************************************
+19 ;
RUSURE ;
+1 WRITE !
+2 SET BARANS=0
+3 KILL DIR
+4 SET DIR(0)="Y^A"
+5 SET DIR("A")="Would you like to resend "_BARFN_" now"
+6 SET DIR("B")="Y"
+7 DO ^DIR
+8 IF Y
SET BARANS=1
+9 KILL DIR
+10 QUIT
+11 ; ********************************************************************
+12 ;
RESEND ;
+1 ; Resend selected file
+2 SET BAREISS=$GET(^BAR(90052.06,DUZ(2),DUZ(2),2))
+3 SET XBFN=BARFN
+4 SET XBUF=BARDIR
+5 ; Username of system receiving file
SET BARUNAM=$PIECE(BAREISS,U,2)
+6 ; Password of system receiving file
SET BARUPASS=$PIECE(BAREISS,U,3)
+7 ; System id to receive file
SET XBQTO=$PIECE(BAREISS,U)
+8 ; Include username and password in system id
+9 ; Add i to XBQTO to send immediately rather than queue. Needed so can
+10 ; delete sent files. (A/R 1.8)
+11 SET XBQTO="-il """_BARUNAM_":"_BARUPASS_""" "_XBQTO
+12 IF XBUF=""!(BARUNAM="")!(BARUPASS="")!(XBQTO="")
QUIT
+13 IF IO=IO(0)
WRITE !!
+14 IF $$VERSION^%ZOSV(1)["Windows"
DO UUCPQ^ZIBGSVEP
+15 IF '$TEST
DO UUCPQ^ZIBGSVEM
+16 DO ^%ZISC
DO HOME^%ZIS
+17 IF '$DATA(XBFLG)
SET XBFLG=0
+18 ; Send not successful
IF +XBFLG
QUIT
+19 ; delete file from local, send successful
+20 SET BARDEL=$$DEL^%ZISH(BARDIR,BARFN)
+21 QUIT
