BMXADOS1 ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE GUI VERSION ;
;;4.0;BMX;;JUN 28, 2010
; RPC CALLS
;
;
;
DISP(OUT) ; TEMP DISPLAY
N I,X
S I=0 W !
F S I=$O(@OUT@(I)) Q:'I S X=@OUT@(I) S X=$TR(X,$C(30),"}") S X=$TR(X,$C(31),"{") W !,X
Q
;
SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN
N IEN
S IEN=$O(^BMXADO("B",NAME,0))
Q IEN
;
FILE ; RETURN A LIST OF FILES
N OUT,%,SIEN
S SIEN=$$SCHEMA("FILEMAN FILES")
D SS^BMXADO(.OUT,SIEN,"","B~B~C~")
D DISP(OUT) R %:$G(DTIME,60) ; IHS/OIT/HMW SAC Exemption Applied For
K ^TMP("BMX ADO",$J)
Q
;
SF ; RETURN A LIST OF SUBFILES
N OUT,%,SIEN
S SIEN=$$SCHEMA("SUBFILES")
D SS^BMXADO(.OUT,SIEN,"","~~~~~SFIT~BMXADOS1~2~")
D DISP(OUT) R %:$G(DTIME,60) ; IHS/OIT/HMW SAC Exemption Applied For
K ^TMP("BMX ADO",$J)
Q
;
FLD ; RETURN LIST OF FIELDS FOR A FILE OR SUBFILE
N OUT,%,SIEN
S SIEN=$$SCHEMA("FIELDS")
D SS^BMXADO(.OUT,SIEN,"","~~~~~FLDIT~BMXADOS1~2~")
D DISP(OUT) R %:$G(DTIME,60) ; IHS/OIT/HMW SAC Exemption Applied For
K ^TMP("BMX ADO",$J)
Q
;
SCH ; RETURN A LIST OF SCHEMAS
N OUT,%,SIEN
S SIEN=$$SCHEMA("SCHEMAS")
D SS^BMXADO(.OUT,SIEN,"","B~~~")
D DISP(OUT) R %:$G(DTIME,60) ; IHS/OIT/HMW SAC Exemption Applied For
K ^TMP("BMX ADO",$J)
Q
;
SD ; RETURN THE SCHEMA DEFINITION
N OUT,%,SIEN
S SIEN=$$SCHEMA("SCHEMA DEFINITION")
D SS^BMXADO(.OUT,SIEN,"52,","~~~")
D DISP(OUT) R %:$G(DTIME,60) ; IHS/OIT/HMW SAC Exemption Applied For
K ^TMP("BMX ADO",$J)
Q
;
FLDIT(PARAM,IENS,MAX,OUT,TOT) ; CUSTOM ITERATOR TO DISPLAY FIELDS
N SFARR,CNT,DEL,NUM,NAME,DDT,DLEN,DHDR,DRO,DKEY,DNA,X,Y
D FLIST^BMXADOS(.SFARR,PARAM)
S CNT=0,DEL=" ["
F S CNT=$O(SFARR(CNT)) Q:'CNT D
. S X=SFARR(CNT) I '$L(X) Q
. S NAME=$P(X,DEL)
. ; F Q:$E(NAME)'=" " S NAME=$E(NAME,2,999)
. I '$L(NAME) Q
. S NUM=+$P(X,DEL,2) I 'NUM Q
. S TOT=TOT+1
. S Y=$$FDEF^BMXADOS(PARAM,NUM) I '$L(Y) Q ; ""
. S DDT=$E(Y),DLEN=+$E(Y,2,6),DHDR=$E(Y,7,99)
. S DRO="NO" S DKEY="NO" S DNA="YES"
. S ^TMP("BMX ADO",$J,TOT)=NUM_U_NAME_U_DDT_U_DLEN_U_DHDR_U_DRO_U_DKEY_U_DNA_$C(30)
Q ""
;
FNIT(PARAM,IENS,MAX,OUT,TOT) ; CUSTOM ITERATOR TO DISPLAY FILE OR SUBFILE NAME GIVEN FILE NUMBER
N NUM,NAME
S NUM=+PARAM
S NAME=""
Q:'$D(^DD(NUM,0,"NM")) ""
S NAME=$O(^DD(NUM,0,"NM",0))
S TOT=TOT+1
S ^TMP("BMX ADO",$J,TOT)=NUM_U_NAME_$C(30)
Q ""
;
SFIT(PARAM,IENS,MAX,OUT,TOT) ; CUSTOM ITERATOR TO DISPLAY SUBFILES
N SFARR,CNT,DEL,NUM,NAME
D SC^BMXADOS(.SFARR,PARAM)
S CNT=0,DEL=" ("
F S CNT=$O(SFARR(CNT)) Q:'CNT D
. S X=SFARR(CNT) I '$L(X) Q
. S NAME=$P(X,DEL)
. ; F Q:$E(NAME)'=" " S NAME=$E(NAME,2,999)
. I '$L(NAME) Q
. S NUM=+$P(X,DEL,2) I 'NUM Q
. S TOT=TOT+1
. S ^TMP("BMX ADO",$J,TOT)=NUM_U_NAME_$C(30)
Q ""
;
SFT(FNAME) ; TRIGGER "YES" TO INDICATE THAT A SUBFILE IS PRESENT WITHIN A FILE
I '$L($G(FNAME)) Q ""
N FIEN
S FIEN=$O(^DIC("B",FNAME,0))
I 'FIEN Q ""
I '$O(^DD(FIEN,"SB",0)) Q ""
Q "+"
;
BMXADOS1 ; IHS/CIHA/GIS - UPDATE THE BMX ADO SCHEMA FILE GUI VERSION ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ; RPC CALLS
+3 ;
+4 ;
+5 ;
DISP(OUT) ; TEMP DISPLAY
+1 NEW I,X
+2 SET I=0
WRITE !
+3 FOR
SET I=$ORDER(@OUT@(I))
IF 'I
QUIT
SET X=@OUT@(I)
SET X=$TRANSLATE(X,$CHAR(30),"}")
SET X=$TRANSLATE(X,$CHAR(31),"{")
WRITE !,X
+4 QUIT
+5 ;
SCHEMA(NAME) ; GIVEN SCHEMA NAME, RETURN THE IEN
+1 NEW IEN
+2 SET IEN=$ORDER(^BMXADO("B",NAME,0))
+3 QUIT IEN
+4 ;
FILE ; RETURN A LIST OF FILES
+1 NEW OUT,%,SIEN
+2 SET SIEN=$$SCHEMA("FILEMAN FILES")
+3 DO SS^BMXADO(.OUT,SIEN,"","B~B~C~")
+4 ; IHS/OIT/HMW SAC Exemption Applied For
DO DISP(OUT)
READ %:$GET(DTIME,60)
+5 KILL ^TMP("BMX ADO",$JOB)
+6 QUIT
+7 ;
SF ; RETURN A LIST OF SUBFILES
+1 NEW OUT,%,SIEN
+2 SET SIEN=$$SCHEMA("SUBFILES")
+3 DO SS^BMXADO(.OUT,SIEN,"","~~~~~SFIT~BMXADOS1~2~")
+4 ; IHS/OIT/HMW SAC Exemption Applied For
DO DISP(OUT)
READ %:$GET(DTIME,60)
+5 KILL ^TMP("BMX ADO",$JOB)
+6 QUIT
+7 ;
FLD ; RETURN LIST OF FIELDS FOR A FILE OR SUBFILE
+1 NEW OUT,%,SIEN
+2 SET SIEN=$$SCHEMA("FIELDS")
+3 DO SS^BMXADO(.OUT,SIEN,"","~~~~~FLDIT~BMXADOS1~2~")
+4 ; IHS/OIT/HMW SAC Exemption Applied For
DO DISP(OUT)
READ %:$GET(DTIME,60)
+5 KILL ^TMP("BMX ADO",$JOB)
+6 QUIT
+7 ;
SCH ; RETURN A LIST OF SCHEMAS
+1 NEW OUT,%,SIEN
+2 SET SIEN=$$SCHEMA("SCHEMAS")
+3 DO SS^BMXADO(.OUT,SIEN,"","B~~~")
+4 ; IHS/OIT/HMW SAC Exemption Applied For
DO DISP(OUT)
READ %:$GET(DTIME,60)
+5 KILL ^TMP("BMX ADO",$JOB)
+6 QUIT
+7 ;
SD ; RETURN THE SCHEMA DEFINITION
+1 NEW OUT,%,SIEN
+2 SET SIEN=$$SCHEMA("SCHEMA DEFINITION")
+3 DO SS^BMXADO(.OUT,SIEN,"52,","~~~")
+4 ; IHS/OIT/HMW SAC Exemption Applied For
DO DISP(OUT)
READ %:$GET(DTIME,60)
+5 KILL ^TMP("BMX ADO",$JOB)
+6 QUIT
+7 ;
FLDIT(PARAM,IENS,MAX,OUT,TOT) ; CUSTOM ITERATOR TO DISPLAY FIELDS
+1 NEW SFARR,CNT,DEL,NUM,NAME,DDT,DLEN,DHDR,DRO,DKEY,DNA,X,Y
+2 DO FLIST^BMXADOS(.SFARR,PARAM)
+3 SET CNT=0
SET DEL=" ["
+4 FOR
SET CNT=$ORDER(SFARR(CNT))
IF 'CNT
QUIT
Begin DoDot:1
+5 SET X=SFARR(CNT)
IF '$LENGTH(X)
QUIT
+6 SET NAME=$PIECE(X,DEL)
+7 ; F Q:$E(NAME)'=" " S NAME=$E(NAME,2,999)
+8 IF '$LENGTH(NAME)
QUIT
+9 SET NUM=+$PIECE(X,DEL,2)
IF 'NUM
QUIT
+10 SET TOT=TOT+1
+11 ; ""
SET Y=$$FDEF^BMXADOS(PARAM,NUM)
IF '$LENGTH(Y)
QUIT
+12 SET DDT=$EXTRACT(Y)
SET DLEN=+$EXTRACT(Y,2,6)
SET DHDR=$EXTRACT(Y,7,99)
+13 SET DRO="NO"
SET DKEY="NO"
SET DNA="YES"
+14 SET ^TMP("BMX ADO",$JOB,TOT)=NUM_U_NAME_U_DDT_U_DLEN_U_DHDR_U_DRO_U_DKEY_U_DNA_$CHAR(30)
End DoDot:1
+15 QUIT ""
+16 ;
FNIT(PARAM,IENS,MAX,OUT,TOT) ; CUSTOM ITERATOR TO DISPLAY FILE OR SUBFILE NAME GIVEN FILE NUMBER
+1 NEW NUM,NAME
+2 SET NUM=+PARAM
+3 SET NAME=""
+4 IF '$DATA(^DD(NUM,0,"NM"))
QUIT ""
+5 SET NAME=$ORDER(^DD(NUM,0,"NM",0))
+6 SET TOT=TOT+1
+7 SET ^TMP("BMX ADO",$JOB,TOT)=NUM_U_NAME_$CHAR(30)
+8 QUIT ""
+9 ;
SFIT(PARAM,IENS,MAX,OUT,TOT) ; CUSTOM ITERATOR TO DISPLAY SUBFILES
+1 NEW SFARR,CNT,DEL,NUM,NAME
+2 DO SC^BMXADOS(.SFARR,PARAM)
+3 SET CNT=0
SET DEL=" ("
+4 FOR
SET CNT=$ORDER(SFARR(CNT))
IF 'CNT
QUIT
Begin DoDot:1
+5 SET X=SFARR(CNT)
IF '$LENGTH(X)
QUIT
+6 SET NAME=$PIECE(X,DEL)
+7 ; F Q:$E(NAME)'=" " S NAME=$E(NAME,2,999)
+8 IF '$LENGTH(NAME)
QUIT
+9 SET NUM=+$PIECE(X,DEL,2)
IF 'NUM
QUIT
+10 SET TOT=TOT+1
+11 SET ^TMP("BMX ADO",$JOB,TOT)=NUM_U_NAME_$CHAR(30)
End DoDot:1
+12 QUIT ""
+13 ;
SFT(FNAME) ; TRIGGER "YES" TO INDICATE THAT A SUBFILE IS PRESENT WITHIN A FILE
+1 IF '$LENGTH($GET(FNAME))
QUIT ""
+2 NEW FIEN
+3 SET FIEN=$ORDER(^DIC("B",FNAME,0))
+4 IF 'FIEN
QUIT ""
+5 IF '$ORDER(^DD(FIEN,"SB",0))
QUIT ""
+6 QUIT "+"
+7 ;
