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

BMXADO.m

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