source: FOIAVistA/tag/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMGRP2.m@ 628

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
 ;;