QAMGRP2 ;HISC/DAD-AUTO LOAD GROUP DATA: ICD PROCEDURES ;2/10/92 07:33
;;1.0;Clinical Monitoring System;;09/13/1993
F QAQLABEL="AN","TR8","TR10","TR11","CV4" S QAQCHECK=0 D LOOP Q:QAQCHECK=-1
EXIT K X,DIC,DLAYGO,QAMD0,Y,OFFSET,LINE,ST,END,NUM,D0,DIK,DA,LASTD0,TAB,QAQCHECK,QAQCOUNT
Q
LOOP ;
S X=$P($T(@QAQLABEL),";;",2) W !!,"Loading: ",X
S QAMD0=+$O(^QA(743.5,"B",$E(X,1,30),0)) I QAMD0 W !!?5,"*** ",X," already exists !! ***",*7 D G:(QAQCHECK=-1)!(QAQCHECK=2) XIT
ASK . W !!?5,"Do you want to check this group's completeness"
. S %=2 D YN^DICN I '% W !!?10,"Please answer Y(es) or N(o)" G ASK
. S QAQCHECK=%
. Q
W !!,"Working",! S (QAQCOUNT,TAB)=0
I QAQCHECK'>0 K DD,DIC,DINUM,DO S DIC="^QA(743.5,",DIC(0)="LM",DIC("DR")=".02////80.1",DLAYGO=743.5 D FILE^DICN S QAMD0=+Y
F OFFSET=1:1 S LINE=$P($T(@QAQLABEL+OFFSET),";;",2) Q:LINE="" D
. S ST=+LINE,END=$S(LINE["-":+$P(LINE,"-",2),1:ST),NUM=ST-.000001
. F S NUM=$O(^ICD0("BA",NUM)) Q:(NUM'>0)!(NUM>END) D
.. F D0=0:0 S D0=$O(^ICD0("BA",NUM,D0)) Q:D0'>0 D
... S NUMBER=$P($G(^ICD0(D0,0)),"^") Q:NUMBER'>0
... S X=NUMBER_";"_D0
... G:$O(^QA(743.5,QAMD0,"GRP","B",$E(X,1,30),0)) SKIP
... S ^QA(743.5,QAMD0,"GRP",D0,0)=X
... S QAQADICT=743.51,QAQAFLD=.01,DA(1)=QAMD0,DA=D0 D ENSET^QAQAXREF
SKIP ... S LASTD0=D0,QAQCOUNT=QAQCOUNT+1
... W:'TAB ! W ?TAB,NUMBER S TAB=TAB+$S(TAB=70:-70,1:10)
... Q
.. Q
. Q
S ^QA(743.5,QAMD0,"GRP",0)="^743.51A^"_LASTD0_"^"_QAQCOUNT
W !!,QAQCOUNT," ICD-9-CM Procedure Codes ",$S(QAQCHECK=1:"checked",1:"loaded"),".",!
XIT Q
AN ;;ANESTHESIA INDICATOR PROC LIST
;;01.-02.4
;;02.42-02.93
;;02.99-03.3
;;03.32-03.79
;;03.9
;;03.97
;;04.-04.1
;;04.12-04.79
;;04.9-04.92
;;04.99-05.29
;;05.8-06.1
;;06.12-07.1
;;07.12-08.2
;;08.23-08.24
;;08.3-09.
;;09.1-10.
;;11.1-18.
;;18.2- 20.
;;20.2-20.3
;;20.32-21.0
;;21.03-21.2
;;21.22-21.29
;;21.4-22.
;;22.1
;;22.12
;;22.2-24.0
;;24.2-24.5
;;24.9-25.0
;;25.02
;;25.1-25.5
;;25.59-25.9
;;25.93-26.1
;;26.12-26.9
;;26.99-27.1
;;27.3-27.4
;;27.42-27.51
;;27.53-27.9
;;27.92-28.0
;;28.19-29.1
;;29.12-31.
;;31.1-31.4
;;31.42-33.2
;;33.22-33.25
;;33.27-34.24
;;34.26-34.9
;;34.93-36.00
;;36.03-36.04
;;36.09-37.2
;;37.24-37.6
;;37.62-37.70
;;37.74-37.75
;;37.8-37.9
;;37.99-38.89
;;39.-39.59
;;39.7-39.91
;;39.93-39.94
;;39.96-41.0
;;41.01-41.3
;;41.33-42.21
;;42.23-44.11
;;44.13-44.92
;;44.99-45.11
;;45.13-45.21
;;45.26-45.41
;;45.49-46.94
;;46.99-48.21
;;48.25-49.12
;;49.4
;;49.43-50.1
;;50.12-51.0
;;51.02-51.11
;;51.13-52.1
;;52.12-54.23
;;54.29-54.9
;;54.92-54.95
;;54.99-55.22
;;55.24-55.91
;;55.96-56.32
;;56.34-57.1
;;57.12
;;57.18-57.3
;;57.34-57.91
;;57.93
;;57.96-58.0
;;58.2
;;58.22-58.5
;;58.9-59.92
;;59.99-60.1
;;60.12
;;60.14-60.7
;;60.72-60.91
;;60.93-61.1
;;61.2-61.4
;;61.42-61.9
;;61.92-62.1
;;62.12-63.6
;;63.8-63.9
;;63.92-64.1
;;64.19-64.9
;;64.92-64.93
;;64.95-66.79
;;66.9-67.
;;67.2-67.6
;;67.62-68.1
;;68.13-69.59
;;69.9-69.91
;;69.95
;;69.98-70.
;;70.1
;;70.12-70.2
;;70.3
;;70.32-70.75
;;70.77-71.1
;;71.19-71.2
;;71.22-73.
;;73.1-73.22
;;73.8-75.
;;75.3-75.31
;;75.35-75.50
;;75.52-75.61
;;75.69-76.95
;;76.97-79.02
;;79.05-79.07
;;79.09-79.72
;;79.75-79.77
;;79.79-80.19
;;80.4-81.9
;;81.93-83.95
;;83.99-84.40
;;84.44
;;84.9-85.1
;;85.12-85.50
;;85.53-86.0
;;86.03
;;86.05-86.09
;;86.2-86.22
;;86.4-86.91
;;86.93-86.99
;;93.26
;;94.26-94.27
;;98.5-98.59
;;
TR8 ;;TR-8 PROC GROUP
;;39.31
;;39.32
;;39.56
;;39.57
;;41.43
;;41.5
;;41.95
;;41.99
;;44.61
;;46.71
;;46.73
;;50.22
;;50.3
;;50.4
;;50.61
;;50.69
;;52.95
;;54.11
;;54.92
;;55.4
;;55.5
;;55.81
;;55.82
;;57.79
;;
TR10 ;;TR-10 PROC GROUP
;;79.15
;;79.35
;;
TR11 ;;TR-11 PROC GROUP
;;01.24
;;02.02
;;38.06
;;38.07
;;38.44
;;38.46
;;38.47
;;38.7
;;38.84
;;38.86
;;38.87
;;39.1
;;39.24
;;39.25
;;39.26
;;39.29
;;39.3-39.399999
;;39.56
;;39.57
;;39.58
;;44.49
;;44.61
;;46.10
;;46.20
;;46.21
;;46.73
;;46.75
;;50.22
;;50.4
;;50.6
;;51.71
;;51.79
;;51.91
;;52.5
;;52.6
;;52.95
;;54.11
;;54.19
;;54.3
;;54.74
;;54.75
;;54.91
;;54.92
;;55.4
;;55.5
;;55.81
;;56.82
;;32.3
;;32.4
;;33.4-33.499999
;;34.01
;;34.91
;;34.93
;;38.85
;;39.21
;;39.22
;;39.3-39.399999
;;39.56
;;39.57
;;39.58
;;37.0
;;37.12
;;37.4
;;34.02
;;38.04
;;38.34
;;38.35
;;38.84
;;38.85
;;38.56
;;39.57
;;39.58
;;54.11
;;33.4-33.499999
;;34.01
;;34.02
;;34.04
;;34.09
;;34.71
;;34.91
;;34.92
;;34.93
;;
CV4 ;;CV-4 PROC GROUP
;;36.1-36.199999
;;36.01
;;36.02
;;36.09
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMGRP2 4911 printed Apr 09, 2024@20:47:18 Page 2
QAMGRP2 ;HISC/DAD-AUTO LOAD GROUP DATA: ICD PROCEDURES ;2/10/92 07:33
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 FOR QAQLABEL="AN","TR8","TR10","TR11","CV4"
SET QAQCHECK=0
DO LOOP
if QAQCHECK=-1
QUIT
EXIT KILL X,DIC,DLAYGO,QAMD0,Y,OFFSET,LINE,ST,END,NUM,D0,DIK,DA,LASTD0,TAB,QAQCHECK,QAQCOUNT
+1 QUIT
LOOP ;
+1 SET X=$PIECE($TEXT(@QAQLABEL),";;",2)
WRITE !!,"Loading: ",X
+2 SET QAMD0=+$ORDER(^QA(743.5,"B",$EXTRACT(X,1,30),0))
IF QAMD0
WRITE !!?5,"*** ",X," already exists !! ***",*7
Begin DoDot:1
ASK WRITE !!?5,"Do you want to check this group's completeness"
+1 SET %=2
DO YN^DICN
IF '%
WRITE !!?10,"Please answer Y(es) or N(o)"
GOTO ASK
+2 SET QAQCHECK=%
+3 QUIT
End DoDot:1
if (QAQCHECK=-1)!(QAQCHECK=2)
GOTO XIT
+4 WRITE !!,"Working",!
SET (QAQCOUNT,TAB)=0
+5 IF QAQCHECK'>0
KILL DD,DIC,DINUM,DO
SET DIC="^QA(743.5,"
SET DIC(0)="LM"
SET DIC("DR")=".02////80.1"
SET DLAYGO=743.5
DO FILE^DICN
SET QAMD0=+Y
+6 FOR OFFSET=1:1
SET LINE=$PIECE($TEXT(@QAQLABEL+OFFSET),";;",2)
if LINE=""
QUIT
Begin DoDot:1
+7 SET ST=+LINE
SET END=$SELECT(LINE["-":+$PIECE(LINE,"-",2),1:ST)
SET NUM=ST-.000001
+8 FOR
SET NUM=$ORDER(^ICD0("BA",NUM))
if (NUM'>0)!(NUM>END)
QUIT
Begin DoDot:2
+9 FOR D0=0:0
SET D0=$ORDER(^ICD0("BA",NUM,D0))
if D0'>0
QUIT
Begin DoDot:3
+10 SET NUMBER=$PIECE($GET(^ICD0(D0,0)),"^")
if NUMBER'>0
QUIT
+11 SET X=NUMBER_";"_D0
+12 if $ORDER(^QA(743.5,QAMD0,"GRP","B",$EXTRACT(X,1,30),0))
GOTO SKIP
+13 SET ^QA(743.5,QAMD0,"GRP",D0,0)=X
+14 SET QAQADICT=743.51
SET QAQAFLD=.01
SET DA(1)=QAMD0
SET DA=D0
DO ENSET^QAQAXREF
SKIP SET LASTD0=D0
SET QAQCOUNT=QAQCOUNT+1
+1 if 'TAB
WRITE !
WRITE ?TAB,NUMBER
SET TAB=TAB+$SELECT(TAB=70:-70,1:10)
+2 QUIT
End DoDot:3
+3 QUIT
End DoDot:2
+4 QUIT
End DoDot:1
+5 SET ^QA(743.5,QAMD0,"GRP",0)="^743.51A^"_LASTD0_"^"_QAQCOUNT
+6 WRITE !!,QAQCOUNT," ICD-9-CM Procedure Codes ",$SELECT(QAQCHECK=1:"checked",1:"loaded"),".",!
XIT QUIT
AN ;;ANESTHESIA INDICATOR PROC LIST
+1 ;;01.-02.4
+2 ;;02.42-02.93
+3 ;;02.99-03.3
+4 ;;03.32-03.79
+5 ;;03.9
+6 ;;03.97
+7 ;;04.-04.1
+8 ;;04.12-04.79
+9 ;;04.9-04.92
+10 ;;04.99-05.29
+11 ;;05.8-06.1
+12 ;;06.12-07.1
+13 ;;07.12-08.2
+14 ;;08.23-08.24
+15 ;;08.3-09.
+16 ;;09.1-10.
+17 ;;11.1-18.
+18 ;;18.2- 20.
+19 ;;20.2-20.3
+20 ;;20.32-21.0
+21 ;;21.03-21.2
+22 ;;21.22-21.29
+23 ;;21.4-22.
+24 ;;22.1
+25 ;;22.12
+26 ;;22.2-24.0
+27 ;;24.2-24.5
+28 ;;24.9-25.0
+29 ;;25.02
+30 ;;25.1-25.5
+31 ;;25.59-25.9
+32 ;;25.93-26.1
+33 ;;26.12-26.9
+34 ;;26.99-27.1
+35 ;;27.3-27.4
+36 ;;27.42-27.51
+37 ;;27.53-27.9
+38 ;;27.92-28.0
+39 ;;28.19-29.1
+40 ;;29.12-31.
+41 ;;31.1-31.4
+42 ;;31.42-33.2
+43 ;;33.22-33.25
+44 ;;33.27-34.24
+45 ;;34.26-34.9
+46 ;;34.93-36.00
+47 ;;36.03-36.04
+48 ;;36.09-37.2
+49 ;;37.24-37.6
+50 ;;37.62-37.70
+51 ;;37.74-37.75
+52 ;;37.8-37.9
+53 ;;37.99-38.89
+54 ;;39.-39.59
+55 ;;39.7-39.91
+56 ;;39.93-39.94
+57 ;;39.96-41.0
+58 ;;41.01-41.3
+59 ;;41.33-42.21
+60 ;;42.23-44.11
+61 ;;44.13-44.92
+62 ;;44.99-45.11
+63 ;;45.13-45.21
+64 ;;45.26-45.41
+65 ;;45.49-46.94
+66 ;;46.99-48.21
+67 ;;48.25-49.12
+68 ;;49.4
+69 ;;49.43-50.1
+70 ;;50.12-51.0
+71 ;;51.02-51.11
+72 ;;51.13-52.1
+73 ;;52.12-54.23
+74 ;;54.29-54.9
+75 ;;54.92-54.95
+76 ;;54.99-55.22
+77 ;;55.24-55.91
+78 ;;55.96-56.32
+79 ;;56.34-57.1
+80 ;;57.12
+81 ;;57.18-57.3
+82 ;;57.34-57.91
+83 ;;57.93
+84 ;;57.96-58.0
+85 ;;58.2
+86 ;;58.22-58.5
+87 ;;58.9-59.92
+88 ;;59.99-60.1
+89 ;;60.12
+90 ;;60.14-60.7
+91 ;;60.72-60.91
+92 ;;60.93-61.1
+93 ;;61.2-61.4
+94 ;;61.42-61.9
+95 ;;61.92-62.1
+96 ;;62.12-63.6
+97 ;;63.8-63.9
+98 ;;63.92-64.1
+99 ;;64.19-64.9
+100 ;;64.92-64.93
+101 ;;64.95-66.79
+102 ;;66.9-67.
+103 ;;67.2-67.6
+104 ;;67.62-68.1
+105 ;;68.13-69.59
+106 ;;69.9-69.91
+107 ;;69.95
+108 ;;69.98-70.
+109 ;;70.1
+110 ;;70.12-70.2
+111 ;;70.3
+112 ;;70.32-70.75
+113 ;;70.77-71.1
+114 ;;71.19-71.2
+115 ;;71.22-73.
+116 ;;73.1-73.22
+117 ;;73.8-75.
+118 ;;75.3-75.31
+119 ;;75.35-75.50
+120 ;;75.52-75.61
+121 ;;75.69-76.95
+122 ;;76.97-79.02
+123 ;;79.05-79.07
+124 ;;79.09-79.72
+125 ;;79.75-79.77
+126 ;;79.79-80.19
+127 ;;80.4-81.9
+128 ;;81.93-83.95
+129 ;;83.99-84.40
+130 ;;84.44
+131 ;;84.9-85.1
+132 ;;85.12-85.50
+133 ;;85.53-86.0
+134 ;;86.03
+135 ;;86.05-86.09
+136 ;;86.2-86.22
+137 ;;86.4-86.91
+138 ;;86.93-86.99
+139 ;;93.26
+140 ;;94.26-94.27
+141 ;;98.5-98.59
+142 ;;
TR8 ;;TR-8 PROC GROUP
+1 ;;39.31
+2 ;;39.32
+3 ;;39.56
+4 ;;39.57
+5 ;;41.43
+6 ;;41.5
+7 ;;41.95
+8 ;;41.99
+9 ;;44.61
+10 ;;46.71
+11 ;;46.73
+12 ;;50.22
+13 ;;50.3
+14 ;;50.4
+15 ;;50.61
+16 ;;50.69
+17 ;;52.95
+18 ;;54.11
+19 ;;54.92
+20 ;;55.4
+21 ;;55.5
+22 ;;55.81
+23 ;;55.82
+24 ;;57.79
+25 ;;
TR10 ;;TR-10 PROC GROUP
+1 ;;79.15
+2 ;;79.35
+3 ;;
TR11 ;;TR-11 PROC GROUP
+1 ;;01.24
+2 ;;02.02
+3 ;;38.06
+4 ;;38.07
+5 ;;38.44
+6 ;;38.46
+7 ;;38.47
+8 ;;38.7
+9 ;;38.84
+10 ;;38.86
+11 ;;38.87
+12 ;;39.1
+13 ;;39.24
+14 ;;39.25
+15 ;;39.26
+16 ;;39.29
+17 ;;39.3-39.399999
+18 ;;39.56
+19 ;;39.57
+20 ;;39.58
+21 ;;44.49
+22 ;;44.61
+23 ;;46.10
+24 ;;46.20
+25 ;;46.21
+26 ;;46.73
+27 ;;46.75
+28 ;;50.22
+29 ;;50.4
+30 ;;50.6
+31 ;;51.71
+32 ;;51.79
+33 ;;51.91
+34 ;;52.5
+35 ;;52.6
+36 ;;52.95
+37 ;;54.11
+38 ;;54.19
+39 ;;54.3
+40 ;;54.74
+41 ;;54.75
+42 ;;54.91
+43 ;;54.92
+44 ;;55.4
+45 ;;55.5
+46 ;;55.81
+47 ;;56.82
+48 ;;32.3
+49 ;;32.4
+50 ;;33.4-33.499999
+51 ;;34.01
+52 ;;34.91
+53 ;;34.93
+54 ;;38.85
+55 ;;39.21
+56 ;;39.22
+57 ;;39.3-39.399999
+58 ;;39.56
+59 ;;39.57
+60 ;;39.58
+61 ;;37.0
+62 ;;37.12
+63 ;;37.4
+64 ;;34.02
+65 ;;38.04
+66 ;;38.34
+67 ;;38.35
+68 ;;38.84
+69 ;;38.85
+70 ;;38.56
+71 ;;39.57
+72 ;;39.58
+73 ;;54.11
+74 ;;33.4-33.499999
+75 ;;34.01
+76 ;;34.02
+77 ;;34.04
+78 ;;34.09
+79 ;;34.71
+80 ;;34.91
+81 ;;34.92
+82 ;;34.93
+83 ;;
CV4 ;;CV-4 PROC GROUP
+1 ;;36.1-36.199999
+2 ;;36.01
+3 ;;36.02
+4 ;;36.09
+5 ;;
