| [613] | 1 | ICPTCR ;ALB/ABR - MUMPS CROSS REFERENCE ROUTINE ; 3/10/97
|
|---|
| 2 | ;;6.0;CPT/HCPCS;;May 19, 1997;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | ; VARIABLES
|
|---|
| 5 | ; ICPTA = Begin Range
|
|---|
| 6 | ; ICPTX = End Range
|
|---|
| 7 | ;
|
|---|
| 8 | CATEG ; For CATEGORY x-refs (file 81.1, fields 4-BEGIN CPT RANGE, and
|
|---|
| 9 | ; 5-END CPT RANGE)
|
|---|
| 10 | ; CAT = category type; used to determine x-ref "M" or "R"
|
|---|
| 11 | ; where "M" is used only for Major categories, and
|
|---|
| 12 | ; "R" is used for all others (not major) categories.
|
|---|
| 13 | ;
|
|---|
| 14 | CSET(DA,ICPTX,CAT) ; category range x-ref on END range
|
|---|
| 15 | N ICPTA
|
|---|
| 16 | S ICPTA=$P(^DIC(81.1,DA,0),U,4),ICPTA=$$NUM^ICPTAPIU(ICPTA) ; begin cpt range
|
|---|
| 17 | S ICPTX=$$NUM^ICPTAPIU(ICPTX)
|
|---|
| 18 | D CXSET
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | CKIL(DA,CAT) ; x-ref kill on END range
|
|---|
| 22 | N ICPTA
|
|---|
| 23 | S ICPTA=$P(^DIC(81.1,DA,0),U,4),ICPTA=$$NUM^ICPTAPIU(ICPTA)
|
|---|
| 24 | I ICPTA<0 Q
|
|---|
| 25 | D CXKIL
|
|---|
| 26 | Q
|
|---|
| 27 | ;
|
|---|
| 28 | ;
|
|---|
| 29 | CBSET(DA,ICPTA) ; x-ref on begin range for categories
|
|---|
| 30 | ;
|
|---|
| 31 | N ICPTX,CAT
|
|---|
| 32 | D CVAR
|
|---|
| 33 | S ICPTA=$$NUM^ICPTAPIU(ICPTA),ICPTX=$$NUM^ICPTAPIU(ICPTX)
|
|---|
| 34 | D CXSET
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | CBKIL(DA,ICPTA) ; x-ref kill on begin range for categories
|
|---|
| 38 | N ICPTX,CAT
|
|---|
| 39 | D CVAR
|
|---|
| 40 | S ICPTA=$$NUM^ICPTAPIU(ICPTA)
|
|---|
| 41 | D CXKIL
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | CVAR ; set begin range x-ref variables.
|
|---|
| 45 | ; ICPTX = end range
|
|---|
| 46 | N ICPTSTR
|
|---|
| 47 | S ICPTSTR=^DIC(81.1,DA,0),CAT=$S($P(ICPTSTR,U,2)="m":"M",1:"R"),ICPTX=$P(ICPTSTR,U,5)
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | CXSET ; set of category x-ref
|
|---|
| 51 | S ^DIC(81.1,CAT,ICPTA,DA)=ICPTX
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | CXKIL ; kill of category x-ref
|
|---|
| 55 | K ^DIC(81.1,CAT,ICPTA,DA)
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | MODIFIER ; Mod x-refs
|
|---|
| 59 | ; ICPTA = begin range
|
|---|
| 60 | ; ICPTX = end range
|
|---|
| 61 | ; M = If $G(M), do whole file x-ref,
|
|---|
| 62 | ; else, just x-ref within multiple
|
|---|
| 63 | ;
|
|---|
| 64 | MSET(DA,ICPTX,M) ; x-ref on end range
|
|---|
| 65 | N ICPTA
|
|---|
| 66 | S ICPTA=$P(^DIC(81.3,DA(1),10,DA,0),U),ICPTA=$$NUM^ICPTAPIU(ICPTA)
|
|---|
| 67 | S ICPTX=$$NUM^ICPTAPIU(ICPTX)
|
|---|
| 68 | I $G(M) D MXMSET Q
|
|---|
| 69 | D MXSET
|
|---|
| 70 | Q
|
|---|
| 71 | ;
|
|---|
| 72 | MKIL(DA,ICPTX,M) ; x-ref kill on end range
|
|---|
| 73 | N ICPTA
|
|---|
| 74 | S ICPTA=$P(^DIC(81.3,DA(1),10,DA,0),U),ICPTA=$$NUM^ICPTAPIU(ICPTA)
|
|---|
| 75 | S ICPTX=$$NUM^ICPTAPIU(ICPTX)
|
|---|
| 76 | I $G(M) D MXMKIL Q
|
|---|
| 77 | D MXKIL
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
| 80 | MBSET(DA,ICPTA,M) ; modifier begin range x-ref
|
|---|
| 81 | N ICPTX
|
|---|
| 82 | S ICPTX=$P(^DIC(81.3,DA(1),10,DA,0),U,2),ICPTX=$$NUM^ICPTAPIU(ICPTX)
|
|---|
| 83 | S ICPTA=$$NUM^ICPTAPIU(ICPTA)
|
|---|
| 84 | I $G(M) D MXMSET Q
|
|---|
| 85 | D MXSET
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | MBKIL(DA,ICPTA,M) ; modifier begin range x-ref kill
|
|---|
| 89 | N ICPTX
|
|---|
| 90 | S ICPTX=$P(^DIC(81.3,DA(1),10,DA,0),U,2),ICPTX=$$NUM^ICPTAPIU(ICPTX)
|
|---|
| 91 | S ICPTA=$$NUM^ICPTAPIU(ICPTA)
|
|---|
| 92 | I $G(M) D MXMKIL Q
|
|---|
| 93 | D MXKIL
|
|---|
| 94 | Q
|
|---|
| 95 | ;
|
|---|
| 96 | MXSET ; set modifier x-ref
|
|---|
| 97 | S ^DIC(81.3,DA(1),"M",ICPTA)=ICPTX
|
|---|
| 98 | Q
|
|---|
| 99 | ;
|
|---|
| 100 | MXKIL ; kill modifier x-ref
|
|---|
| 101 | K ^DIC(81.3,DA(1),"M",ICPTA)
|
|---|
| 102 | Q
|
|---|
| 103 | ;
|
|---|
| 104 | MXMSET ; set full file x-ref on range
|
|---|
| 105 | S ^DIC(81.3,"M",ICPTA,ICPTX,DA(1))=DA
|
|---|
| 106 | Q
|
|---|
| 107 | MXMKIL ; kill full file x-ref on range
|
|---|
| 108 | K ^DIC(81.3,"M",ICPTA,ICPTX,DA(1))
|
|---|
| 109 | Q
|
|---|
