- 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
