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

DDBR.m

Go to the documentation of this file.
  1. DDBR ;SFISC/DCL - VA FILEMAN BROWSER ;13JUN2016
  1. ;;22.2;VA FileMan;**3,7**;Jan 05, 2016;Build 3
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;GFT;**165,999,1055**;
  1. ;
  1. EN N DDBC,DDBFLG,DDBL,DDBPMSG,DDBSA,DDBX,IOTM,IOBM
  1. ; I '$$TEST^DDBRT W $C(7),!!,$$EZBLD^DIALOG(830),!! Q ;VEN/SMH - don't check for supportability
  1. D LIST^DDBR3(.DDBX)
  1. I DDBX'>0 W:DDBX=0 $C(7),!!,$$EZBLD^DIALOG(1404),!! Q ;**
  1. S DDBSA=DDBX(6)
  1. S DDBFLG=DDBX(4)
  1. S DDBPMSG=DDBX(5)
  1. D CONTNU
  1. D KTMP^DDBRU
  1. Q
  1. ;
  1. WP(DDBFN,DDBRN,DDBFLD,DDBFLG,DDBPMSG,DDBL,DDBC,IOTM,IOBM) N DDBSA
  1. S DDBSA=$$GET^DIQG($G(DDBFN),$G(DDBRN),$G(DDBFLD),"B")
  1. I $G(DIERR) D CLEAN Q
  1. S DDBSA=$P(DDBSA,"$CREF$",2)
  1. I DDBSA']"" D ERR("FILE, RECORD and/or FIELD") Q
  1. I '$D(@DDBSA) D ERR("SOURCE ARRAY") Q
  1. I $G(DDBFLG)["A" D
  1. .N DDBSAN
  1. .S DDBSAN=$$NROOT^DDBRAP($NA(@DDBSA))
  1. .I '$D(@DDBSAN) D WP^DDBRAP($NA(@DDBSA))
  1. .Q:$G(DDBPMSG)]""
  1. .I $D(@DDBSAN@("TITLE")) S DDBPMSG=@DDBSAN@("TITLE") Q
  1. .Q
  1. S DDBPMSG=$S($G(DDBPMSG)]"":DDBPMSG,1:"VA FileMan Browser (wp) DOCUMENT 1")
  1. D CONTNU
  1. D:$G(DDBFLG)'["P" KTMP^DDBRU
  1. Q
  1. ;
  1. BROWSE(DDBSA,DDBFLG,DDBPMSG,DDBL,DDBC,IOTM,IOBM) N DDBRLIST
  1. CONTNU I $G(U)'="^" N U S U="^"
  1. I $G(DDBFLG)["A" D
  1. .N DDBSAN
  1. .S DDBSAN=$$NROOT^DDBRAP($NA(@DDBSA))
  1. .I '$D(@DDBSAN) D WP^DDBRAP($NA(@DDBSA))
  1. .Q:$G(DDBPMSG)]""
  1. .I $D(@DDBSAN@("TITLE")) S DDBPMSG=@DDBSAN@("TITLE") Q
  1. .Q
  1. S DDBPMSG=$S($G(DDBPMSG)]"":DDBPMSG,1:"VA FileMan Browser DOCUMENT 1")
  1. N %,D,DX,IOP,XY,X,Y
  1. D:$G(DDBFLG)'["H" INIT I $G(DIERR) D CLEAN Q
  1. I $G(DDBSA)']"" D ERR("SOURCE ARRAY") Q
  1. I '$D(@DDBSA) D ERR("SOURCE ARRAY") Q
  1. I $G(DDBFLG)'["N",DDBSA'="^TMP(""DDB"",$J)" D
  1. .I $NA(@DDBSA)=$NA(^TMP("DDB",$J)) S DDBSA="^TMP(""DDB"",$J)" Q
  1. .K ^TMP("DDB",$J)
  1. .D XY^%RCR($$OREF(DDBSA),"^TMP(""DDB"",$J,")
  1. .;M ^TMP("DDB",$J)=@DDBSA
  1. .S DDBSA="^TMP(""DDB"",$J)"
  1. .Q
  1. N DDBRE,DDBRPE,DDBPSA,DDBTO,DDBDM,DDBFNO,I,DDBFLGS,DDBRHT,DDBRHTF
  1. N DDBHDR,DDBHDRC,DDBFTR,DDBSP,DDBSF,DDBST,DDBTL,DDBTPG,DDBZN
  1. I '$G(DDBRLIST) N DDBSRL,DDBSX,DDBSY,DDBRSA
  1. S DDBFTR=$E("Col> |"_$$EZBLD^DIALOG(8074)_"| Line> Screen>"_$J("",IOM),1,IOM) ;**
  1. I '$G(DDBRLIST) S IOBM=$S($G(IOBM)>0:IOBM,1:$G(IOSL,24))-1,IOTM=$S($G(IOTM)>0:IOTM,1:1)+1
  1. S DDBRSA=0
  1. D TB^DDBRS(.IOTM,.IOBM,.DDBRSA)
  1. S DDBSX="0;4;40;65"
  1. S DDBSY=DDBRSA(0,"DDBSY")
  1. I IOBM>(IOSL-1) D ERR($$EZBLD^DIALOG(833)) Q ;**
  1. I IOTM<2 D ERR($$EZBLD^DIALOG(832)) Q ;**
  1. I IOBM'>IOTM D ERR($$EZBLD^DIALOG(831)) Q ;**
  1. S DDBSRL=DDBRSA(0,"DDBSRL")
  1. I DDBSRL'>4,$G(DDBFLG)'["H" D ERR($$EZBLD^DIALOG(834)) Q ;**
  1. I DDBRSA(1,"DDBSRL")'>4 K DDBRSA(1),DDBRSA(2)
  1. S DDBHDR=$$CTXT(DDBPMSG,$J("",IOM+1),IOM),DDBHDRC=0
  1. S DDBTL=$P($G(@DDBSA@(0)),"^",3) S:DDBTL'>0 DDBTL=$O(@DDBSA@(" "),-1)
  1. I DDBTL'>0 D I DDBTL'>0 D BLD^DIALOG(1700,$$EZBLD^DIALOG(1404)_DDBSA) D CLEAN Q ;**
  1. .N I S I=0 F S I=$O(@DDBSA@(I)) Q:I'>0 S DDBTL=I
  1. .Q
  1. S DDBZN=$D(@DDBSA@(DDBTL,0))#2,DDBTPG=DDBTL\DDBSRL+(DDBTL#DDBSRL'<1),DDBSF=1,DDBST=IOM
  1. S DDBDM=DDBSA="^TMP(""DDB"",$J)"
  1. I $G(DDBC)=+$G(DDBC) D ERR("TAB (Closed Array Root)") Q
  1. S:$G(DDBC)="" DDBC="^TMP(""DDBC"",$J)"
  1. I '$D(@DDBC) F I=1,22:22:176 S @DDBC@(I)=""
  1. I $D(@DDBC@(1))'>9 N DDBC0,DDBC1 S @DDBC@(1)="",DDBC1=1,DDBC0=DDBC
  1. S DDBPSA=0,DDBFLG=$G(DDBFLG)
  1. S DDBFLGS=DDBFLG["S",DDBRHTF=DDBFLG["A"
  1. I DDBRHTF S $E(DDBFTR,1,9)="HYPER-TXT"
  1. G EN^DDBRGE
  1. DOCLIST(DDBDSA,DDBFLG,IOTM,IOBM) S IOP="HOME" D ^%ZIS
  1. N DDBPMSG,DDBL,DDBC,DDBSA,DDBSRL,DDBSX,DDBSY,DDBRSA,DDBRLIST
  1. S IOBM=$S($G(IOBM)>0:IOBM,1:$G(IOSL,24))-1,IOTM=$S($G(IOTM)>0:IOTM,1:1)+1
  1. S DDBSX="0;4;40;65"
  1. S DDBSY=(IOTM-2)_";"_(IOTM-1)_";"_(IOBM-1)_";"_(IOBM) ;hdr,txttop,txtbot,ftr
  1. I IOBM>(IOSL-1) D ERR($$EZBLD^DIALOG(833)) Q ;**
  1. I IOTM<2 D ERR($$EZBLD^DIALOG(832)) Q ;**
  1. I IOBM'>IOTM D ERR($$EZBLD^DIALOG(831)) Q ;**
  1. S DDBSRL=(IOBM-IOTM)+1 ;scroll region lines
  1. I '$D(@DDBDSA) D ERR("DOCUMENT ARRAY INVALID") Q
  1. S DDBFLG=$TR($G(DDBFLG),"P")_"N"
  1. S DDBPMSG=$O(@DDBDSA@("")) S:DDBPMSG]"" DDBSA=@DDBDSA@(DDBPMSG)
  1. I DDBPMSG']""!(DDBSA']"") D ERR("DOCUMENT ARRAY INVALID") Q
  1. D I $G(DIERR) K ^TMP("DDBLST",$J) D CLEAN Q
  1. .N DOC,DOCSA
  1. .S DOC=""
  1. .K ^TMP("DDBLST",$J)
  1. .F S DOC=$O(@DDBDSA@(DOC)) Q:DOC="" D
  1. ..S DOCSA=@DDBDSA@(DOC)
  1. ..D LOADCL^DDBR4(DOCSA,"",DOC)
  1. ..Q
  1. .Q
  1. Q:$G(DDBENDR)
  1. S DDBRLIST=1
  1. G CONTNU
  1. ;
  1. RTN G DR^DDBRU
  1. ;
  1. ROOT G EN^DDBRU2
  1. ;
  1. CTXT(X,T,W) Q:X="" $G(T)
  1. N HW
  1. S W=$G(W,79),HW=W\2
  1. S $E(T,HW-($L(X)\2),HW-($L(X)\2)+$L(X))=X Q $E(T,1,W)
  1. ;
  1. OREF(X) N X1,X2 S X1=$P(X,"(")_"(",X2=$$OR2($P(X,"(",2)) Q:X2="" X1 Q X1_X2_","
  1. ;
  1. OR2(%) Q:%=")"!(%=",") "" Q:$L(%)=1 % S:"),"[$E(%,$L(%)) %=$E(%,1,$L(%)-1) Q %
  1. ;
  1. INIT I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1. D INIT^DDGLIB0(1)
  1. I $G(DIERR) Q
  1. I '$D(IOSTBM)!('$D(IORI)) S X="IOSTBM;IORI" D ENDR^%ZISS
  1. D:$G(IOSTBM)="" TRMERR^DDGLIB0($$EZBLD^DIALOG(831)) ;**
  1. D:$G(IORI)="" TRMERR^DDGLIB0($$EZBLD^DIALOG(835))
  1. ;W $P(DDGLCLR,DDGLDEL,2) ; VEN/SMH - Clear entire screen. ;P7
  1. ;TODO: Rollback IOSL to 24 if IOSL is >100; restore at exit (prob in CLEAN) - VEN/SMH
  1. Q
  1. ;
  1. ERR(DDBERR) N P S P(1)=DDBERR
  1. I $G(U)="^" N U S U="^"
  1. D BLD^DIALOG(202,.P),OUT^DDBRU:$D(DDGLDEL)
  1. CLEAN D:'$D(DDS) KILL^DDGLIB0($G(DDBFLG))
  1. Q