source: BMXNET_RPMS_dotNET_UTILITIES-BMX/branch/BMX41000/routines/BMXADOV1.m@ 1801

Last change on this file since 1801 was 1200, checked in by Sam Habiel, 14 years ago

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