source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADO.m@ 1166

BMXADO  ; IHS/CIHA/GIS - RPC CALL: GENERATE AN ADO SCHEMA STRING AND DATA SET ;
        ;;2.3;BMX;;Jan 25, 2011
        ; SS^BMXADO: RPC EP FROM WINDOWS/WEB APP TO GENERATE A SCHEMEA STRING (& OPTIONALLY, A DATA SET AS WELL)
        ; THE SCHEMA DEFINITION AND MAP IS STORED IN THE 'BMX ADO SCHEMA' FILE
        ; THIS ROUTINE GENERATES THE SCHEMA STRING.  BMXADOV GENERATES THE DATA SET THAT GOES WITH THE SCHEMA STRING.
        ; IF THERE IS AN ERROR, XXX(1) WILL CONTAIN "ERROR|msg"_$C(30) WHERE 'msg' IS THE ERROR MESSAGE
        ;  E.G."ERROR|Invalid schema IEN"
        ;
        ;
SSD(OUT,SIEN,DAS,VSTG,JSTG)     ;Debug entry point
        D DEBUG^%Serenji("SS^BMXADO(.OUT,SIEN,DAS,VSTG,JSTG)")  ; DEBUGGER ENTRY POINT
        Q
        ;
        ; 
SS(OUT,SIEN,DAS,VSTG,JSTG)      ; EP - RETURN THE SCHEMA STRING IN AN ARRAY
        ; OUT=OUTPUT VARIABLE (PASSED BY REFERENCE)
        ;   THE OUTPUT ARRAY IS GENERATED FROM DATA IN THE 'BMX ADO SCHEMA' FILE AND THE FILEMAN DATABASE
        ;   RECORDS ARE SEPARATED WITH $C(30).  FIELDS ARE SEPARATED BY "^".  FIELD PROPERTIES ARE SEPARATED BY "|".
        ;   ONE RECORD PER OUTPUT NODE.
        ;   1ST RECORD IS THE "INTRODUCTION RECORD": "@@@meta@@@BMXIEN|FILE #|DA STRING"
        ;   THE SECOND RECORD IS THE HEADER RECORD.  THE REST ARE THE DATA RECORDS
        ;   RECORD FORMAT: FILE#|FIELD#|DATA TYPE|LENGTH|FIELDNAME|READONLY|KEYFIELD|NULLOK_$C(30)
        ; SIEN=SCHEMA NAME OR IEN FROM BMX ADO SCHEMA FILE
        ; DAS= "DA" STRING: STRING FOR DEFINING PARENT FILES
        ;    EXAMPLE: "4,8," CORRESPONDS TO DA(2), DA(1).
        ;    PRIMARILY  USED AS A "SEED" FOR RE-ENTRY - IF INDEX IS PRESENT.
        ;    IF NOT A SEED, DO NOT INCLUDE THE BOTTOM LEVEL IEN: DA; E.G., "4,8,"
        ;    DO NOT CONFUSE WITH "IENS STRING" OF FILEMAN SILENT CALLS
        ; VSTG=VIEW STRING INSTRUCTIONS (SEE BMXADOV FOR DETAILS)
        ; JSTG=JOIN STRING INSTRUCTIONS (SEE BMXADOVJ FOR DETAILS)
        ; 
        N X,Y,DIC,ERR
        S OUT=$NA(^TMP("BMX ADO",$J)) K @OUT ; DEFINE THE OUTPUT ARRAY CLOSED REFERENCE
        X ("S "_$C(68)_"UZ(0)=$C(64)") ; INSURE PRIVELEGES
        S X="MERR^BMXADO",@^%ZOSF("TRAP") ; SET MUMPS ERROR TRAP
        I '$L(SIEN) S ERR="Missing schema ID" D ERR(ERR) Q
        I 'SIEN S DIC="^BMXADO(",DIC(0)="M",X=SIEN D ^DIC S SIEN=+Y I Y=-1 S ERR="Invalid schema ID" D ERR(ERR) Q
        I '$D(^BMXADO(SIEN,0)) S ERR="Invalid/missing schema" D ERR(ERR) Q  ; SCHEMA MUST EXIST
        N FIEN,FLDIEN,TOT,STG,B,C,X,%,LEVEL,Y,SF
        S FIEN=$P(^BMXADO(SIEN,0),U,2)
        I '$D(^DD(FIEN,0)) S ERR="Invalid/missing file number in schema file" D ERR(ERR) Q  ; INVALID FILE NUMBER
        S SF=$$CKSUB(FIEN,DAS) I SF=-1 S ERR="Invalid DA string" D ERR(ERR) Q  ; INVALID DA STRING
        S C=",",B="|",TOT=0 ; THESE LOCALS, ALONG WITH KERNEL VARIABLES, ARE ALWAYS AVAILABLE TO ALL ROUTINES AND SUBROUTINES
