- 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
