BARDSP ; IHS/SD/LSL - VALM INTERFACE FOR A/R ;
;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
;; ;
EN ;EP - main entry point for BAR DISPLAY
D EN^VALM("BAR DISPLAY")
Q
; *********************************************************************
;
HDR ; -- header code
Q
; *********************************************************************
;
INIT ; -- init variables and list array
S VALMCNT=$O(^TMP("BAR",$J,BARNODE,""),-1)
Q
; *********************************************************************
;
HELP ; -- help code
S X="?"
D DISP^XQORM1
W !!
Q
; *********************************************************************
;
EXIT ; -- exit code
K ^TMP("BAR",$J,BARNODE)
I '$G(XQORS) D CLEAR^VALM1
Q
; *********************************************************************
;
EXPND ; -- expand code
Q
; *********************************************************************
;
FILE(BARDIR,BARFN) ; EP
; Pull up a file into the TMP global for display
N Y,X,I,BARNODE
S BARNODE=$G(XQORS)+1
S Y=$$OPEN^%ZISH(BARDIR,BARFN,"R")
I Y W !,"NO OPEN" H 1 G FILE
K ^TMP("BAR",$J)
F I=1:1 U IO R X:1 Q:$$STATUS^%ZISH=-1 S ^TMP("BAR",$J,BARNODE,I,0)=X
D ^%ZISC
D EN^BARDSP
K ^TMP("BAR",$J,BARNODE)
EFILE ;
Q
; *********************************************************************
;
SFILE ; EP - SELECT FILE
OPEN ;
D DT^DICRW
D ^XBCLS
W !!,"Select a Directory and File",!!
K DIR
S DIR(0)="F^1:30"
S DIR("A")="Directory "
S DIR("B")="/usr/mumps/"
D ^DIR
K DIR
Q:Y["^"
S BARXDIR=Y
;
FNAME ;
K DIR
FNAME1 ;
S DIR(0)="F^1:15"
S DIR("A")="File Name "
D ^DIR
K DIR
G:Y["^" OPEN
I Y?.N,$D(BARXFL(Y)) S DIR("B")=BARXFL(Y) G FNAME1
I Y["*" D
.K BARXFL D G FNAME
.. S X=$$LIST^%ZISH(BARXDIR,Y,.BARXFL)
.. F BARXI=1:1 Q:'$D(BARXFL(BARXI)) W !,?5,BARXI,?10,BARXFL(BARXI)
S BARXFN=Y
S X=$$OPEN^%ZISH(BARXDIR,BARXFN,"R")
;
ES ;
I X W !,"error on open of file ",BARXDIR,BARXFN,! D EOP^BARUTL(0) Q:Y=1 G FNAME
D ^%ZISC
D FILE^BARDSP(BARXDIR,BARXFN)
;
ESFILE ;
Q
; *********************************************************************
;
FACE(DFN) ;EP - display face sheet
Q:'$G(DFN)
N BARFN
S BARFN="BAR"_$J
;
O ;
S Y=$$OPEN^%ZISH("",BARFN,"W")
I Y W !,"NO OPEN"
U IO
D START^AGFACE
D ^%ZISC
D FILE^BARDSP("",BARFN)
S Y=$$DEL^%ZISH("",BARFN)
Q
; *********************************************************************
;
FMCRIB ; EP
; call up the FM CRIB text from the A/R LETTERS & TEXT file
D ARRAY^XBLM("^BAR(90052.03,1,1,")
Q
BARDSP ; IHS/SD/LSL - VALM INTERFACE FOR A/R ;
+1 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
+2 ;; ;
EN ;EP - main entry point for BAR DISPLAY
+1 DO EN^VALM("BAR DISPLAY")
+2 QUIT
+3 ; *********************************************************************
+4 ;
HDR ; -- header code
+1 QUIT
+2 ; *********************************************************************
+3 ;
INIT ; -- init variables and list array
+1 SET VALMCNT=$ORDER(^TMP("BAR",$JOB,BARNODE,""),-1)
+2 QUIT
+3 ; *********************************************************************
+4 ;
HELP ; -- help code
+1 SET X="?"
+2 DO DISP^XQORM1
+3 WRITE !!
+4 QUIT
+5 ; *********************************************************************
+6 ;
EXIT ; -- exit code
+1 KILL ^TMP("BAR",$JOB,BARNODE)
+2 IF '$GET(XQORS)
DO CLEAR^VALM1
+3 QUIT
+4 ; *********************************************************************
+5 ;
EXPND ; -- expand code
+1 QUIT
+2 ; *********************************************************************
+3 ;
FILE(BARDIR,BARFN) ; EP
+1 ; Pull up a file into the TMP global for display
+2 NEW Y,X,I,BARNODE
+3 SET BARNODE=$GET(XQORS)+1
+4 SET Y=$$OPEN^%ZISH(BARDIR,BARFN,"R")
+5 IF Y
WRITE !,"NO OPEN"
HANG 1
GOTO FILE
+6 KILL ^TMP("BAR",$JOB)
+7 FOR I=1:1
USE IO
READ X:1
IF $$STATUS^%ZISH=-1
QUIT
SET ^TMP("BAR",$JOB,BARNODE,I,0)=X
+8 DO ^%ZISC
+9 DO EN^BARDSP
+10 KILL ^TMP("BAR",$JOB,BARNODE)
EFILE ;
+1 QUIT
+2 ; *********************************************************************
+3 ;
SFILE ; EP - SELECT FILE
OPEN ;
+1 DO DT^DICRW
+2 DO ^XBCLS
+3 WRITE !!,"Select a Directory and File",!!
+4 KILL DIR
+5 SET DIR(0)="F^1:30"
+6 SET DIR("A")="Directory "
+7 SET DIR("B")="/usr/mumps/"
+8 DO ^DIR
+9 KILL DIR
+10 IF Y["^"
QUIT
+11 SET BARXDIR=Y
+12 ;
FNAME ;
+1 KILL DIR
FNAME1 ;
+1 SET DIR(0)="F^1:15"
+2 SET DIR("A")="File Name "
+3 DO ^DIR
+4 KILL DIR
+5 IF Y["^"
GOTO OPEN
+6 IF Y?.N
IF $DATA(BARXFL(Y))
SET DIR("B")=BARXFL(Y)
GOTO FNAME1
+7 IF Y["*"
Begin DoDot:1
+8 KILL BARXFL
Begin DoDot:2
+9 SET X=$$LIST^%ZISH(BARXDIR,Y,.BARXFL)
+10 FOR BARXI=1:1
IF '$DATA(BARXFL(BARXI))
QUIT
WRITE !,?5,BARXI,?10,BARXFL(BARXI)
End DoDot:2
GOTO FNAME
End DoDot:1
+11 SET BARXFN=Y
+12 SET X=$$OPEN^%ZISH(BARXDIR,BARXFN,"R")
+13 ;
ES ;
+1 IF X
WRITE !,"error on open of file ",BARXDIR,BARXFN,!
DO EOP^BARUTL(0)
IF Y=1
QUIT
GOTO FNAME
+2 DO ^%ZISC
+3 DO FILE^BARDSP(BARXDIR,BARXFN)
+4 ;
ESFILE ;
+1 QUIT
+2 ; *********************************************************************
+3 ;
FACE(DFN) ;EP - display face sheet
+1 IF '$GET(DFN)
QUIT
+2 NEW BARFN
+3 SET BARFN="BAR"_$JOB
+4 ;
O ;
+1 SET Y=$$OPEN^%ZISH("",BARFN,"W")
+2 IF Y
WRITE !,"NO OPEN"
+3 USE IO
+4 DO START^AGFACE
+5 DO ^%ZISC
+6 DO FILE^BARDSP("",BARFN)
+7 SET Y=$$DEL^%ZISH("",BARFN)
+8 QUIT
+9 ; *********************************************************************
+10 ;
FMCRIB ; EP
+1 ; call up the FM CRIB text from the A/R LETTERS & TEXT file
+2 DO ARRAY^XBLM("^BAR(90052.03,1,1,")
+3 QUIT
