Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BAR277LM

BAR277LM.m

Go to the documentation of this file. 
  1. BAR277LM ; IHS/SD/LSL - LIST MANAGER API'S ;
  1.  ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005
  1.  ;
  1.  ; Routine created by cmi/flag/maw for V1.6 Patch 3
  1.  ;
  1.  ; ********************************************************************
  1.  ; cmi/flag/maw modified from XBLM for 276/277 Project
  1.  ; Documentation APIs for BAR276LM Generic Display.
  1.  ; This utility uses the Veterans Administration List Manager
  1.  ; (VALM).
  1.  ;
  1.  ; APIs
  1.  ;
  1.  ; FILE^BAR277LM("Directory","File Name")
  1.  ;     Displays file indicated.
  1.  ;
  1.  ; SFILE^BAR277LM
  1.  ;     Selection of host file for display.
  1.  ;
  1.  ; VIEWR^BAR277LM("TAG^ROUTINE","Header")
  1.  ;     Displays printout of the routine. (non - FM, using IO)
  1.  ;
  1.  ; VIEWD^BAR277LM("Tag^Routine","Header")
  1.  ;     Displays printout of the routine. (FM - using EN1^DIP)
  1.  ;
  1.  ; DIQ^BAR277LM("DIC","DA")
  1.  ;     Displays EN1^DIQ for the DIC,DA.
  1.  ;
  1.  ; ARRAY^BAR277LM("array(","Header")
  1.  ;     Displays the array(..,n,0) (%RCR notation)
  1.  ;
  1.  ; >>GUI<<                                      
  1.  ;
  1.  ; GUIR^BAR277LM("TAG^ROUTINE","root(")
  1.  ;     Returns the hard coded output in the array specified.
  1.  ;     "(" not required.
  1.  ;
  1.  ; GUID^BAR277LM("TAG^ROUTINE","root(")
  1.  ;     Returns the output of the FM routine specified in the
  1.  ;     array specified.  Most often the call is "EN1^DIP".
  1.  ;                                          
  1.  ; S XBGUI=1,XBY="root(" D entry_point^XBLM    
  1.  ;     The entry points sense these two variables and will
  1.  ;     put the output into the array specified.
  1.  ;
  1. EN(BAR277PR) ;EP -- main entry point for BAR277 RESPONSE DISPLAY
  1.  D EN^VALM(BAR277PR)
  1.  Q
  1.  ;
  1. HDR ;EP -- header code
  1.  I XBHDR]"" S VALMHDR(1)=XBHDR
  1.  Q
  1.  ;
  1. INIT ;EP -- init variables and list array
  1. MARKERS ;
  1.  I $G(XBLMMARK) F I=10:10 Q:'$D(@VALMAR@(I))  D
  1.  . F J=10:10:80 D CNTRL^VALM10(I,J,1,IORVON,IORVOFF)
  1.  .Q
  1.  KILL XBLMMARK
  1.  S VALMCNT=$O(^TMP("XBLM",$J,XBNODE,""),-1)
  1.  Q
  1.  ;
  1. HELP ;EP -- help code
  1.  S X="?"
  1.  D DISP^XQORM1
  1.  W !!
  1.  Q
  1.  ;
  1. EXIT ;EP -- exit code
  1.  KILL ^TMP("XBLM",$J,XBNODE)
  1. K ;
  1.  KILL XBAR,XBDIR,XBFL,XBFN,XBHDR,XBI,XBROU,XBDIR
  1.  I '$G(XQORS) D CLEAR^VALM1
  1.  K IOPAR,IOUPAR
  1.  Q
  1.  ;
  1. EXPND ;EP -- expand code
  1.  Q
  1.  ;
  1. FILE(XBDIR,XBFN) ;EP - pull up a file into the TMP global for display
  1.  ;      or into an array for GUI (see GUIR and GUID entry points)
  1.  I '$D(XBHDR) S XBHDR=""
  1.  NEW Y,X,I,XBNODE
  1.  S XBNODE=$G(XQORS)+1
  1.  ;S Y=$$OPEN^%ZISH(XBDIR,XBFN,"M")
  1.  ;open hfs with zis
  1.  D DF^%ZISH(.XBDIR)
  1.  ;
  1.  ; IHS/ADC/GTH XB*3*5 start of open HF change 
  1.  KILL %ZIS
  1.  I ('$D(^%ZIS(1,"B","XBLM HF DEVICE")))!('$D(^%ZIS(2,"B","P-XBLM"))) D ^XBLMSET
  1.  S IOP="XBLM HF DEVICE",%ZIS("HFSMODE")="R",%ZIS("HFSNAME")=XBDIR_XBFN
  1.  D ^%ZIS
  1.  I POP W !,*7,"CANNOT OPEN (OR ACCESS) FILE '",XBDIR,XBFN,"'." S Y=$$DIR^XBDIR("E") G EFILE
  1.  KILL ^TMP("XBLM",$J,XBNODE)
  1.  ; F I=1:1 U IO R X:DTIME S:($L(X)>250) X=$E(X,1,250) S X=$$STRIP(X) S ^TMP("XBLM",$J,XBNODE,I,0)=X Q:$$STATUS^%ZISH ; XB*3*8
  1.  F I=1:1 U IO R X S:($L(X)>250) X=$E(X,1,250) S X=$$STRIP(X) S ^TMP("XBLM",$J,XBNODE,I,0)=X Q:$$STATUS^%ZISH  ; XB*3*8 - UNIX does not find EOF w/timed READ, writes to ^TMP(, and fills up journal space.
  1.  D ^%ZISC
  1.  ; IHS/ADC/GTH XB*3*5 END of open HF change 
  1.  ;
  1.  I $G(XBGUI) D  KILL ^TMP("XBLM",$J,XBNODE) Q
  1.  . S I=0
  1.  . S XBY=$$OPENROOT(XBY)
  1.  . F  S I=$O(^TMP("XBLM",$J,XBNODE,I)) Q:'+I  S XBZ=XBY_"I)",@XBZ=^TMP("XBLM",$J,XBNODE,I,0)
  1.  .Q
  1.  D EN^BAR277LM("BAR EDI 277 RESPONSE")
  1.  KILL ^TMP("XBLM",$J,XBNODE)
  1. EFILE ;
  1.  Q
  1.  ;
  1. SFILE ;EP - Select a host file for display.
  1. OPEN ;
  1.  S IOP="HOME"
  1.  D ^%ZIS,DT^DICRW,^XBCLS
  1.  W !!,"Select a Directory and File",!!
  1.  S Y=$$PWD^%ZISH(.XBDIR),XBDIR=XBDIR(1)
  1.  KILL DIR
  1.  S DIR(0)="F^1:30",DIR("A")="Directory ",DIR("B")=XBDIR
  1.  K XBDIR
  1.  D ^DIR
  1.  KILL DIR
  1.  Q:$G(DTOUT)
  1.  Q:Y["^"
  1.  S XBDIR=Y
  1. FNAME ;EP - Select a file (directory can be pre-loaded into XBDIR)
  1.  KILL DIR
  1. FNAME1 ;
  1.  S DIR(0)="FO^1:15",DIR("A")="File Name "
  1.  D ^DIR
  1.  KILL DIR
  1.  Q:$G(DTOUT)
  1.  G:Y["^" OPEN
  1.  G:Y="" OPEN
  1.  I Y?.N,$D(XBFL(Y)) S DIR("B")=XBFL(Y) G FNAME1
  1.  I Y["*" K XBFL S X=$$LIST^%ZISH(XBDIR,Y,.XBFL) D  G FNAME
  1.  . F XBI=1:1 Q:'$D(XBFL(XBI))  W !?5,XBI,?10,XBFL(XBI) I '(XBI#20) R X:DTIME
  1.  .Q
  1.  S XBFN=Y
  1.  ;S X=$$OPEN^%ZISH(XBDIR,XBFN,"M")
  1.  ;open hfs with zis
  1.  D DF^%ZISH(.XBDIR)
  1.  ;
  1.  ; IHS/ADC/GTH XB*3*5 start of open HF change 
  1.  KILL %ZIS
  1.  I ('$D(^%ZIS(1,"B","XBLM HF DEVICE")))!('$D(^%ZIS(2,"B","P-XBLM"))) D ^XBLMSET
  1.  S IOP="XBLM HF DEVICE",%ZIS("HFSMODE")="R",%ZIS("HFSNAME")=XBDIR_XBFN
  1.  D ^%ZIS
  1. ES ;
  1.  I POP W !,"error on open of file ",XBDIR,XBFN,! S Y=$$DIR^XBDIR("E") Q:Y=1  G FNAME
  1.  D ^%ZISC
  1.  D FILE^XBLM(XBDIR,XBFN)
  1.  K XBFN
  1. ESFILE ;
  1.  G FNAME
  1.  Q
  1.  ;
  1. VIEWR(XBROU,XBHDR) ;EP ** USING XBROU print to a host file for viewing
  1.  I '$D(XBHDR) S XBHDR=""
  1.  I +$G(IO(0)) U IO(0) D:'$G(XBGUI) WAIT^DICD
  1.  S Y=$$PWD^%ZISH(.XBDIR)
  1.  S XBDIR=XBDIR(1),XBFN="XB"_$J
  1.  ;open hfs with zis
  1.  D DF^%ZISH(.XBDIR)
  1.  K %ZIS
  1.  S XBIOM=IOM
  1.  I ('$D(^%ZIS(1,"B","XBLM HF DEVICE")))!('$D(^%ZIS(2,"B","P-XBLM"))) D ^XBLMSET
  1.  S IOP="XBLM HF DEVICE;"_IOM_";6000"
  1.  S %ZIS("HFSMODE")="W",%ZIS("HFSNAME")=XBDIR_XBFN
  1.  D ^%ZIS
  1.  U IO
  1.  K DX ;IHS/JDH 6/17/98 prevent <MODER> if defined when DIQ is called
  1.  D @XBROU
  1.  D ^%ZISC,HOME^%ZIS
  1.  D FILE^BAR277LM(XBDIR,XBFN)
  1.  S X=$$DEL^%ZISH(XBDIR,XBFN)
  1.  S IOM=XBIOM
  1.  KILL XBDIR,XBFN,XBHDR,XBNODE,XBDIR,XBFN,XBIOM
  1.  ; IHS/ADC/GTH XB*3*5 END of open HF change 
  1.  ;
  1.  Q
  1.  ;
  1. GUIR(XBROU,XBY) ;EP - give routine and target array
  1.  Q:$L(XBY)=0
  1.  ;
  1.  S XBGUI=1
  1.  D VIEWR^XBLM(XBROU,"")
  1.  KILL XBGUI,XBY
  1.  Q
  1.  ;
  1. GUID(XBROU,XBY) ;EP give routine and target array for FM prints
  1.  Q:$L(XBY)=0
  1.  S:XBY["(" XBY=$P(XBY,"(")
  1.  S XBGUI=1
  1.  D VIEWD^XBLM(XBROU,"")
  1.  KILL XBGUI,XBY
  1.  Q
  1.  ;
  1. VIEWD(XBROU,XBHDR) ;EP ** USING XBROU print to a host file for viewing
  1.  S:'$D(XBHDR) XBHDR=""
  1.  I +$G(IO(0)) I '$G(XBGUI) U IO(0) D WAIT^DICD
  1.  S XBFN="XB"_$J,Y=$$PWD^%ZISH(.XBDIR),XBDIR=XBDIR(1)
  1.  ;S X=$$OPEN^%ZISH(XBDIR,XBFN,"W"),IOP=IO_";P-OTHER;"_IOM_";"_IOSL
  1.  ;open hfs with zis
  1.  D DF^%ZISH(.XBDIR)
  1.  ;
  1.  ; IHS/ADC/GTH XB*3*5 start of open HF change 
  1.  KILL %ZIS
  1.  S XBIOM=IOM
  1.  I ('$D(^%ZIS(1,"B","XBLM HF DEVICE")))!('$D(^%ZIS(2,"B","P-XBLM"))) D ^XBLMSET
  1.  S IOP="XBLM HF DEVICE;"_IOM_";6000"
  1.  S %ZIS("HFSMODE")="W",%ZIS("HFSNAME")=XBDIR_XBFN
  1.  D ^%ZIS
  1.  D @XBROU
  1.  K DX ;IHS/JDH 6/17/98 prevent <MODER> if defined when DIQ is called
  1.  D ^%ZISC,HOME^%ZIS
  1.  D FILE^XBLM(XBDIR,XBFN)
  1.  S X=$$DEL^%ZISH(XBDIR,XBFN)
  1.  S IOM=XBIOM
  1.  KILL XBDIR,XBFN,XBNODE,XBDIR,XBFN,XBIOM
  1.  ; IHS/ADC/GTH XB*3*5 END of open HF change 
  1.  ;
  1.  Q
  1.  ;
  1. DIQ(DIC,DA) ;EP - Display DIC and DA after call to EN^DIQ
  1.  S IOSTO=IOST,IOST="P-DEC",IOSLO=IOSL,IOSL=6000
  1.  I DIC=+DIC S DIC=$$DIC^XBDIQ1(DIC)
  1.  I DA'=+DA D PARSE^XBDIQ1(DA)
  1.  NEW DIQ,DR
  1.  S DIQ(0)="C"
  1.  D VIEWR^BAR277LM("EN^DIQ")
  1.  S IOST=IOSTO
  1.  KILL IOSTO
  1.  S IOSL=IOSLO
  1.  KILL IOSLO,XBNODE,XBDIR,XBFN
  1.  Q
  1.  ;
  1. ARRAY(XBAR,XBHDR) ;EP  Display an array that has (...,n,0) structure
  1.  I '$D(XBHDR) S XBHDR=""
  1.  NEW Y,X,I,XBNODE
  1.  S XBNODE=$G(XQORS)+1
  1.  KILL ^TMP("XBLM",$J,XBNODE)
  1.  S %X=XBAR,%Y="^TMP(""XBLM"","_$J_","_XBNODE_","
  1.  D %XY^%RCR,EN^XBLM
  1.  KILL ^TMP("XBLM",$J,XBNODE),XBNODE,XBDIR,XBFN
  1. ARRAYE ;
  1.  Q
  1.  ;
  1. STRIP(Z) ;REMOVE CONTROLL CHARACTERS
  1.  NEW I
  1.  F I=1:1:$L(Z) I (32>$A($E(Z,I))) S Z=$E(Z,1,I-1)_" "_$E(Z,I+1,999)
  1.  Q Z
  1.  ;
  1. OPENROOT(XBY) ;EP - return OPen RooT form of XBY .. for %RCR use
  1.  NEW L
  1.  S L=$L(XBY)
  1.  I XBY["(",$E(XBY,L)="," G CONT
  1.  I XBY'["(" S XBY=XBY_"(" G CONT
  1.  I XBY["(",$E(XBY,L)=")" S XBY=$E(XBY,1,L-1)_"," G CONT
  1. CONT ;
  1.  Q XBY
  1.  ;