JEP     ; EP-RECURSION RE-ENTRY POINT FOR JOINS
        I $G(SUB),$G(SF) S ERR="Invalid request" D ERR(ERR) Q  ; CAN'T DO JOIN  WITH A SUBFILE AS THE PRIMARY FILE
        S TOT=TOT+1,@OUT@(TOT)="@@@meta@@@BMXIEN"_B_FIEN_B_DAS_U
        I $G(SUB) S TOT=TOT+1,@OUT@(TOT)=FIEN_"|.0001|N|15|DA(1)|TRUE|FALSE|FALSE^"
        I $G(SF) D SFH(SF) ; SUBFILE HEADERS
        S TOT=TOT+1,@OUT@(TOT)=FIEN_"|.001|N|15|BMXIEN|TRUE|TRUE|FALSE^" ; KEY FIELD PART OF HEADER RECORD
        S FLDIEN=0
        F  S FLDIEN=$O(^BMXADO(SIEN,1,FLDIEN)) Q:'FLDIEN  S STG=$G(^BMXADO(SIEN,1,FLDIEN,0)) I $L(STG) D  ; REST OF HEADER RECORD
        . S X=FIEN_B_$P(STG,U)_B_$P(STG,U,2)_B_$P(STG,U,3)_B_$P(STG,U,4)_B
        . S %=$S($P(STG,U,5):"TRUE",$P($G(^BMXADO(+$G(IEN),0)),U,3):"TRUE",1:"FALSE") S X=X_%_B ; READ ONLY
        . S %=$S($P(STG,U,6):"TRUE",1:"FALSE") S X=X_%_B ; THIS IS A KEY FIELD
        . S %=$S($P(STG,U,7):"TRUE",1:"FALSE") S X=X_%_U ; NULL VALUE IS OK (NOT MANDATORY FOR TRANSACTION)
        . S TOT=TOT+1
        . S @OUT@(TOT)=X
        . Q
        I TOT'>2 Q  ; NOTHING TO PROCESS
        S %=@OUT@(TOT) I $E(%,$L(%))=U S $E(%,$L(%))=$C(30),@OUT@(TOT)=% ; END OF RECORD MARKER
        I $G(VSTG)="",$G(DFLD)=.001 S VSTG="~~~" ; SIMPLE LOOKUP INTO DETAILS FILE BY IEN
        I '$L($G(VSTG)) Q  ; REQUEST IS FOR SCHEMA ONLY - NO DATA
DATASET S VSTG=SIEN_"~"_DAS_"~"_VSTG
        I $O(^TMP("BMX JOIN",$J,1,+$G(SDETAIL),0)) D JVIEW Q  ; JOIN ITERATION ; NO SUPPORT FOR EXTENDED JOINS
        D VIEW^BMXADOV(.OUT,VSTG,.TOT) ; APPEND A DATA SET TO A SCHEMA STRING
        I '$L($G(JSTG)) S JSTG=$P(VSTG,"~",11,999) ; INCLUDED FOR BKWD COMPATIBILITY ;JOIN INSTRUCTIONS SPAN MULTIPLE ~ PIECES (11,999) BECAUSE OF POSSIBLE NESTED VSTG
        I $L(JSTG) D JOIN^BMXADOVJ(SIEN,JSTG) ; ADD DATA SET(S) TO FULFIL THE JOIN REQUEST
        Q
        ;
