BARLN0.m

BARLN0 ; IHS/SD/LSL - LISTMAN DRIVER FOR LINK 02-FEB-1996 ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 ;; ;

EN ; EP -- main entry point for BAR LINK

 D EN^VALM("BAR LINK")

 Q

 ; *********************************************************************

 ;

HDR ; -- header code

 Q

 ; *********************************************************************

 ;

INIT ; -- init variables and list array

 D VIEW^BARLN0(XBROU)

 S VALMCNT=$O(^TMP("BAR LINK",$J,XBNODE,""),-1)

 Q

 ; *********************************************************************

 ;

HELP ; -- help code

 S X="?"

 D DISP^XQORM1

 W !!

 Q

 ; *********************************************************************

 ;

EXIT ; -- exit code

 Q

 ; *********************************************************************

 ;

EXPND ; -- expand code

 Q

 ; *********************************************************************

 ;

LMFUN ;

VIEW(XBROU)         ;EP

 ; ** USING XBROU print to a host file for viewing

 I '$D(XBHDR) S XBHDR=""

 U IO(0)

 D WAIT^DICD

 S Y=$$PWD^%ZISH(.XBDIR)

 S XBDIR=XBDIR(1)

 S XBFN="XB"_$J

 S X=$$OPEN^%ZISH(XBDIR,XBFN,"W")

 S IOST="P-DEC",IOST(0)=$O(^%ZIS(2,"B","P-DEC",0))

 S IOSL=6000

 S IOF="#"

 U IO

 D @XBROU

 D ^%ZISC

 D HOME^%ZIS

 I '$D(XBHDR) S XBHDR=""

 N Y,X,I

 S XBNODE=$G(XQORS)+1

 S Y=$$OPEN^%ZISH(XBDIR,XBFN,"R")

 I Y W !,"NO OPEN" H 1 Q

 K ^TMP("BAR LINK",$J,XBNODE)

 F I=1:1 U IO R X:DTIME S X=$$STRIP(X) S ^TMP("BAR LINK",$J,XBNODE,I,0)=X Q:$$STATUS^%ZISH=-1

 D ^%ZISC

 S X=$$DEL^%ZISH(XBDIR,XBFN)

 K XBDIR,XBFN,XBHDR

 K XBDIR,XBFN

 Q

 ; *********************************************************************

 ;

EFILE Q

 ; *********************************************************************

 ;

STRIP(Z) ;

 ; REMOVE CONTROLL CHARACTERS

 N I F I=1:1:$L(Z) I (32>$A($E(Z,I))) S Z=$E(Z,1,I-1)_" "_$E(Z,I+1,999)

 Q Z

 ; *********************************************************************

 ;

KILL ;

 K ^TMP("BAR LINK",$J,XBNODE)

 Q

BARLN0    ; IHS/SD/LSL - LISTMAN DRIVER FOR LINK 02-FEB-1996 ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 +2       ;; ;

EN        ; EP -- main entry point for BAR LINK

 +1        DO EN^VALM("BAR LINK")

 +2        QUIT 

 +3       ; *********************************************************************

 +4       ;

HDR       ; -- header code

 +1        QUIT 

 +2       ; *********************************************************************

 +3       ;

INIT      ; -- init variables and list array

 +1        DO VIEW^BARLN0(XBROU)

 +2        SET VALMCNT=$ORDER(^TMP("BAR LINK",$JOB,XBNODE,""),-1)

 +3        QUIT 

 +4       ; *********************************************************************

 +5       ;

HELP      ; -- help code

 +1        SET X="?"

 +2        DO DISP^XQORM1

 +3        WRITE !!

 +4        QUIT 

 +5       ; *********************************************************************

 +6       ;

EXIT      ; -- exit code

 +1        QUIT 

 +2       ; *********************************************************************

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ; *********************************************************************

 +3       ;

LMFUN     ;

VIEW(XBROU) ;EP

 +1       ; ** USING XBROU print to a host file for viewing

 +2        IF '$DATA(XBHDR)

               SET XBHDR=""

 +3        USE IO(0)

 +4        DO WAIT^DICD

 +5        SET Y=$$PWD^%ZISH(.XBDIR)

 +6        SET XBDIR=XBDIR(1)

 +7        SET XBFN="XB"_$JOB

 +8        SET X=$$OPEN^%ZISH(XBDIR,XBFN,"W")

 +9        SET IOST="P-DEC"

           SET IOST(0)=$ORDER(^%ZIS(2,"B","P-DEC",0))

 +10       SET IOSL=6000

 +11       SET IOF="#"

 +12       USE IO

 +13       DO @XBROU

 +14       DO ^%ZISC

 +15       DO HOME^%ZIS

 +16       IF '$DATA(XBHDR)

               SET XBHDR=""

 +17       NEW Y,X,I

 +18       SET XBNODE=$GET(XQORS)+1

 +19       SET Y=$$OPEN^%ZISH(XBDIR,XBFN,"R")

 +20       IF Y

               WRITE !,"NO OPEN"

               HANG 1

               QUIT 

 +21       KILL ^TMP("BAR LINK",$JOB,XBNODE)

 +22       FOR I=1:1

               USE IO

               READ X:DTIME

               SET X=$$STRIP(X)

               SET ^TMP("BAR LINK",$JOB,XBNODE,I,0)=X

               IF $$STATUS^%ZISH=-1

                   QUIT 

 +23       DO ^%ZISC

 +24       SET X=$$DEL^%ZISH(XBDIR,XBFN)

 +25       KILL XBDIR,XBFN,XBHDR

 +26       KILL XBDIR,XBFN

 +27       QUIT 

 +28      ; *********************************************************************

 +29      ;

EFILE      QUIT 

 +1       ; *********************************************************************

 +2       ;

STRIP(Z)  ;

 +1       ; REMOVE CONTROLL CHARACTERS

 +2        NEW I

           FOR I=1:1:$LENGTH(Z)

               IF (32>$ASCII($EXTRACT(Z,I)))

                   SET Z=$EXTRACT(Z,1,I-1)_" "_$EXTRACT(Z,I+1,999)

 +3        QUIT Z

 +4       ; *********************************************************************

 +5       ;

KILL      ;

 +1        KILL ^TMP("BAR LINK",$JOB,XBNODE)

 +2        QUIT