[613] | 1 | SROADX ;BIR/RJS - ASSOCIATED DIAGNOSIS FOR CODER AND VERIFY SCREENS ;11/22/05
|
---|
| 2 | ;;3.0;Surgery;**119,150**;24 Jun 93
|
---|
| 3 | CASDX ;Associate/Delete "Primary" CPT to Diagnosis from the CPT Coding menu.
|
---|
| 4 | N SRDX0,SRDX1,SRDX2,SROANS,SRODIR,SRDIRX,OTHCNT,SRASSDS
|
---|
| 5 | S S("OP")=^SRF(SRTN,"OP"),CPT=$P(S("OP"),U,2),SROPER=$P(S("OP"),U)
|
---|
| 6 | Q:'CPT
|
---|
| 7 | K DIR
|
---|
| 8 | D HDR^SROVER2
|
---|
| 9 | D CPTDISP^SROADX1,ASDX^SROADX1,ADXPRMT
|
---|
| 10 | Q:($G(Y(0))="")!($G(Y(0))="QUIT")
|
---|
| 11 | K DIR
|
---|
| 12 | S Y=$P(SROLST,",",Y)
|
---|
| 13 | S SROANS=Y
|
---|
| 14 | S SRODIR("A",1)=" Select the number(s) of the Diagnosis Code appropriate for this procedure"
|
---|
| 15 | S SRODIR("A")=" ("_SRTXT_")"
|
---|
| 16 | S:$G(SROANS)="D" SRODIR("A",1)=" Select the number(s) of the Diagnosis Code(s) to delete from this procedure"
|
---|
| 17 | D HDR^SROVER2
|
---|
| 18 | D CPTDISP^SROADX1,ASDX^SROADX1
|
---|
| 19 | S Y=SROANS
|
---|
| 20 | I Y="D" D
|
---|
| 21 | .W !,?8,SRDXCNT,". ALL"
|
---|
| 22 | .S DIR(0)=SRDX1,DIR("A")=SRODIR("A"),DIR("A",1)="",DIR("A",2)=SRODIR("A",1)
|
---|
| 23 | .F I=1:1 D ^DIR Q:$$VALASC()
|
---|
| 24 | .Q:(Y["^")!(Y="")!($P(Y,",",1)=0)
|
---|
| 25 | .I +Y(0)'=SRDXCNT D PDEL1^SROADX1
|
---|
| 26 | .I +Y(0)=SRDXCNT D PDELALL^SROADX1
|
---|
| 27 | I Y="A" D
|
---|
| 28 | .K DIR
|
---|
| 29 | .D SRODIR^SROADX1
|
---|
| 30 | .W ! F I=1:1:80 W "-"
|
---|
| 31 | .S DIR(0)=SRDX2
|
---|
| 32 | .S SRASSDS=$$PASSDS^SROADX1
|
---|
| 33 | .S DIR("B")=SRASSDS
|
---|
| 34 | .F I=1:1 D ^DIR Q:(($$VALASC())&('$$DXDUP(Y)))
|
---|
| 35 | .Q:(Y["^")!(Y="")!($P(Y,",",1)=0)
|
---|
| 36 | .I SRDIRX(+Y(0))'="ALL" D PADD1^SROADX1 Q
|
---|
| 37 | .I SRDIRX(+Y(0))="ALL" D PADDALL^SROADX1 Q
|
---|
| 38 | Q:Y="Q"!(Y["")
|
---|
| 39 | G CASDX
|
---|
| 40 | Q
|
---|
| 41 | COTHADX D COTHBLD^SROADX1 ;Associate/Delete "Other" CPTs to Diagnosis from CPT/CODE menu.
|
---|
| 42 | N SRDX0,SRDX1,SRDX2,SRDIR,OTHCNT,SRASSDS
|
---|
| 43 | D HDR^SROVER2
|
---|
| 44 | S OTHCNT=SRDA
|
---|
| 45 | K DIR
|
---|
| 46 | D OTHCPTD^SROADX1
|
---|
| 47 | D OTHADX^SROADX1,ADXPRMT
|
---|
| 48 | Q:($G(Y(0))="")!($G(Y(0))="QUIT")
|
---|
| 49 | S SRODIR("A",1)=" Select the number(s) of the Diagnosis Code appropriate for this procedure"
|
---|
| 50 | S SRODIR("A")=" ("_$G(SRSHT)_")"
|
---|
| 51 | S:$G(Y(0))="DELETE" SRODIR("A",1)=" Select the number(s) of the Diagnosis Code(s) to delete from this procedure"
|
---|
| 52 | K DIR
|
---|
| 53 | S Y=$P(SROLST,",",Y)
|
---|
| 54 | S SROANS=Y
|
---|
| 55 | W @IOF
|
---|
| 56 | D OTHCPTD^SROADX1
|
---|
| 57 | D OTHADX^SROADX1
|
---|
| 58 | S Y=SROANS
|
---|
| 59 | I Y="D" D
|
---|
| 60 | .W !,?8,SRDXCNT,". ALL"
|
---|
| 61 | .S DIR(0)=SRDX1,DIR("A")=SRODIR("A"),DIR("A",1)="",DIR("A",2)=SRODIR("A",1)
|
---|
| 62 | .F I=1:1 D ^DIR Q:$$VALASC()
|
---|
| 63 | .Q:(Y["^")!(Y="")!($P(Y,",",1)=0)
|
---|
| 64 | .I +Y(0)=SRDXCNT D
|
---|
| 65 | ..W !,"ARE YOU SRE YOU WANT TO DELETE ALL ? (Y/N) "
|
---|
| 66 | ..S %=2 D YN^DICN
|
---|
| 67 | ..I %=1 Q:$E($G(IOST))'="C"!($G(DIK)'="") D KOADX^SROADX2(SRTN,OTH)
|
---|
| 68 | ..W @IOF
|
---|
| 69 | ..S OTHCNT=SRDA
|
---|
| 70 | .I +Y(0)'=SRDXCNT D
|
---|
| 71 | ..S DIR(0)=SRDX1,DIR("A")=SRODIR("A"),DIR("A",1)="",DIR("A",2)=SRODIR("A",1)
|
---|
| 72 | ..D ODEL1^SROADX1
|
---|
| 73 | ..W @IOF
|
---|
| 74 | .D OTHCPTD^SROADX1
|
---|
| 75 | I Y="A" D G COTHADX
|
---|
| 76 | .K DIR
|
---|
| 77 | .D SRODIR^SROADX1
|
---|
| 78 | .W ! F I=1:1:80 W "-"
|
---|
| 79 | .S DIR(0)=SRDX2
|
---|
| 80 | .S SRASSDS=$$OASSDS^SROADX1
|
---|
| 81 | .S DIR("B")=SRASSDS
|
---|
| 82 | .F I=1:1 D ^DIR Q:(($$VALASC())&('$$DXDUP(Y)))
|
---|
| 83 | .Q:(Y["^")!(Y="")!($P(Y,",",1)=0)
|
---|
| 84 | .I SRDIRX(+Y(0))="ALL",SRDX0'="SO^1:ASSOCIATE;2:DELETE;3:QUIT" D Q
|
---|
| 85 | ..D OADDALL^SROADX1
|
---|
| 86 | .I SRDIRX(+Y(0))="ALL",SRDX0="SO^1:ASSOCIATE;2:DELETE;3:QUIT" D Q
|
---|
| 87 | ..D OADD1^SROADX1
|
---|
| 88 | .I SRDIRX(+Y(0))'="ALL" D
|
---|
| 89 | ..D OADD1^SROADX1
|
---|
| 90 | .W @IOF
|
---|
| 91 | .D OTHCPTD^SROADX1
|
---|
| 92 | .D OTHADX^SROADX1
|
---|
| 93 | Q:Y="Q"!(Y["")
|
---|
| 94 | G COTHADX
|
---|
| 95 | Q
|
---|
| 96 | VASDX ;Associate/Delete PRINCIPAL CPTs to Diagnosis from Physician's Verify menu.
|
---|
| 97 | N SRDX0,SRDX1,SRDX2,SROANS,SRODIR,SRDIRX,SRASSDS
|
---|
| 98 | K DIR
|
---|
| 99 | W @IOF
|
---|
| 100 | S DIR("?")="^D VHELP^SROADX"
|
---|
| 101 | S DIR("??")="^D VHELP1^SROADX"
|
---|
| 102 | D CPTDISP^SROADX1,ASDX^SROADX1,ADXPRMT
|
---|
| 103 | Q:($G(Y(0))="")!($G(Y(0))="QUIT")
|
---|
| 104 | S SRODIR("A",1)=" Select the number(s) of the Diagnosis Code appropriate for this procedure"
|
---|
| 105 | S SRODIR("A")=" ("_SROCPT2_")"
|
---|
| 106 | S:$G(Y(0))="DELETE" SRODIR("A",1)=" Select the number(s) of the Diagnosis Code(s) to delete from this procedure"
|
---|
| 107 | K DIR
|
---|
| 108 | S Y=$P(SROLST,",",Y)
|
---|
| 109 | S SROANS=Y
|
---|
| 110 | W @IOF
|
---|
| 111 | D CPTDISP^SROADX1,ASDX^SROADX1
|
---|
| 112 | S Y=SROANS
|
---|
| 113 | I Y="D" D
|
---|
| 114 | .W !,?8,SRDXCNT,". ALL"
|
---|
| 115 | .S DIR(0)=SRDX1,DIR("A")=SRODIR("A"),DIR("A",1)="",DIR("A",2)=SRODIR("A",1)
|
---|
| 116 | .S DIR("?")="^D DHELP^SROADX"
|
---|
| 117 | .S DIR("??")="^D PHELP^SROADX"
|
---|
| 118 | .F I=1:1 D ^DIR Q:$$VALASC()
|
---|
| 119 | .Q:(Y["^")!(Y="")!($P(Y,",",1)=0)
|
---|
| 120 | .I +Y(0)=SRDXCNT D PDELALL^SROADX1 Q
|
---|
| 121 | .I +Y(0)'=SRDXCNT D PDEL1^SROADX1 Q
|
---|
| 122 | I Y="A" D
|
---|
| 123 | .K DIR
|
---|
| 124 | .D SRODIR^SROADX1
|
---|
| 125 | .W ! F I=1:1:80 W "-"
|
---|
| 126 | .S DIR("?")="^D AHELP^SROADX"
|
---|
| 127 | .S DIR("??")="^D PHELP^SROADX"
|
---|
| 128 | .S SRASSDS=$$PASSDS^SROADX1
|
---|
| 129 | .S DIR("B")=SRASSDS
|
---|
| 130 | .S DIR(0)=SRDX2
|
---|
| 131 | .F I=1:1 D ^DIR Q:(($$VALASC())&('$$DXDUP(Y)))
|
---|
| 132 | .Q:(Y["^")!(Y="")!($P(Y,",",1)=0)
|
---|
| 133 | .I SRDIRX(+Y(0))'="ALL" D PADD1^SROADX1 Q
|
---|
| 134 | .I SRDIRX(+Y(0))="ALL" D PADDALL^SROADX1 Q
|
---|
| 135 | G VASDX
|
---|
| 136 | Q
|
---|
| 137 | NOTHADX S OTH=DA,OTHCNT=CNT
|
---|
| 138 | S SRSEL(CNT)=OTH_U_$G(OTHER)_"^CPT Code: "_CPT_U_$G(CPT1)
|
---|
| 139 | VOTHADX N SRDX0,SRDX1,SRDX2,SRDIR,SRASSDS ;Associate/Delete OTHER Diagnosis to CPTs from Physician's Verify menu.
|
---|
| 140 | Q:'$D(^SRF(SRTN,13,OTH))
|
---|
| 141 | W @IOF
|
---|
| 142 | K DIR
|
---|
| 143 | D OTHCPTD^SROADX1,OTHADX^SROADX1,ADXPRMT
|
---|
| 144 | Q:($G(Y(0))="")!($G(Y(0))="QUIT")
|
---|
| 145 | S SRODIR("A",1)=" Select the number(s) of the Diagnosis Code appropriate for this procedure"
|
---|
| 146 | S SRODIR("A")=" ("_$G(SRSHT)_")"
|
---|
| 147 | S:$G(Y(0))="DELETE" SRODIR("A",1)=" Select the number(s) of the Diagnosis Code(s) to delete from this procedure"
|
---|
| 148 | K DIR
|
---|
| 149 | S Y=$P(SROLST,",",Y)
|
---|
| 150 | S SROANS=Y
|
---|
| 151 | W @IOF
|
---|
| 152 | D OTHCPTD^SROADX1
|
---|
| 153 | D OTHADX^SROADX1
|
---|
| 154 | S Y=SROANS
|
---|
| 155 | I Y="D" D
|
---|
| 156 | .W !,?8,SRDXCNT,". ALL"
|
---|
| 157 | .S DIR("?")="^D DHELP^SROADX"
|
---|
| 158 | .S DIR("??")="^D OHELP^SROADX"
|
---|
| 159 | .S DIR(0)=SRDX1,DIR("A")=SRODIR("A"),DIR("A",1)="",DIR("A",2)=SRODIR("A",1)
|
---|
| 160 | .F I=1:1 D ^DIR Q:$$VALASC()
|
---|
| 161 | .Q:(Y["^")!(Y="")!($P(Y,",",1)=0)
|
---|
| 162 | .I +Y(0)=SRDXCNT D
|
---|
| 163 | ..W !,"ARE YOU SRE YOU WANT TO DELETE ALL ? (Y/N) "
|
---|
| 164 | ..S %=2 D YN^DICN
|
---|
| 165 | ..I %=1 Q:$E($G(IOST))'="C"!($G(DIK)'="") D KOADX^SROADX2(SRTN,OTH)
|
---|
| 166 | .I +Y(0)'=SRDXCNT D Q
|
---|
| 167 | ..S DIR(0)=SRDX1,DIR("A")=SRODIR("A"),DIR("A",1)=""
|
---|
| 168 | ..W ! F I=1:1:80 W "-"
|
---|
| 169 | ..S DIR("A",2)=SRODIR("A",1)
|
---|
| 170 | ..D ODEL1^SROADX1
|
---|
| 171 | .W @IOF
|
---|
| 172 | .D OTHCPTD^SROADX1
|
---|
| 173 | I Y="A" D
|
---|
| 174 | .K DIR
|
---|
| 175 | .D SRODIR^SROADX1
|
---|
| 176 | .W ! F I=1:1:80 W "-"
|
---|
| 177 | .S DIR("?")="^D AHELP^SROADX"
|
---|
| 178 | .S DIR("??")="^D OHELP^SROADX"
|
---|
| 179 | .S SRASSDS=$$OASSDS^SROADX1
|
---|
| 180 | .S DIR("B")=SRASSDS
|
---|
| 181 | .S DIR(0)=SRDX2
|
---|
| 182 | .F I=1:1 D ^DIR Q:(($$VALASC())&('$$DXDUP(Y)))
|
---|
| 183 | .Q:(Y["^")!(Y="")!($P(Y,",",1)=0)
|
---|
| 184 | .I SRDIRX(+Y(0))="ALL" D OADDALL^SROADX1 Q
|
---|
| 185 | .I SRDIRX(+Y(0))'="ALL" D OADD1^SROADX1 Q
|
---|
| 186 | G VOTHADX
|
---|
| 187 | Q
|
---|
| 188 | OHELP ;
|
---|
| 189 | W !!,?5,"The Other Associated Diagnosis is used to associate a diagnosis"
|
---|
| 190 | W !,?5,"or a group of diagnoses to the Other Procedures"
|
---|
| 191 | Q
|
---|
| 192 | PHELP ;
|
---|
| 193 | W !!,?5,"The Principal Associated Diagnosis is used to associate a diagnosis"
|
---|
| 194 | W !,?5,"or a group of diagnoses to the Principal CPT Code"
|
---|
| 195 | Q
|
---|
| 196 | DHELP ;
|
---|
| 197 | W !!,?5,"Please enter a list or range, e.g.,2, or 2,3 or 1-3"
|
---|
| 198 | W !,?5,"from the above list to be Deleted."
|
---|
| 199 | Q
|
---|
| 200 | AHELP ;
|
---|
| 201 | W !!,?5,"Please enter a list or range, e.g.,2, or 2,3 or 1-3"
|
---|
| 202 | W !,?5,"from the above list to be Associated."
|
---|
| 203 | Q
|
---|
| 204 | VHELP ;
|
---|
| 205 | W !!,?5
|
---|
| 206 | W:DIR("0")="SO^D:DELETE;Q:QUIT" "Select either D to Delete or Q to Quit"
|
---|
| 207 | W:DIR("0")="SO^A:ASSOCIATE;D:DELETE;Q:QUIT" "Select A to Associate, D to Delete or Q to Quit"
|
---|
| 208 | W:DIR("0")="SO^A:ASSOCIATE;Q:QUIT" "Select A to Associate or Q to Quit"
|
---|
| 209 | Q
|
---|
| 210 | VHELP1 ;
|
---|
| 211 | W !!,?5
|
---|
| 212 | W:DIR("0")="SO^D:DELETE;Q:QUIT" "This will setup your choices for Deleting any Associated Diagnosis"
|
---|
| 213 | W:DIR("0")="SO^A:ASSOCIATE;D:DELETE;Q:QUIT" "This will setup your choices for Associating or Deleting any Associated Diagnosis"
|
---|
| 214 | W:DIR("0")="SO^A:ASSOCIATE;Q:QUIT" "This will setup your choices for Associating any Associated Diagnosis"
|
---|
| 215 | Q
|
---|
| 216 | PINPUT ;
|
---|
| 217 | Q:$D(EMILY)
|
---|
| 218 | N SRC,SRDX
|
---|
| 219 | S SRC(1)="The Associated Diagnosis can only be added via the",SRC(1,"F")="!!?5"
|
---|
| 220 | S SRC(2)="Surgery Menu options. Your entry has NOT been filed",SRC(2,"F")="!?5"
|
---|
| 221 | D EN^DDIOL(.SRC),CONT^SROADX1
|
---|
| 222 | K X
|
---|
| 223 | Q
|
---|
| 224 | ADXPRMT ;
|
---|
| 225 | I SRDX1'="LO^:0",SRDX2'="LO^:0" S SRDX0="SO^1:ASSOCIATE;2:DELETE;3:QUIT",SROLST="A,D,Q",DIR("L")=" 1 ASSOCIATE 2 DELETE 3 QUIT"
|
---|
| 226 | I SRDX1'="LO^:0",SRDX2="LO^:0" S SRDX0="SO^1:DELETE;2:QUIT",SROLST="D,Q",DIR("L")=" 1 DELETE 2 QUIT"
|
---|
| 227 | I SRDX1="LO^:1",SRDX2'="LO^:0" S SRDX0="SO^1:ASSOCIATE;2:QUIT",SROLST="A,Q",DIR("L")=" 1 ASSOCIATE 2 QUIT"
|
---|
| 228 | I SRDX1="LO^:0",SRDX2="LO^:0" S SRDX0="SO^1:QUIT",SROLST="A,Q",DIR("L")=" No Diagnosis to associate 1 QUIT"
|
---|
| 229 | S DIR(0)=SRDX0,DIR("L",1)=" Select one of the following:",DIR("L",2)=""
|
---|
| 230 | D ^DIR K DIR
|
---|
| 231 | Q
|
---|
| 232 | DXDUP(SRDX) I (Y["^")!($G(DTOUT)) Q 0
|
---|
| 233 | N SRAI,SRDXX,SRDUP,DIR S SRDUP=0
|
---|
| 234 | I SRDX="" Q 0
|
---|
| 235 | F SRAI=1:1:$L(SRDX,",") D
|
---|
| 236 | .Q:$P(SRDX,",",SRAI)<1
|
---|
| 237 | .I $D(SRDXX($P(SRDX,",",SRAI)))!((SRDIRX($P(SRDX,",",SRAI))="ALL")&($L(SRDX,",")>2)) S SRDUP=1,DIR(0)="FO^",DIR("A",1)=" **Duplicates entered",DIR("A")=" Press Return to continue" D ^DIR
|
---|
| 238 | .S SRDXX($P(SRDX,",",SRAI))=""
|
---|
| 239 | Q SRDUP
|
---|
| 240 | VALASC() I (Y["^")!('$G(Y(0)))!($G(DTOUT)) Q 1
|
---|
| 241 | N VALA,DIR S VALA=1
|
---|
| 242 | S:Y=""!(Y=U)!('+Y(0))!(Y[",0")!($P(Y,",",1)=0) VALA=0
|
---|
| 243 | I 'VALA S DIR("A",1)=" **Invalid input",DIR(0)="FO^",DIR("A")=" Press Return to continue" D ^DIR
|
---|
| 244 | Q VALA
|
---|