JVIEW   ; JOIN VIEW - SET XCNT AND RESET THE VSTG
        N XCNT,DA,NODE,%
        S NODE=999999999999
        F  S NODE=$O(@OUT@(NODE),-1) Q:'NODE  I @OUT@(NODE)["|.001|" Q
        I 'NODE Q  ; INVALID SCHEMA - JOIN CANCELLED
        I '$L($P(VSTG,"~",3)),'$G(SUB),$G(DFLD)'=.001 Q  ; THERE MUST BE AN INDEX OR SUBFILE FOR A JOIN TO TAKE PLACE
        D JFLD^BMXADOVJ ; STUFF VALUES FOR JOIN FLDS INTO INTRO SEGMENT OF THE SCHEMA
        S XCNT=NODE
        S DA=0
        F  S DA=$O(^TMP("BMX JOIN",$J,1,SDETAIL,DA)) Q:'DA  D  D VIEW^BMXADOV(.OUT,VSTG,.TOT) ; APPEND JOINED DATA SETS TO A SCHEMA STRING
        . I $P(VSTG,"~",3)="AA",$L($P(VSTG,"~",10)) D  Q
        .. S %=$P(VSTG,"~",10)
        .. S $P(%,"|",1)=DA
        .. S $P(VSTG,"~",10)=%
        .. Q
        . I $G(SUB) S DAS=DA_",",VSTG=SDETAIL_"~"_DA_",~~" Q  ; SUBFILE ITERATOR
        . I $P(VSTG,"~",3)="AA",$G(FIEN)=9000011 S $P(VSTG,"~",4,5)=DA_"~"_DA Q  ; PROBLEM LIST ITERATOR
        . S $P(VSTG,"~",4,5)=DA_"~"_DA ; SINGLE IEN ITERATOR
        . Q
        Q
        ; 
SFH(DAS)        ; SUBFILE HEADERS
        N L,LEV,PCE,X,%,Z,FLD
        S Z="000000000",L=$L(DAS,",")
        F PCE=1:1:L-1 D
        . S LEV=(L+1)-PCE
        . S FLD="."_$E(Z,1,LEV+1)_1
        . S TOT=TOT+1
        . S @OUT@(TOT)=FIEN_B_FLD_"|I|10|BMXIEN"_(LEV-1)_"|TRUE|TRUE|FALSE"_U ; FIX
        . Q
        Q
        ; 
CKSUB(FILE,DAS) ; CHECK THE DA STRING FOR VALIDITY AND MAKE THE DA ARRAY
        N LEVEL,FIEN
        S FIEN=FILE
        F LEVEL=1:1 S FIEN=$G(^DD(FIEN,0,"UP")) Q:'FIEN  ; COUNT THE LEVELS
        I LEVEL'=$L($G(DAS),",") Q -1 ; LEVEL MATCHES DA STRING
        I LEVEL=1 Q "" ; INVALID DA STRING
        Q DAS
        ; 
LINE(FILE)      ; GET FIELD VALUES
        N LINE,NODE,STG,DIR,FLD,PF,SET,X,DS,DP
        S LINE=""
        S NODE=2,Y="" F  S NODE=$O(ARR(NODE)) Q:'NODE  S STG=ARR(NODE) I $L(STG) D  I Y=U Q
        . S FLD=$P(STG,B,2) I 'FLD S Y=U Q
        . I $P(STG,B,6)="TRUE" Q  ; READ ONLY
        . S DIR("A")=$P(STG,B,5) I '$L(DIR("A")) S Y=U Q
        . S X=$P($G(^DD(+$G(FILE),FLD,0)),U,2)
        . I X["P" D  Q
        .. S PF=+$P(X,"P",2) I 'PF S Y=U Q
        .. S DIR(0)="P^"_PF_":EQMZ"
        .. D DIR
        .. Q
        . I X["S" D  Q
        .. S DIR(0)="S^"_$P(^DD(FILE,FLD,0),U,3)
        .. D DIR
        .. Q
        . I X["D" D  Q
        .. S DS=$P(^DD(FILE,FLD,0),U,5)
        .. I DS'["%DT=""" S DIR(0)="D^::EX" D DIR Q
        .. S DP=$P(DS,"%DT="_$C(34),2) S DP=$P(DP,$C(34,32),1)
        .. S DIR(0)="D^::"_DP
        .. D DIR
        .. Q
        . S DIR="F"
        . D DIR
        . Q
        Q LINE
        ; 
DIR     D ^DIR
        I Y?1."^" S Y=U Q
        I Y?1.N1"^".E S Y="`"_+Y
        S LINE=LINE_U_Y
        Q
        ;
MERR    ; MUMPS ERROR TRAP
        N X
        X ("S X=$"_"ZE")
        S X="MUMPS error: """_X_""""
        D ERR(X)
        Q
        ;
ERR(ERR)        ;EP - BMX ADO SCHEMA ERROR PROCESSOR
        N X
        S X="ERROR|"_ERR_$C(30)
        S @OUT@(1)=X
        Q
        ;