BMXRPC2 ; IHS/OIT/HMW - FIELD LIST ;
;;4.0;BMX;;JUN 28, 2010
;
FLDLIST(BMXGBL,BMXFL,BMXATTR,BMXSCR) ;EP
;TODO: Change all this to be a hard-coded $O thru ^DD
;Returns info in BMXATTR for all fields in file number BMXFL
;BMXSCR is executable code to set $T
; When BMXSCR is executed, the field number is in BMXFLD
;See FileMan documentation for FIELD^DD for description
;of Attributes
;
;---> Set variables, kill temp globals.
;S ^HW("F",BMXFL)=""
;S ^HW("F",BMXATTR)=""
N BMX31,BMXERR,BMXG,BMXFLD,BMX,BMXC,BMXT
S BMX31=$C(31)_$C(31)
S BMXGBL="BMXTMP("_$J_")",BMXERR="",U="^"
K BMXTMP($J)
;
;---> If file number not provided, return error.
;I '+BMXFL D ERROUT^BMXRPC("File number not provided.",1) Q
;---> If file number not provided check for file name.
I +BMXFL'=BMXFL D
. S BMXFL=$TR(BMXFL,"_"," ")
. I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
. S BMXFL=$O(^DIC("B",BMXFL,0))
I '$G(BMXFL) D ERROUT^BMXRPC("File number not provided.",1) Q
;
;---> If no such file, return error.
I '$D(^DD(BMXFL,0)) D ERROUT^BMXRPC("File does not exist.",1) Q
;
;---> Validate screen code
I $G(BMXSCR)="" S BMXSCR="I 1"
S X=$G(BMXSCR)
I X]"" D ^DIM
I '$D(X) S BMXSCR="I 1" ;Default to no screen
;
;---> Set Target Global for output and errors.
S BMXG="BMXTMP($J,""DID"")"
;
;---> Loop through ^DD(FileNumber,FieldNumber,0) to get field names
K BMXTMP($J)
I $G(BMXATTR)="" S BMXATTR="LABEL" ;Changed from NAME to LABEL
;---> Attribute Names
F I=1:1:$L(BMXATTR,";") S BMXT($P(BMXATTR,";",I))=""
S (BMX,BMXC)=0 F S BMX=$O(BMXT(BMX)) Q:BMX="" D
. S BMXC=BMXC+1
. S $P(BMXT,U,BMXC)="T00030"_BMX
S BMXTMP($J,1)="T00030NUMBER"_U_BMXT_$C(30)
;
;S BMXFLD=0 F I=2:1 S BMXFLD=$O(^DD(BMXFL,BMXFLD)) Q:'+BMXFLD D
S BMXTMP($J,2)=".001^BMXIEN"_$C(30)
S BMXFLDN=0 F I=3:1 S BMXFLDN=$O(^DD(BMXFL,"B",BMXFLDN)) Q:BMXFLDN="" D
. S BMXFLD=$O(^DD(BMXFL,"B",BMXFLDN,0)) Q:'+BMXFLD
. X BMXSCR Q:'$T
. D FIELD^DID(BMXFL,BMXFLD,,BMXATTR,BMXG,BMXG)
. K BMXT S (BMXC,BMX)=0
. F S BMX=$O(BMXTMP($J,"DID",BMX)) Q:BMX="" D
. . S BMXC=BMXC+1
. . S $P(BMXT,U,BMXC)=BMXTMP($J,"DID",BMX)
. S BMXTMP($J,I)=BMXFLD_U_$TR(BMXT," ","_")_$C(30)
;S I=I+1,BMXTMP($J,I)=".001^BMXIEN"_$C(30)
S I=I+1
K BMXTMP($J,"DID")
;---> Tack on Error Delimiter and any error.
S BMXTMP($J,I)=BMX31_BMXERR
Q
;
MLTLIST(BMXGBL,BMXFL,BMXONEOK) ;EP
;Returns list of multiple fields in file BMXFL, returns only one field
;if BMXONEOK is TRUE
;S ^HW($H,"MLTLIST","FL")=BMXFL
;S ^HW($H,"MLTLIST","ONE")=BMXONEOK
N BMX31,BMXERR,BMXG,BMXFLD,BMX,BMXC,BMXT,I
S BMX31=$C(31)_$C(31)
S BMXGBL="BMXTMP("_$J_")",BMXERR="",U="^"
K BMXTMP($J)
;
;---> If file number not provided check for file name.
I +BMXFL'=BMXFL D
. S BMXFL=$TR(BMXFL,"_"," ")
. I '$D(^DIC("B",BMXFL)) S BMXFL="" Q
. S BMXFL=$O(^DIC("B",BMXFL,0))
I '$G(BMXFL) D ERROUT^BMXRPC("File number not provided.",1) Q
;
;---> If no such file, return error.
I '$D(^DD(BMXFL,0)) D ERROUT^BMXRPC("File does not exist.",1) Q
;
;---> Column Headers
S BMXTMP($J,1)="T00030NUMBER"_U_"T00030NAME"_$C(30)
;
;---> $O thru ^DD(BMXFL,"SB" to get subfile numbers and names
S I=2
N BMXSB,BMXSBN,BMXSBF,BMXFOUND
S BMXFOUND=0
I $D(^DD(BMXFL,"SB")) D
. S BMXSB=0
. F S BMXSB=$O(^DD(BMXFL,"SB",BMXSB)) Q:'+BMXSB D I BMXFOUND Q:BMXONEOK=1
. . S BMXSBF=$O(^DD(BMXFL,"SB",BMXSB,0))
. . Q:'+BMXSBF
. . S BMXSBN=$G(^DD(BMXFL,BMXSBF,0))
. . Q:BMXSBN=""
. . S BMXZ=$G(^DD(BMXSB,.01,0))
. . Q:$P(BMXZ,U,2)["W"
. . S BMXFOUND=1
. . S BMXSBN=$P(BMXSBN,U)
. . S BMXTMP($J,I)=BMXSB_U_BMXSBN_$C(30)
. . S I=I+1
;
;---> Tack on Error Delimiter and any error.
S BMXTMP($J,I)=BMX31_BMXERR
Q
BMXRPC2 ; IHS/OIT/HMW - FIELD LIST ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
FLDLIST(BMXGBL,BMXFL,BMXATTR,BMXSCR) ;EP
+1 ;TODO: Change all this to be a hard-coded $O thru ^DD
+2 ;Returns info in BMXATTR for all fields in file number BMXFL
+3 ;BMXSCR is executable code to set $T
+4 ; When BMXSCR is executed, the field number is in BMXFLD
+5 ;See FileMan documentation for FIELD^DD for description
+6 ;of Attributes
+7 ;
+8 ;---> Set variables, kill temp globals.
+9 ;S ^HW("F",BMXFL)=""
+10 ;S ^HW("F",BMXATTR)=""
+11 NEW BMX31,BMXERR,BMXG,BMXFLD,BMX,BMXC,BMXT
+12 SET BMX31=$CHAR(31)_$CHAR(31)
+13 SET BMXGBL="BMXTMP("_$JOB_")"
SET BMXERR=""
SET U="^"
+14 KILL BMXTMP($JOB)
+15 ;
+16 ;---> If file number not provided, return error.
+17 ;I '+BMXFL D ERROUT^BMXRPC("File number not provided.",1) Q
+18 ;---> If file number not provided check for file name.
+19 IF +BMXFL'=BMXFL
Begin DoDot:1
+20 SET BMXFL=$TRANSLATE(BMXFL,"_"," ")
+21 IF '$DATA(^DIC("B",BMXFL))
SET BMXFL=""
QUIT
+22 SET BMXFL=$ORDER(^DIC("B",BMXFL,0))
End DoDot:1
+23 IF '$GET(BMXFL)
DO ERROUT^BMXRPC("File number not provided.",1)
QUIT
+24 ;
+25 ;---> If no such file, return error.
+26 IF '$DATA(^DD(BMXFL,0))
DO ERROUT^BMXRPC("File does not exist.",1)
QUIT
+27 ;
+28 ;---> Validate screen code
+29 IF $GET(BMXSCR)=""
SET BMXSCR="I 1"
+30 SET X=$GET(BMXSCR)
+31 IF X]""
DO ^DIM
+32 ;Default to no screen
IF '$DATA(X)
SET BMXSCR="I 1"
+33 ;
+34 ;---> Set Target Global for output and errors.
+35 SET BMXG="BMXTMP($J,""DID"")"
+36 ;
+37 ;---> Loop through ^DD(FileNumber,FieldNumber,0) to get field names
+38 KILL BMXTMP($JOB)
+39 ;Changed from NAME to LABEL
IF $GET(BMXATTR)=""
SET BMXATTR="LABEL"
+40 ;---> Attribute Names
+41 FOR I=1:1:$LENGTH(BMXATTR,";")
SET BMXT($PIECE(BMXATTR,";",I))=""
+42 SET (BMX,BMXC)=0
FOR
SET BMX=$ORDER(BMXT(BMX))
IF BMX=""
QUIT
Begin DoDot:1
+43 SET BMXC=BMXC+1
+44 SET $PIECE(BMXT,U,BMXC)="T00030"_BMX
End DoDot:1
+45 SET BMXTMP($JOB,1)="T00030NUMBER"_U_BMXT_$CHAR(30)
+46 ;
+47 ;S BMXFLD=0 F I=2:1 S BMXFLD=$O(^DD(BMXFL,BMXFLD)) Q:'+BMXFLD D
+48 SET BMXTMP($JOB,2)=".001^BMXIEN"_$CHAR(30)
+49 SET BMXFLDN=0
FOR I=3:1
SET BMXFLDN=$ORDER(^DD(BMXFL,"B",BMXFLDN))
IF BMXFLDN=""
QUIT
Begin DoDot:1
+50 SET BMXFLD=$ORDER(^DD(BMXFL,"B",BMXFLDN,0))
IF '+BMXFLD
QUIT
+51 XECUTE BMXSCR
IF '$TEST
QUIT
+52 DO FIELD^DID(BMXFL,BMXFLD,,BMXATTR,BMXG,BMXG)
+53 KILL BMXT
SET (BMXC,BMX)=0
+54 FOR
SET BMX=$ORDER(BMXTMP($JOB,"DID",BMX))
IF BMX=""
QUIT
Begin DoDot:2
+55 SET BMXC=BMXC+1
+56 SET $PIECE(BMXT,U,BMXC)=BMXTMP($JOB,"DID",BMX)
End DoDot:2
+57 SET BMXTMP($JOB,I)=BMXFLD_U_$TRANSLATE(BMXT," ","_")_$CHAR(30)
End DoDot:1
+58 ;S I=I+1,BMXTMP($J,I)=".001^BMXIEN"_$C(30)
+59 SET I=I+1
+60 KILL BMXTMP($JOB,"DID")
+61 ;---> Tack on Error Delimiter and any error.
+62 SET BMXTMP($JOB,I)=BMX31_BMXERR
+63 QUIT
+64 ;
MLTLIST(BMXGBL,BMXFL,BMXONEOK) ;EP
+1 ;Returns list of multiple fields in file BMXFL, returns only one field
+2 ;if BMXONEOK is TRUE
+3 ;S ^HW($H,"MLTLIST","FL")=BMXFL
+4 ;S ^HW($H,"MLTLIST","ONE")=BMXONEOK
+5 NEW BMX31,BMXERR,BMXG,BMXFLD,BMX,BMXC,BMXT,I
+6 SET BMX31=$CHAR(31)_$CHAR(31)
+7 SET BMXGBL="BMXTMP("_$JOB_")"
SET BMXERR=""
SET U="^"
+8 KILL BMXTMP($JOB)
+9 ;
+10 ;---> If file number not provided check for file name.
+11 IF +BMXFL'=BMXFL
Begin DoDot:1
+12 SET BMXFL=$TRANSLATE(BMXFL,"_"," ")
+13 IF '$DATA(^DIC("B",BMXFL))
SET BMXFL=""
QUIT
+14 SET BMXFL=$ORDER(^DIC("B",BMXFL,0))
End DoDot:1
+15 IF '$GET(BMXFL)
DO ERROUT^BMXRPC("File number not provided.",1)
QUIT
+16 ;
+17 ;---> If no such file, return error.
+18 IF '$DATA(^DD(BMXFL,0))
DO ERROUT^BMXRPC("File does not exist.",1)
QUIT
+19 ;
+20 ;---> Column Headers
+21 SET BMXTMP($JOB,1)="T00030NUMBER"_U_"T00030NAME"_$CHAR(30)
+22 ;
+23 ;---> $O thru ^DD(BMXFL,"SB" to get subfile numbers and names
+24 SET I=2
+25 NEW BMXSB,BMXSBN,BMXSBF,BMXFOUND
+26 SET BMXFOUND=0
+27 IF $DATA(^DD(BMXFL,"SB"))
Begin DoDot:1
+28 SET BMXSB=0
+29 FOR
SET BMXSB=$ORDER(^DD(BMXFL,"SB",BMXSB))
IF '+BMXSB
QUIT
Begin DoDot:2
+30 SET BMXSBF=$ORDER(^DD(BMXFL,"SB",BMXSB,0))
+31 IF '+BMXSBF
QUIT
+32 SET BMXSBN=$GET(^DD(BMXFL,BMXSBF,0))
+33 IF BMXSBN=""
QUIT
+34 SET BMXZ=$GET(^DD(BMXSB,.01,0))
+35 IF $PIECE(BMXZ,U,2)["W"
QUIT
+36 SET BMXFOUND=1
+37 SET BMXSBN=$PIECE(BMXSBN,U)
+38 SET BMXTMP($JOB,I)=BMXSB_U_BMXSBN_$CHAR(30)
+39 SET I=I+1
End DoDot:2
IF BMXFOUND
IF BMXONEOK=1
QUIT
End DoDot:1
+40 ;
+41 ;---> Tack on Error Delimiter and any error.
+42 SET BMXTMP($JOB,I)=BMX31_BMXERR
+43 QUIT
