| 1 | BMXADOV1 ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
|
|---|
| 2 | ;;4.1000;BMX;;Apr 17, 2011
|
|---|
| 3 | ; CONTINUATION FILE FOR BMXADOV
|
|---|
| 4 | ; MANAGES ITERATION FOR INDIVIDUAL INDEX TYPES
|
|---|
| 5 | ; ASSUMES CERTAIN LOCAL VARS: CREF,FIEN,IENS,DAS (<-THESE CAN'T BE NULL),START,STOP,MAX,TOT,NUM,IX
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | ;
|
|---|
| 9 | DATA(IENS,DA,XCNT) ;EP - ADD DATA NODES TO ARRAY
|
|---|
| 10 | ; ASSUMES THAT VSTG VARIABLES AND THE OUT ARRAY ARE PRESENT
|
|---|
| 11 | I '$G(DA) Q
|
|---|
| 12 | I '$L(IENS) Q
|
|---|
| 13 | S $P(IENS,C)=DA
|
|---|
| 14 | N STG,X,Y,%,FLD,STOP,VAL,CNT,FIEN,LINE,IFLAG,IDEP,TFLD,TNO,TEF
|
|---|
| 15 | S STG=DA
|
|---|
| 16 | I $G(DAS),$E(DAS,$L(DAS))="," S STG=$TR(DAS,",",U)_STG ; FIX FOR SUBFILE
|
|---|
| 17 | S CNT=$L(IENS,",") ; START AFTER THE .001 FIELD
|
|---|
| 18 | 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
|
|---|
| 19 | I $G(XCNT) S CNT=XCNT ; USED WITH JOINS
|
|---|
| 20 | F S CNT=$O(@OUT@(CNT)) Q:'CNT Q:$G(STOP) D I @OUT@(CNT)[$C(30) Q ; LOOP TO CREATE THE DATA STRING
|
|---|
| 21 | . K IFLAG,IDEP
|
|---|
| 22 | . S FIEN=+@OUT@(CNT) I '$D(^DD(FIEN,0)) S STOP=1 Q
|
|---|
| 23 | . S FLD=$P(@OUT@(CNT),B,2)
|
|---|
| 24 | . I FLD=".01ID" D Q ; PROCESS THE IDENTIFIER FIELD
|
|---|
| 25 | .. I '$G(SIEN) Q
|
|---|
| 26 | .. S %=$O(^BMXADO(SIEN,1,"B",".01ID",0)) I '% Q
|
|---|
| 27 | .. S IDEP=$G(^BMXADO(SIEN,1,%,1)) I '$L(IDEP) Q
|
|---|
| 28 | .. X ("S VAL=$$"_IDEP_"("_+STG_")") ; PASS THE DA TO THE IDENTIFIER EXTRINSIC FUNCTION, RETURN IDENTIFIERS
|
|---|
| 29 | .. S VAL=$TR(VAL,"^",""),VAL=$TR(VAL,B,"")
|
|---|
| 30 | .. S STG=STG_U_VAL
|
|---|
| 31 | .. Q
|
|---|
| 32 | . 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
|
|---|
| 33 | . K TFLD
|
|---|
| 34 | . I FLD["TRIGGER" S TFLD=FLD,FLD=+FLD,IFLAG=1
|
|---|
| 35 | . I FLD["IEN" S FLD=+FLD,IFLAG=1 ; LOOKUP VALUE FIELD (IEN)
|
|---|
| 36 | . I '$D(^DD(FIEN,FLD,0)),FLD'=.001 S STOP=1 Q
|
|---|
| 37 | . I $D(TFLD),FLD=.001 S VAL=+IENS
|
|---|
| 38 | . E S VAL=$$GET1^DIQ(FIEN,IENS,FLD,$S($G(IFLAG):"I",$G(TFLAG):"I",1:$G(FMT)))
|
|---|
| 39 | . I $G(TFLD) D S STG=STG_U_VAL Q ; GENERATE A TRIGGERED VALUE FOR THIS FIELD
|
|---|
| 40 | .. S TNO=$O(^BMXADO(SIEN,1,"B",TFLD,0)) I 'TNO S VAL="" Q
|
|---|
| 41 | .. S TEF=$G(^BMXADO(SIEN,1,TNO,3)) I '$L(TEF) S VAL="" Q ; GET EXTR FUNCT THAT GENERATES A SECONDARY VALUE
|
|---|
| 42 | .. X ("S VAL=$$"_TEF_"(VAL)")
|
|---|
| 43 | .. Q
|
|---|
| 44 | . I FLD=.01,VAL="" S STOP=1 Q ; INVALID FILEMAN ENTRY! SKIP IT
|
|---|
| 45 | . S VAL=$TR(VAL,"^",""),VAL=$TR(VAL,B,"")
|
|---|
| 46 | . S STG=STG_U_VAL
|
|---|
| 47 | . Q
|
|---|
| 48 | I $G(STOP) Q ; DON'T ADD NODE IF DD INFO IS INVALID
|
|---|
| 49 | F S LINE=$E(STG,1,250),STG=$E(STG,251,999999) D I '$L(STG) Q ; PREVENTS DATA LENGTH FROM EXCEEDING 250 BYTES
|
|---|
| 50 | . S TOT=TOT+1
|
|---|
| 51 | . I '$L(STG) S LINE=LINE_$C(30),NUM=NUM+1 ; END OF RECORD, RECORD TOTAL IS UPDATED
|
|---|
| 52 | . S @OUT@(TOT)=LINE ; NODE IS ADDED
|
|---|
| 53 | . Q
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | NUMIT(DA) ; EP-ITERATE BY NUMBER
|
|---|
| 57 | N XIT,LDA
|
|---|
| 58 | I IENS S DA=+IENS ; RE-ENTRY FROM SEED
|
|---|
| 59 | I '$G(DA),$G(START) S DA=START-1
|
|---|
| 60 | I '$G(DA) S DA=0
|
|---|
| 61 | S LDA=""
|
|---|
| 62 | F S DA=$O(@CREF@(DA)) D I $G(XIT) Q
|
|---|
| 63 | . I 'DA S XIT=1,LDA="" Q ; NO MORE IENS - THE END OF THE LINE
|
|---|
| 64 | . D DATA(IENS,DA,+$G(XCNT))
|
|---|
| 65 | . I $G(STOP),$O(@CREF@(DA))>STOP S LDA="",XIT=1 Q ; AS FAR AS YOU ARE ALLOWED TO GO FOR NUMBER ITERATION
|
|---|
| 66 | . I NUM=MAX S LDA=DA,XIT=1 Q ; REACHED THE MAX TRANSACTION LIMIT - GET MORE NEXT TIME
|
|---|
| 67 | . Q
|
|---|
| 68 | I LDA,'$O(@CREF@(LDA)) S LDA="" ; END OF THE LINE SO SET LDA TO NULL
|
|---|
| 69 | Q LDA
|
|---|
| 70 | ;
|
|---|
| 71 | LOOK(LIEN) ; EP-ITERATE BY A SINGLE STANDARD INDEX THAT IS A POINTER VALUE
|
|---|
| 72 | N XIT,LDA
|
|---|
| 73 | S DA=+IENS
|
|---|
| 74 | F S DA=$O(@CREF@(IX,LIEN,DA)) D I $G(XIT) Q
|
|---|
| 75 | . I 'DA S XIT=1,LDA="" Q ; NO MORE IENS - THE END OF THE LINE
|
|---|
| 76 | . D DATA(IENS,DA,$G(XCNT))
|
|---|
| 77 | . I NUM=MAX S LDA=DA,XIT=1 Q ; REACHED THE MAX TRANSACTION LIMIT - GET MORE NEXT TIME
|
|---|
| 78 | . Q
|
|---|
| 79 | I '$O(@CREF@(IX,LIEN,DA)) Q ""
|
|---|
| 80 | Q LDA
|
|---|
| 81 | ;
|
|---|
| 82 | LOOK1() ; EP-ITERATE USING A STANDARD INDEX
|
|---|
| 83 | N XIT,LDA,VAL,DA,%
|
|---|
| 84 | S DA=+IENS I 'DA G SCRATCH ; CHECK FOR RE-RENTRY
|
|---|
| 85 | REENTER ; RE-ENTER STD ITERATION USING DA AS THE SEED
|
|---|
| 86 | S %=$$IXVAL(FIEN,IX,DAS) I '$L(%) Q "" ; GET STARTUP INFO
|
|---|
| 87 | LR S VAL=$P(%,B,3)
|
|---|
| 88 | I VAL="" Q "" ; NO VAL FOUND FOR INITIAL ITERATION, SO QUIT
|
|---|
| 89 | 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
|
|---|
| 90 | I $G(XIT) Q:'$O(@CREF@(IX,VAL,LDA)) "" Q LDA ; IF NO MORE AFTER MAX, SET LDA = NULL
|
|---|
| 91 | G LOOK1R ; SEED IS DEFINED
|
|---|
| 92 | SCRATCH S VAL="" ; STD LOOKUP STARTING FROM SCRATCH
|
|---|
| 93 | I $L(START) S VAL=$O(@CREF@(IX,START),-1) ; GET SEED FOR ITERATION
|
|---|
| 94 | LOOK1R F S VAL=$O(@CREF@(IX,VAL)) D I $G(XIT) Q ; EP - RE-ENTRY POINT IF SEED IS DEFINED
|
|---|
| 95 | . I VAL="" S LDA="",XIT=1 Q ; END OF THE LINE
|
|---|
| 96 | . I STOP=+STOP,VAL=+VAL,VAL>STOP S LDA="",XIT=1 Q
|
|---|
| 97 | . I $L(STOP),VAL]STOP S LDA="",XIT=1 Q ; LOOKUP LIMITS
|
|---|
| 98 | . S DA=0
|
|---|
| 99 | . F S DA=$O(@CREF@(IX,VAL,DA)) Q:'DA D I $G(XIT) Q
|
|---|
| 100 | .. D DATA(IENS,DA,+$G(XCNT))
|
|---|
| 101 | .. I NUM=MAX S LDA=DA,XIT=1 D ; TRANSACTION LIMIT ; CHECK FOR MORE
|
|---|
| 102 | ... I $O(@CREF@(IX,VAL,DA)) Q
|
|---|
| 103 | ... S %=$O(@CREF@(IX,VAL)) I %="" S LDA="" Q
|
|---|
| 104 | ... I $L(STOP),%]STOP S LDA="" Q
|
|---|
| 105 | ... I '$O(@CREF@(IX,%,0)) S LDA="" Q
|
|---|
| 106 | ... Q
|
|---|
| 107 | .. Q
|
|---|
| 108 | . Q
|
|---|
| 109 | Q LDA
|
|---|
| 110 | ;
|
|---|
| 111 | LOOK2(LFILE) ; EP-TEXT POINTER LOOKUP
|
|---|
| 112 | ; CHANGE THE GLOBAL REFERENCE FOR THE LOOKUP TO THE POINTED-TO FILE BEFORE PROCEEDING
|
|---|
| 113 | N XIT,LDA,OREF,CREF,VAL,DA
|
|---|
| 114 | S OREF=$$ROOT^DILFD(LFILE,IENS) I '$L(OREF) Q ""
|
|---|
| 115 | S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q ""
|
|---|
| 116 | S DA=+IENS
|
|---|
| 117 | I '$G(DA) G SCRATCH ; START FROM SCRATCH
|
|---|
| 118 | S %=$$IXVAL(LFILE,IX,DAS) I '$L(%) Q ""
|
|---|
| 119 | G LR ; RE-ENTER
|
|---|
| 120 | ;
|
|---|
| 121 | IXVAL(FIEN,IX,DAS) ; GIVEN A FILE IEN, INDEX NAME, AND DAS STRING, RETURN THE VALUE USED IN THE INDEX
|
|---|
| 122 | N DA,FLD,IENS,OREF,CREF,XREF,VAL,UP,LEV,L
|
|---|
| 123 | I '$D(^DD(+$G(FIEN),0)) Q "" ; MISSING OR INVALID FILE NUMBER
|
|---|
| 124 | I '$L($G(IX)) Q "" ; NO INDEX SPECIFIED
|
|---|
| 125 | S UP=FIEN F LEV=1:1 S UP=$G(^DD(UP,0,"UP")) Q:'UP
|
|---|
| 126 | I LEV'=$L(DAS,C) Q "" ; DAS LEVELS MUST MATCH FILE OR SUBFILE LEVEL
|
|---|
| 127 | S IENS=$$IENS^BMXADOV($G(DAS)) I IENS=U Q ""
|
|---|
| 128 | S OREF=$$ROOT^DILFD(FIEN,IENS) I '$L(OREF) Q ""
|
|---|
| 129 | S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q ""
|
|---|
| 130 | I '$D(@CREF@(IX)) Q CREF_"||" ; NO INDEX VALUES TO CHECK
|
|---|
| 131 | S XREF=OREF_IX_")"
|
|---|
| 132 | S DA=+IENS I 'DA Q CREF_"||"
|
|---|
| 133 | I '$D(@CREF@(DA)) Q CREF_"||" ; NO ENTRY EXISTS
|
|---|
| 134 | I IX="AA" G AA
|
|---|
| 135 | S FLD=+$$IXFLD^BMXADOV(FIEN,IX) I 'FLD Q "" ; INVALID DD
|
|---|
| 136 | S VAL=$$GET1^DIQ(FIEN,IENS,FLD,"I") I VAL="" Q "" ; VALUE IS NULL - NOTHING TO INDEX
|
|---|
| 137 | I '$D(@CREF@(IX,VAL,DA)) Q "" ; INVALID INDEX
|
|---|
| 138 | Q XREF_B_DA_B_VAL
|
|---|
| 139 | ;
|
|---|
| 140 | AA() ;EP - VISIT/V-FILE ITERATION USING THE 'AA' INDEX
|
|---|
| 141 | N LDA,XIT,AAINFO,DA,%,X,Y,DFN,TYPE,ORD,ISTART,ISTOP,IDT,AAREF,%DT,DIC
|
|---|
| 142 | S X=OREF_"""AA"")",%=$Q(@X) I %="" Q ""
|
|---|
| 143 | S TYPE="" I $L(%,C)=5 S TYPE=$P(PARAM,B,2) I TYPE="" Q "" ; FOR CERTAIN V FILES, TYPE MUST BE DEFINED
|
|---|
| 144 | I $E(TYPE)="`" S TYPE=$E(TYPE,2,99) I 'TYPE Q "" ; REMOVE ` FROM TYPE IEN
|
|---|
| 145 | I $L(TYPE),'TYPE D I TYPE'>0 Q "" ; QUIT IF INVALID TYPE
|
|---|
| 146 | . S %=$P($G(^DD(FIEN,.01,0)),U,2)
|
|---|
| 147 | . S DIC=+$P(%,"P",2) I '$D(^DD(DIC,.01,0)) Q
|
|---|
| 148 | . S X=TYPE,DIC(0)="M" D ^DIC I Y=-1 Q
|
|---|
| 149 | . S TYPE=+Y
|
|---|
| 150 | . Q
|
|---|
| 151 | S DFN=+PARAM
|
|---|
| 152 | I '$D(^DPT(DFN,0)) Q "" ; PATIENT DFN MUST BE DEFINED
|
|---|
| 153 | I 'TYPE S AAREF=OREF_"""AA"","_DFN_")"
|
|---|
| 154 | E S AAREF=OREF_"""AA"","_DFN_","_TYPE_")"
|
|---|
| 155 | I '$D(@AAREF) Q "" ; IF NOTHING UNDER AA INDEX, DON'T BOTHER LOOKING
|
|---|
| 156 | S ISTART=9999999 I START S X=START,%DT="P" D ^%DT S ISTART=9999999-Y
|
|---|
| 157 | S ISTOP=0 I STOP S X=STOP,%DT="P" D ^%DT S ISTOP=9999999-Y
|
|---|
| 158 | S ORD=-1 I $P(PARAM,B,$L(PARAM,B))="R" S ORD=1 ; SORT IN CHRONOLOGICAL OR REVERSE CHRONOLOGICAL ORDER
|
|---|
| 159 | I ORD=-1 S X=$G(ISTART),Y=$G(ISTOP),ISTOP=X,ISTART=Y ; CHANGES REQUIRED TO PRESENT DATA IN CHRONOLIGICAL ORDER
|
|---|
| 160 | S IDT=0,LDA=""
|
|---|
| 161 | I ISTOP S IDT=ISTOP-.0000001
|
|---|
| 162 | S DA=+IENS
|
|---|
| 163 | I DA S IDT=$$AAR I 'IDT Q LDA ; SWEEP UP REMAINING IENS FOR CURRENT IDT AND RESET IDT FOR RE-ENTRY
|
|---|
| 164 | F S IDT=$O(@AAREF@(IDT),ORD) Q:'IDT D I $G(XIT) Q
|
|---|
| 165 | . I ORD=1,IDT>ISTART S LDA="",XIT=1 Q
|
|---|
| 166 | . I ORD=-1,IDT<ISTART S LDA="",XIT=1 Q
|
|---|
| 167 | . S DA=0
|
|---|
| 168 | . F S DA=$O(@AAREF@(IDT,DA)) Q:'DA D I $G(XIT) Q
|
|---|
| 169 | .. D DATA(IENS,DA,+$G(XCNT))
|
|---|
| 170 | .. I NUM=MAX S LDA=DA,XIT=1 I '$$AAMORE S LDA="" ; TRANSACTION LIMIT
|
|---|
| 171 | .. Q
|
|---|
| 172 | . Q
|
|---|
| 173 | Q LDA
|
|---|
| 174 | ;
|
|---|
| 175 | AAR() ; SWEEP UP REMAINING IENS FOR CURRENT IDT AND RESET IDT FOR RE-ENTRY
|
|---|
| 176 | N %,X,Y,XIT
|
|---|
| 177 | S %=$$AAVAL(FIEN,DAS) I '$L(%) Q ""
|
|---|
| 178 | S IDT=$P(%,B,5) I 'IDT Q ""
|
|---|
| 179 | F S DA=$O(@AAREF@(IDT,DA)) Q:'DA D I $G(XIT) Q
|
|---|
| 180 | . D DATA(IENS,DA,+$G(XCNT))
|
|---|
| 181 | . I NUM=MAX S LDA=DA,IDT="",XIT="" I '$$AAMORE S LDA=""
|
|---|
| 182 | . Q
|
|---|
| 183 | Q IDT
|
|---|
| 184 | ;
|
|---|
| 185 | AAMORE() ; RETURN A '1' IF MORE ITERATION IS POSSIBLE
|
|---|
| 186 | N X
|
|---|
| 187 | I $O(@AAREF@(IDT,DA)) Q 1
|
|---|
| 188 | S X=$O(@AAREF@(IDT),ORD) I 'X Q 0
|
|---|
| 189 | I $O(@AAREF@(X,0)) Q 1
|
|---|
| 190 | Q 0
|
|---|
| 191 | ;
|
|---|
| 192 | AAVAL(FIEN,DAS) ; GIVEN A FILE AND DAS, RETURN INFO NECESSARY TO RE-CREATE THE 'AA' INDEX
|
|---|
| 193 | N DATE,IDT,DFN,TYPE,VIEN,%,OREF,CREF,DA,IENS
|
|---|
| 194 | I '$D(^DD(FIEN,.01,0)) Q ""
|
|---|
| 195 | S IENS=$$IENS^BMXADOV($G(DAS)) I IENS=U Q ""
|
|---|
| 196 | S OREF=$$ROOT^DILFD(FIEN,IENS) I '$L(OREF) Q ""
|
|---|
| 197 | S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q ""
|
|---|
| 198 | S DA=+IENS I '$D(@CREF@(DA)) Q ""
|
|---|
| 199 | I FIEN=9000010 S DFN=$P(@CREF@(DA,0),U,5),VIEN=DA
|
|---|
| 200 | E S DFN=$P(@CREF@(DA,0),U,2),VIEN=$P(@CREF@(DA,0),U,3)
|
|---|
| 201 | I $D(^DPT(DFN,0)),$D(^AUPNVSIT(VIEN,0))
|
|---|
| 202 | E Q ""
|
|---|
| 203 | S DATE=+$P($G(^AUPNVSIT(VIEN,0)),U) I 'DATE Q ""
|
|---|
| 204 | S IDT=(9999999-(DATE\1))
|
|---|
| 205 | S %=$P(DATE,".",2) I % S IDT=+(IDT_"."_%) I 'IDT Q ""
|
|---|
| 206 | S X=OREF_"""AA"")",%=$Q(@X) I %="" Q ""
|
|---|
| 207 | S TYPE="" I $L(%,C)=5 S TYPE=$P(@CREF@(DA,0),U)
|
|---|
| 208 | Q X_B_DA_B_DFN_B_TYPE_B_IDT
|
|---|
| 209 | ;
|
|---|
| 210 | AAP() ;EP - ITERATOR FOR PROBLEM FILE: AA INDEX
|
|---|
| 211 | I '$D(^AUPNPROB("AA",+$G(START))) Q ""
|
|---|
| 212 | N LOC,PNUM,DFN,IEN
|
|---|
| 213 | S LOC=0,DFN=START
|
|---|
| 214 | F S LOC=$O(^AUPNPROB("AA",DFN,LOC)) Q:'LOC D
|
|---|
| 215 | . S PNUM=""
|
|---|
| 216 | . F S PNUM=$O(^AUPNPROB("AA",DFN,LOC,PNUM)) Q:PNUM="" D
|
|---|
| 217 | .. S IEN=0
|
|---|
| 218 | .. F S IEN=$O(^AUPNPROB("AA",DFN,LOC,PNUM,IEN)) Q:'IEN D DATA(",",IEN,+$G(XCNT))
|
|---|
| 219 | .. Q
|
|---|
| 220 | .Q
|
|---|
| 221 | Q ""
|
|---|
| 222 | ;
|
|---|
| 223 | TESTID(DA) ; TEST IDENTIFIERS
|
|---|
| 224 | N %,Y,SEX
|
|---|
| 225 | S %=$G(^DIZ(2160010,+$G(DA),0)) I '$L(%) Q ""
|
|---|
| 226 | S SEX=$P(%,U,2) I '$L(SEX) S SEX="??"
|
|---|
| 227 | S Y=$P(%,U,3) X ^DD("DD")
|
|---|
| 228 | Q (SEX_" "_Y)
|
|---|
| 229 | ;
|
|---|
