BMXADOV1 ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ; ;;2.1;BMX;;Jul 26, 2009 ; CONTINUATION FILE FOR BMXADOV ; MANAGES ITERATION FOR INDIVIDUAL INDEX TYPES ; ASSUMES CERTAIN LOCAL VARS: CREF,FIEN,IENS,DAS (<-THESE CAN'T BE NULL),START,STOP,MAX,TOT,NUM,IX ; ; ; DATA(IENS,DA,XCNT) ;EP - ADD DATA NODES TO ARRAY ; ASSUMES THAT VSTG VARIABLES AND THE OUT ARRAY ARE PRESENT I '$G(DA) Q I '$L(IENS) Q S $P(IENS,C)=DA N STG,X,Y,%,FLD,STOP,VAL,CNT,FIEN,LINE,IFLAG,IDEP,TFLD,TNO,TEF S STG=DA I $G(DAS),$E(DAS,$L(DAS))="," S STG=$TR(DAS,",",U)_STG ; FIX FOR SUBFILE S CNT=$L(IENS,",") ; START AFTER THE .001 FIELD I $G(SUB) S STG=$P(IENS,C,2)_U_DA ; MAKE DAS FOR A SUBFILE. THIS WILL BE THE IST PIECE OF THE DATA STRING I $G(XCNT) S CNT=XCNT ; USED WITH JOINS F S CNT=$O(@OUT@(CNT)) Q:'CNT Q:$G(STOP) D I @OUT@(CNT)[$C(30) Q ; LOOP TO CREATE THE DATA STRING . K IFLAG,IDEP . S FIEN=+@OUT@(CNT) I '$D(^DD(FIEN,0)) S STOP=1 Q . S FLD=$P(@OUT@(CNT),B,2) . I FLD=".01ID" D Q ; PROCESS THE IDENTIFIER FIELD .. I '$G(SIEN) Q .. S %=$O(^BMXADO(SIEN,1,"B",".01ID",0)) I '% Q .. S IDEP=$G(^BMXADO(SIEN,1,%,1)) I '$L(IDEP) Q .. X ("S VAL=$$"_IDEP_"("_+STG_")") ; PASS THE DA TO THE IDENTIFIER EXTRINSIC FUNCTION, RETURN IDENTIFIERS .. S VAL=$TR(VAL,"^",""),VAL=$TR(VAL,B,"") .. S STG=STG_U_VAL .. Q . I $G(SIEN),FLD S %=$O(^BMXADO(SIEN,1,"B",FLD,0)) I %,$P($G(^BMXADO(SIEN,1,%,0)),U,9) S IFLAG=1 ; SCHEMA FILE SAYS FORCE INTERNAL VALUE FOR THIS FIELD . K TFLD . I FLD["TRIGGER" S TFLD=FLD,FLD=+FLD,IFLAG=1 . I FLD["IEN" S FLD=+FLD,IFLAG=1 ; LOOKUP VALUE FIELD (IEN) . I '$D(^DD(FIEN,FLD,0)),FLD'=.001 S STOP=1 Q . I $D(TFLD),FLD=.001 S VAL=+IENS . E S VAL=$$GET1^DIQ(FIEN,IENS,FLD,$S($G(IFLAG):"I",$G(TFLAG):"I",1:$G(FMT))) . I $G(TFLD) D S STG=STG_U_VAL Q ; GENERATE A TRIGGERED VALUE FOR THIS FIELD .. S TNO=$O(^BMXADO(SIEN,1,"B",TFLD,0)) I 'TNO S VAL="" Q .. S TEF=$G(^BMXADO(SIEN,1,TNO,3)) I '$L(TEF) S VAL="" Q ; GET EXTR FUNCT THAT GENERATES A SECONDARY VALUE .. X ("S VAL=$$"_TEF_"(VAL)") .. Q . I FLD=.01,VAL="" S STOP=1 Q ; INVALID FILEMAN ENTRY! SKIP IT . S VAL=$TR(VAL,"^",""),VAL=$TR(VAL,B,"") . S STG=STG_U_VAL . Q I $G(STOP) Q ; DON'T ADD NODE IF DD INFO IS INVALID F S LINE=$E(STG,1,250),STG=$E(STG,251,999999) D I '$L(STG) Q ; PREVENTS DATA LENGTH FROM EXCEEDING 250 BYTES . S TOT=TOT+1 . I '$L(STG) S LINE=LINE_$C(30),NUM=NUM+1 ; END OF RECORD, RECORD TOTAL IS UPDATED . S @OUT@(TOT)=LINE ; NODE IS ADDED . Q Q ; NUMIT(DA) ; EP-ITERATE BY NUMBER N XIT,LDA I IENS S DA=+IENS ; RE-ENTRY FROM SEED I '$G(DA),$G(START) S DA=START-1 I '$G(DA) S DA=0 S LDA="" F S DA=$O(@CREF@(DA)) D I $G(XIT) Q . I 'DA S XIT=1,LDA="" Q ; NO MORE IENS - THE END OF THE LINE . D DATA(IENS,DA,+$G(XCNT)) . I $G(STOP),$O(@CREF@(DA))>STOP S LDA="",XIT=1 Q ; AS FAR AS YOU ARE ALLOWED TO GO FOR NUMBER ITERATION . I NUM=MAX S LDA=DA,XIT=1 Q ; REACHED THE MAX TRANSACTION LIMIT - GET MORE NEXT TIME . Q I LDA,'$O(@CREF@(LDA)) S LDA="" ; END OF THE LINE SO SET LDA TO NULL Q LDA ; LOOK(LIEN) ; EP-ITERATE BY A SINGLE STANDARD INDEX THAT IS A POINTER VALUE N XIT,LDA S DA=+IENS F S DA=$O(@CREF@(IX,LIEN,DA)) D I $G(XIT) Q . I 'DA S XIT=1,LDA="" Q ; NO MORE IENS - THE END OF THE LINE . D DATA(IENS,DA,$G(XCNT)) . I NUM=MAX S LDA=DA,XIT=1 Q ; REACHED THE MAX TRANSACTION LIMIT - GET MORE NEXT TIME . Q I '$O(@CREF@(IX,LIEN,DA)) Q "" Q LDA ; LOOK1() ; EP-ITERATE USING A STANDARD INDEX N XIT,LDA,VAL,DA,% S DA=+IENS I 'DA G SCRATCH ; CHECK FOR RE-RENTRY REENTER ; RE-ENTER STD ITERATION USING DA AS THE SEED S %=$$IXVAL(FIEN,IX,DAS) I '$L(%) Q "" ; GET STARTUP INFO LR S VAL=$P(%,B,3) I VAL="" Q "" ; NO VAL FOUND FOR INITIAL ITERATION, SO QUIT F S DA=$O(@CREF@(IX,VAL,DA)) Q:'DA D DATA(IENS,DA,+$G(XCNT)) I NUM=MAX S LDA=DA,XIT=1 Q ; SWEEP UP ALL THE REMAINING DAS UNDER THE CURRENT VALUE I $G(XIT) Q:'$O(@CREF@(IX,VAL,LDA)) "" Q LDA ; IF NO MORE AFTER MAX, SET LDA = NULL G LOOK1R ; SEED IS DEFINED SCRATCH S VAL="" ; STD LOOKUP STARTING FROM SCRATCH I $L(START) S VAL=$O(@CREF@(IX,START),-1) ; GET SEED FOR ITERATION LOOK1R F S VAL=$O(@CREF@(IX,VAL)) D I $G(XIT) Q ; EP - RE-ENTRY POINT IF SEED IS DEFINED . I VAL="" S LDA="",XIT=1 Q ; END OF THE LINE . I STOP=+STOP,VAL=+VAL,VAL>STOP S LDA="",XIT=1 Q . I $L(STOP),VAL]STOP S LDA="",XIT=1 Q ; LOOKUP LIMITS . S DA=0 . F S DA=$O(@CREF@(IX,VAL,DA)) Q:'DA D I $G(XIT) Q .. D DATA(IENS,DA,+$G(XCNT)) .. I NUM=MAX S LDA=DA,XIT=1 D ; TRANSACTION LIMIT ; CHECK FOR MORE ... I $O(@CREF@(IX,VAL,DA)) Q ... S %=$O(@CREF@(IX,VAL)) I %="" S LDA="" Q ... I $L(STOP),%]STOP S LDA="" Q ... I '$O(@CREF@(IX,%,0)) S LDA="" Q ... Q .. Q . Q Q LDA ; LOOK2(LFILE) ; EP-TEXT POINTER LOOKUP ; CHANGE THE GLOBAL REFERENCE FOR THE LOOKUP TO THE POINTED-TO FILE BEFORE PROCEEDING N XIT,LDA,OREF,CREF,VAL,DA S OREF=$$ROOT^DILFD(LFILE,IENS) I '$L(OREF) Q "" S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q "" S DA=+IENS I '$G(DA) G SCRATCH ; START FROM SCRATCH S %=$$IXVAL(LFILE,IX,DAS) I '$L(%) Q "" G LR ; RE-ENTER ; IXVAL(FIEN,IX,DAS) ; GIVEN A FILE IEN, INDEX NAME, AND DAS STRING, RETURN THE VALUE USED IN THE INDEX N DA,FLD,IENS,OREF,CREF,XREF,VAL,UP,LEV,L I '$D(^DD(+$G(FIEN),0)) Q "" ; MISSING OR INVALID FILE NUMBER I '$L($G(IX)) Q "" ; NO INDEX SPECIFIED S UP=FIEN F LEV=1:1 S UP=$G(^DD(UP,0,"UP")) Q:'UP I LEV'=$L(DAS,C) Q "" ; DAS LEVELS MUST MATCH FILE OR SUBFILE LEVEL S IENS=$$IENS^BMXADOV($G(DAS)) I IENS=U Q "" S OREF=$$ROOT^DILFD(FIEN,IENS) I '$L(OREF) Q "" S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q "" I '$D(@CREF@(IX)) Q CREF_"||" ; NO INDEX VALUES TO CHECK S XREF=OREF_IX_")" S DA=+IENS I 'DA Q CREF_"||" I '$D(@CREF@(DA)) Q CREF_"||" ; NO ENTRY EXISTS I IX="AA" G AA S FLD=+$$IXFLD^BMXADOV(FIEN,IX) I 'FLD Q "" ; INVALID DD S VAL=$$GET1^DIQ(FIEN,IENS,FLD,"I") I VAL="" Q "" ; VALUE IS NULL - NOTHING TO INDEX I '$D(@CREF@(IX,VAL,DA)) Q "" ; INVALID INDEX Q XREF_B_DA_B_VAL ; AA() ;EP - VISIT/V-FILE ITERATION USING THE 'AA' INDEX N LDA,XIT,AAINFO,DA,%,X,Y,DFN,TYPE,ORD,ISTART,ISTOP,IDT,AAREF,%DT,DIC S X=OREF_"""AA"")",%=$Q(@X) I %="" Q "" S TYPE="" I $L(%,C)=5 S TYPE=$P(PARAM,B,2) I TYPE="" Q "" ; FOR CERTAIN V FILES, TYPE MUST BE DEFINED I $E(TYPE)="`" S TYPE=$E(TYPE,2,99) I 'TYPE Q "" ; REMOVE ` FROM TYPE IEN I $L(TYPE),'TYPE D I TYPE'>0 Q "" ; QUIT IF INVALID TYPE . S %=$P($G(^DD(FIEN,.01,0)),U,2) . S DIC=+$P(%,"P",2) I '$D(^DD(DIC,.01,0)) Q . S X=TYPE,DIC(0)="M" D ^DIC I Y=-1 Q . S TYPE=+Y . Q S DFN=+PARAM I '$D(^DPT(DFN,0)) Q "" ; PATIENT DFN MUST BE DEFINED I 'TYPE S AAREF=OREF_"""AA"","_DFN_")" E S AAREF=OREF_"""AA"","_DFN_","_TYPE_")" I '$D(@AAREF) Q "" ; IF NOTHING UNDER AA INDEX, DON'T BOTHER LOOKING S ISTART=9999999 I START S X=START,%DT="P" D ^%DT S ISTART=9999999-Y S ISTOP=0 I STOP S X=STOP,%DT="P" D ^%DT S ISTOP=9999999-Y S ORD=-1 I $P(PARAM,B,$L(PARAM,B))="R" S ORD=1 ; SORT IN CHRONOLOGICAL OR REVERSE CHRONOLOGICAL ORDER I ORD=-1 S X=$G(ISTART),Y=$G(ISTOP),ISTOP=X,ISTART=Y ; CHANGES REQUIRED TO PRESENT DATA IN CHRONOLIGICAL ORDER S IDT=0,LDA="" I ISTOP S IDT=ISTOP-.0000001 S DA=+IENS I DA S IDT=$$AAR I 'IDT Q LDA ; SWEEP UP REMAINING IENS FOR CURRENT IDT AND RESET IDT FOR RE-ENTRY F S IDT=$O(@AAREF@(IDT),ORD) Q:'IDT D I $G(XIT) Q . I ORD=1,IDT>ISTART S LDA="",XIT=1 Q . I ORD=-1,IDT