| 1 | BMXADOFS ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ; 31 Jul 2009 12:42 PM
|
|---|
| 2 | ;;4.1000;BMX;;Apr 17, 2011
|
|---|
| 3 | ; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN
|
|---|
| 4 | ; CONTAINS SPECIAL CODE RELATED TO FILING PROPLEMS, POVS, FAMILY HX, PERSONAL HX AND NOTES.
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | PAT ; TEST PROBLEM ADD
|
|---|
| 9 | S DATA=".01|`8257"_$C(30)_".02|`53"_$C(30)_".03|"_DT_$C(30)_".05|C-POX"_$C(30)_".06|`4585"_$C(30)_".12|I"_$C(30,31)
|
|---|
| 10 | D FILE^BMXADOF(.XXX,9000011,"",DATA) W !,XXX K XXX,DATA Q
|
|---|
| 11 | ;
|
|---|
| 12 | PET ; TEST PROB EDIT
|
|---|
| 13 | S DATA=".01|250.00"_$C(30)_".03|"_DT_$C(30)_".05|HI MOM"_$C(30)_".12|I"_$C(30,31)
|
|---|
| 14 | D FILE^BMXADOF(.XXX,9000011,"1757",DATA) W !,XXX K XXX,DATA Q
|
|---|
| 15 | ;
|
|---|
| 16 | TDP ; TEST PROBLEM DELETE
|
|---|
| 17 | S DATA=$C(31)
|
|---|
| 18 | D FILE^BMXADOF(.XXX,9000011,"-1757",DATA) W !,XXX K XXX,DATA Q
|
|---|
| 19 | ;
|
|---|
| 20 | TPOV ; ADD POV TEST
|
|---|
| 21 | S DATA=".01|`8718"_$C(30)_".02|`53"_$C(30)_".03|`3909"_$C(30)_".04|DM---I"_$C(30)_".12|P"_$C(30,31)
|
|---|
| 22 | D FILE^BMXADOF(.XXX,9000010.07,"",DATA) W !,XXX K XXX,DATA Q
|
|---|
| 23 | ;
|
|---|
| 24 | TH ; HX TEST
|
|---|
| 25 | S DATA=".01|250.00"_$C(30)_".02|`53"_$C(30)_".03|JUL 15,2004"_$C(30)_".04|FAMILY HX OF LUNG CA"_$C(30,31)
|
|---|
| 26 | D FILE^BMXADOF(.XXX,9000014,"",DATA) W !,XXX K XXX,DATA Q
|
|---|
| 27 | ;
|
|---|
| 28 | TNOTE ; TEST ADDING A NOTE TO A PROBLEM
|
|---|
| 29 | N DATA,XXX,PROBIEN,FACNIEN,FACIEN,DAS
|
|---|
| 30 | S PROBIEN=3,FACIEN=4587
|
|---|
| 31 | S FACNIEN=$$FACNIEN(PROBIEN,FACIEN) ; YOU MUST SPECIFY THE PROBLEM IEN AND THE FACILITY IEN
|
|---|
| 32 | S DAS=PROBIEN_","_FACNIEN_","
|
|---|
| 33 | S DATA=".03|NEW NOTE #2"_$C(30,31) ; THE DATA STRING JUST CONTAINS THE NOTE FIELD.
|
|---|
| 34 | ; THE OTHER FIELDS (INCLUDING .01) ARE ADDED BY BMXADOF
|
|---|
| 35 | D FILE^BMXADOF(.XXX,9000011.1111,DAS,DATA) W !,XXX
|
|---|
| 36 | Q
|
|---|
| 37 | ;
|
|---|
| 38 | ; -----------------------------------------------------------------------------------------------------
|
|---|
| 39 | ;
|
|---|
| 40 | SPEC(FILE,DATA,UFLG) ;EP - SPECIAL DATA MODS FOR SPECIFIC FILES
|
|---|
| 41 | I FILE=9000010.07 S DATA=$$POV(DATA) Q DATA
|
|---|
| 42 | I FILE=9000011 S DATA=$$PROB(DATA,$G(UFLG)) Q DATA
|
|---|
| 43 | I FILE=9000013!(FILE=9000014) S DATA=$$HX(DATA) Q DATA
|
|---|
| 44 | I FILE=9000011.1111 S DATA=$$NOTE(DATA,$G(DAS(2)),$G(DAS(1))) Q DATA
|
|---|
| 45 | ; I FILE=9000010.18,DATA'["|.04|" G DSTG
|
|---|
| 46 | Q DATA
|
|---|
| 47 | ;
|
|---|
| 48 | HX(DATA) ; INPUT STRING TRANSFORM FOR PHX AND FHX
|
|---|
| 49 | N NARR,NIEN,%,A,B,X,Y,%DT
|
|---|
| 50 | I DATA[".01|`" G HNARR
|
|---|
| 51 | S DATA=$$ICD(DATA,.01) I DATA="" Q ""
|
|---|
| 52 | HNARR I DATA'[".04|'" G HDT
|
|---|
| 53 | S DATA=$$NARR(DATA,.04)
|
|---|
| 54 | HDT I DATA'[".03|" Q DATA
|
|---|
| 55 | S X=+$P(DATA,".03|",2) I X?7N Q DATA
|
|---|
| 56 | S %DT="" D ^%DT
|
|---|
| 57 | I Y'?7N Q DATA
|
|---|
| 58 | S A=$P(DATA,".03|")
|
|---|
| 59 | S B=$P(DATA,".03|",2) S B=$P(B,$C(30),2)
|
|---|
| 60 | S DATA=A_".03|"_Y
|
|---|
| 61 | I $L(B) S DATA=DATA_$C(30)_B
|
|---|
| 62 | Q DATA
|
|---|
| 63 | ;
|
|---|
| 64 | POV(DATA) ; POV INPUT STRING TRANSFORM
|
|---|
| 65 | N NARR,NIEN,%
|
|---|
| 66 | I DATA[".01|`" G PVNARR
|
|---|
| 67 | S DATA=$$ICD(DATA,.01) I DATA="" Q ""
|
|---|
| 68 | PVNARR I DATA'[".04|'" Q DATA
|
|---|
| 69 | S DATA=$$NARR(DATA,.04)
|
|---|
| 70 | Q DATA
|
|---|
| 71 | ;
|
|---|
| 72 | PROB(DATA,UFLG) ; PROBLEM LIST INPUT STRING TRANSFORM
|
|---|
| 73 | N NARR,NIEN,%,PNUM,FACIEN,DFN,X,A,B
|
|---|
| 74 | PNARR I DATA'[".05|" G PICD
|
|---|
| 75 | S %=$P(DATA,".05|",2)
|
|---|
| 76 | S NARR=$P(%,$C(30))
|
|---|
| 77 | I NARR'?1"`"1.N S DATA=$$NARR(DATA,.05) ; STUFF THE NARR LOOKUP VALUE IN THE DATA STRING
|
|---|
| 78 | I '$L(DATA) Q ""
|
|---|
| 79 | PICD S %=$P(DATA,"|") I %'=.01,DATA'[($C(30)_".01|") G PNUM
|
|---|
| 80 | S DATA=$$ICD(DATA,.01) I DATA="" Q ""
|
|---|
| 81 | PNUM I $G(UFLG)="E" Q DATA ; STOP HERE IF IN EDIT MODE
|
|---|
| 82 | I $P(DATA,($C(30)_".07|"),2) G TODAY ; GET NEXT PROB NUM
|
|---|
| 83 | S DFN=+$P(DATA,".02|`",2)
|
|---|
| 84 | I 'DFN S DATA="" Q ""
|
|---|
| 85 | S FACIEN=+$P(DATA,".06|`",2)
|
|---|
| 86 | I 'FACIEN Q ""
|
|---|
| 87 | S PNUM=$$NEXTPBN(DFN,FACIEN)
|
|---|
| 88 | I 'PNUM Q ""
|
|---|
| 89 | S X=$L(DATA,$C(30))
|
|---|
| 90 | S A=$P(DATA,$C(30),1,X-1),B=$P(DATA,$C(30),X)
|
|---|
| 91 | S DATA=A_$C(30)_".07|"_PNUM_$C(30)_B
|
|---|
| 92 | TODAY I $P(DATA,($C(30)_".08|"),2) Q DATA ; GET TODAY'S DATE
|
|---|
| 93 | S X=$L(DATA,$C(30))
|
|---|
| 94 | S A=$P(DATA,$C(30),1,X-1),B=$P(DATA,$C(30),X)
|
|---|
| 95 | S DATA=A_$C(30)_".08|"_$G(DT)_$C(30)_B
|
|---|
| 96 | Q DATA
|
|---|
| 97 | ;
|
|---|
| 98 | NOTE(DATA,PIEN,FNIEN) ; GIVEN A DATA STRING CONTAINING THE NOTE, THE PROBLEM IEN, AND THE FAC-NOTE IEN:
|
|---|
| 99 | ; ADD NOTE # AND STATUS TO THE DATA STRING
|
|---|
| 100 | I $G(DATA)'[".03|" Q ""
|
|---|
| 101 | I '$D(^AUPNPROB(+$G(PIEN),11,+$G(FNIEN),0)) Q ""
|
|---|
| 102 | N NUM
|
|---|
| 103 | I DATA'[".04|" S DATA=".04|A"_$C(30)_DATA
|
|---|
| 104 | I DATA'[".01|" D
|
|---|
| 105 | . S NUM=$$NEXTNOTE(PIEN,FNIEN)
|
|---|
| 106 | . I 'NUM Q
|
|---|
| 107 | . S DATA=".01|"_NUM_$C(30)_DATA
|
|---|
| 108 | Q DATA
|
|---|
| 109 | ;
|
|---|
| 110 | TI N XXX S XXX=$$ICD(".01|250.00"_$C(30)_".02|123"_$C(30)_".03|ABC",.01) W !,$TR(XXX,$C(30),"{") Q
|
|---|
| 111 | ICD(DATA,FLD) ; VERIFY ICD CODE AND GET LOOKUP VALUE
|
|---|
| 112 | I '$G(FLD) Q ""
|
|---|
| 113 | I '$L($G(DATA)) Q ""
|
|---|
| 114 | N %,A,B
|
|---|
| 115 | S %=$P(DATA,"|")
|
|---|
| 116 | I %=FLD D Q DATA
|
|---|
| 117 | . S %=$P(DATA,"|",2)
|
|---|
| 118 | . S %=$P(%,$C(30))
|
|---|
| 119 | . I %?1"`"1.N Q
|
|---|
| 120 | . S %=$O(^ICD9("BA",%_" ",0))
|
|---|
| 121 | . I $L($T(CODEN^ICDCODE)) S %=+$$CODEN^ICDCODE(%,80) I %<0 S %=""
|
|---|
| 122 | . I '% S DATA="" Q
|
|---|
| 123 | . S A=$P(DATA,"|")
|
|---|
| 124 | . S B=$P(DATA,"|",2,999)
|
|---|
| 125 | . S B=$P(B,$C(30),2,999)
|
|---|
| 126 | . S DATA=A_"|`"_%
|
|---|
| 127 | . I $L(B) S DATA=DATA_$C(30)_B
|
|---|
| 128 | . Q
|
|---|
| 129 | S %=$P(DATA,($C(30)_FLD_"|"),2) D
|
|---|
| 130 | . S %=$P(%,$C(30))
|
|---|
| 131 | . I %?1"`"1.N Q DATA
|
|---|
| 132 | . S %=$O(^ICD9("BA",%_" ",0))
|
|---|
| 133 | . I $L($T(CODEN^ICDCODE)) S %=+$$CODEN^ICDCODE(%,80) I %<0 S %=""
|
|---|
| 134 | . I '% S DATA="" Q
|
|---|
| 135 | . S A=$P(DATA,($C(30)_FLD_"|"))
|
|---|
| 136 | . S B=$P(DATA,($C(30)_FLD_"|"),2,999)
|
|---|
| 137 | . S B=$P(B,$C(30),2,999)
|
|---|
| 138 | . S DATA=A_$C(30)_FLD_"|`"_%
|
|---|
| 139 | . I $L(B) S DATA=DATA_$C(30)_B
|
|---|
| 140 | . Q
|
|---|
| 141 | Q DATA
|
|---|
| 142 | ;
|
|---|
| 143 | NARR(DATA,FLD) ; SUBSTITUTE A LOOKUP VALUE FOR NARRATIVE DATA IN THE DATA STRING
|
|---|
| 144 | N A,B,C,X,Y,DIC,Z
|
|---|
| 145 | I '$G(FLD) Q ""
|
|---|
| 146 | I '$L($G(DATA)) Q ""
|
|---|
| 147 | S Z=FLD_"|"
|
|---|
| 148 | S A=$P(DATA,Z)
|
|---|
| 149 | S B=$P(DATA,Z,2)
|
|---|
| 150 | S NARR=$P(B,$C(30))
|
|---|
| 151 | S NARR=$$UP^XLFSTR(NARR) ; CONVERT ALL NARRATIVE TO UPPERCASE
|
|---|
| 152 | S C=$P(B,$C(30),2,999)
|
|---|
| 153 | S DIC="^AUTNPOV(",DIC(0)="L",X=NARR
|
|---|
| 154 | D ^DIC I Y=-1 Q ""
|
|---|
| 155 | S DATA=A_FLD_"|`"_+Y
|
|---|
| 156 | I $L(C) S DATA=DATA_$C(30)_C
|
|---|
| 157 | D ^XBFMK
|
|---|
| 158 | Q DATA
|
|---|
| 159 | ;
|
|---|
| 160 | FACNIEN(PIEN,FIEN) ; GIVEN A PROBLEM IEN AND FACILITY IEN, RETURN THE FACILITY-NOTE IEN
|
|---|
| 161 | I '$D(^AUPNPROB(+$G(PIEN),0)) Q ""
|
|---|
| 162 | I '$D(^DIC(4,+$G(FIEN),0)) Q ""
|
|---|
| 163 | N FNIEN
|
|---|
| 164 | S FNIEN=$O(^AUPNPROB(PIEN,11,"B",FIEN,0)) I FNIEN Q FNIEN ; IF AN FNIEN EXISTS RETURN IT
|
|---|
| 165 | ; OTHERWISE-CREATE THE FM STUB NODES FOR THE FACILITY SUBFILE
|
|---|
| 166 | S FNIEN=$O(^AUPNPROB(PIEN,11,999999),-1)+1
|
|---|
| 167 | S ^AUPNPROB(PIEN,11,FNIEN,0)=FIEN
|
|---|
| 168 | S ^AUPNPROB(PIEN,11,FNIEN,11,0)="^9000011.1111IA^^"
|
|---|
| 169 | S ^AUPNPROB(PIEN,11,"B",FIEN,FNIEN)=""
|
|---|
| 170 | Q FNIEN
|
|---|
| 171 | ;
|
|---|
| 172 | NEXTPBN(DFN,FIEN) ; RETURN THE NEXT AVAILABLE PROBLEM NUMBER FOR A PATIENT AT THE FACILITY
|
|---|
| 173 | N MAX,PIEN,X,Y
|
|---|
| 174 | S MAX=0,PIEN=0
|
|---|
| 175 | F S PIEN=$O(^AUPNPROB("AC",DFN,PIEN)) Q:'PIEN D ; FIND ALL PROBLEMS FOR THIS PATIENT
|
|---|
| 176 | . S X=$G(^AUPNPROB(PIEN,0)) I '$L(X) Q ""
|
|---|
| 177 | . I $P(X,U,6)'=FIEN Q ; ONLY CHECK NUMBERS AT THIS FACILITY
|
|---|
| 178 | . S Y=$P(X,U,7)
|
|---|
| 179 | . I Y>MAX S MAX=Y ; GET THE HIGHEST NUMBER THUS FAR
|
|---|
| 180 | . Q
|
|---|
| 181 | S MAX=(MAX\1)+1 ; GET NEXT AVAILABLE INTEGER
|
|---|
| 182 | Q MAX
|
|---|
| 183 | ;
|
|---|
| 184 | NN W $$NEXTNOTE(3,1) Q
|
|---|
| 185 | NEXTNOTE(PIEN,FNIEN) ; RETRUN THE NEXT NOTE NUMBER FOR A PROBLEM AND FACILITY-NOTE IEN
|
|---|
| 186 | I '$D(^AUPNPROB(+$G(PIEN),11,+$G(FNIEN),0)) Q ""
|
|---|
| 187 | N MAX,NIEN,X,Y
|
|---|
| 188 | S MAX=0,NIEN=0
|
|---|
| 189 | F S NIEN=$O(^AUPNPROB(PIEN,11,FNIEN,11,NIEN)) Q:'NIEN D
|
|---|
| 190 | . S X=$G(^AUPNPROB(PIEN,11,FNIEN,11,NIEN,0)) I '$L(X) Q
|
|---|
| 191 | . S Y=+X
|
|---|
| 192 | . I Y>MAX S MAX=Y
|
|---|
| 193 | . Q
|
|---|
| 194 | S MAX=MAX+1
|
|---|
| 195 | Q MAX
|
|---|
| 196 | ;
|
|---|
| 197 | PIENN(PIEN) ; GIVEN A PROBLEM IEN, RETURN PROBLEM NARRATIVE (ICD)
|
|---|
| 198 | N X,IIEN,NIEN,NARR,ICD
|
|---|
| 199 | S X=$G(^AUPNPROB(PIEN,0)) I '$L(X) Q ""
|
|---|
| 200 | S IIEN=$P(X,U) I 'IIEN Q ""
|
|---|
| 201 | S NIEN=$P(X,U,5) I 'NIEN Q ""
|
|---|
| 202 | I $L($T(ICDDX^ICDCODE)) S ICD=$P($$ICDDX^ICDCODE(IIEN),U,2) I 1
|
|---|
| 203 | E S ICD=$P($G(^ICD9(IIEN,0)),U)
|
|---|
| 204 | I '$L(ICD) Q ""
|
|---|
| 205 | S NARR=$P($G(^AUTNPOV(NIEN,0)),U) I '$L(NARR) Q ""
|
|---|
| 206 | S X=NARR_" ("_ICD_")"
|
|---|
| 207 | Q X
|
|---|
| 208 | ;
|
|---|
