ICPTCR ;ALB/ABR - MUMPS CROSS REFERENCE ROUTINE ; 3/10/97
;;6.0;CPT/HCPCS;;May 19, 1997
;
; VARIABLES
; ICPTA = Begin Range
; ICPTX = End Range
;
CATEG ; For CATEGORY x-refs (file 81.1, fields 4-BEGIN CPT RANGE, and
; 5-END CPT RANGE)
; CAT = category type; used to determine x-ref "M" or "R"
; where "M" is used only for Major categories, and
; "R" is used for all others (not major) categories.
;
CSET(DA,ICPTX,CAT) ; category range x-ref on END range
N ICPTA
S ICPTA=$P(^DIC(81.1,DA,0),U,4),ICPTA=$$NUM^ICPTAPIU(ICPTA) ; begin cpt range
S ICPTX=$$NUM^ICPTAPIU(ICPTX)
D CXSET
Q
;
CKIL(DA,CAT) ; x-ref kill on END range
N ICPTA
S ICPTA=$P(^DIC(81.1,DA,0),U,4),ICPTA=$$NUM^ICPTAPIU(ICPTA)
I ICPTA<0 Q
D CXKIL
Q
;
;
CBSET(DA,ICPTA) ; x-ref on begin range for categories
;
N ICPTX,CAT
D CVAR
S ICPTA=$$NUM^ICPTAPIU(ICPTA),ICPTX=$$NUM^ICPTAPIU(ICPTX)
D CXSET
Q
;
CBKIL(DA,ICPTA) ; x-ref kill on begin range for categories
N ICPTX,CAT
D CVAR
S ICPTA=$$NUM^ICPTAPIU(ICPTA)
D CXKIL
Q
;
CVAR ; set begin range x-ref variables.
; ICPTX = end range
N ICPTSTR
S ICPTSTR=^DIC(81.1,DA,0),CAT=$S($P(ICPTSTR,U,2)="m":"M",1:"R"),ICPTX=$P(ICPTSTR,U,5)
Q
;
CXSET ; set of category x-ref
S ^DIC(81.1,CAT,ICPTA,DA)=ICPTX
Q
;
CXKIL ; kill of category x-ref
K ^DIC(81.1,CAT,ICPTA,DA)
Q
;
MODIFIER ; Mod x-refs
; ICPTA = begin range
; ICPTX = end range
; M = If $G(M), do whole file x-ref,
; else, just x-ref within multiple
;
MSET(DA,ICPTX,M) ; x-ref on end range
N ICPTA
S ICPTA=$P(^DIC(81.3,DA(1),10,DA,0),U),ICPTA=$$NUM^ICPTAPIU(ICPTA)
S ICPTX=$$NUM^ICPTAPIU(ICPTX)
I $G(M) D MXMSET Q
D MXSET
Q
;
MKIL(DA,ICPTX,M) ; x-ref kill on end range
N ICPTA
S ICPTA=$P(^DIC(81.3,DA(1),10,DA,0),U),ICPTA=$$NUM^ICPTAPIU(ICPTA)
S ICPTX=$$NUM^ICPTAPIU(ICPTX)
I $G(M) D MXMKIL Q
D MXKIL
Q
;
MBSET(DA,ICPTA,M) ; modifier begin range x-ref
N ICPTX
S ICPTX=$P(^DIC(81.3,DA(1),10,DA,0),U,2),ICPTX=$$NUM^ICPTAPIU(ICPTX)
S ICPTA=$$NUM^ICPTAPIU(ICPTA)
I $G(M) D MXMSET Q
D MXSET
Q
;
MBKIL(DA,ICPTA,M) ; modifier begin range x-ref kill
N ICPTX
S ICPTX=$P(^DIC(81.3,DA(1),10,DA,0),U,2),ICPTX=$$NUM^ICPTAPIU(ICPTX)
S ICPTA=$$NUM^ICPTAPIU(ICPTA)
I $G(M) D MXMKIL Q
D MXKIL
Q
;
MXSET ; set modifier x-ref
S ^DIC(81.3,DA(1),"M",ICPTA)=ICPTX
Q
;
MXKIL ; kill modifier x-ref
K ^DIC(81.3,DA(1),"M",ICPTA)
Q
;
MXMSET ; set full file x-ref on range
S ^DIC(81.3,"M",ICPTA,ICPTX,DA(1))=DA
Q
MXMKIL ; kill full file x-ref on range
K ^DIC(81.3,"M",ICPTA,ICPTX,DA(1))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICPTCR 2697 printed Apr 09, 2024@20:50:50 Page 2
ICPTCR ;ALB/ABR - MUMPS CROSS REFERENCE ROUTINE ; 3/10/97
+1 ;;6.0;CPT/HCPCS;;May 19, 1997
+2 ;
+3 ; VARIABLES
+4 ; ICPTA = Begin Range
+5 ; ICPTX = End Range
+6 ;
CATEG ; For CATEGORY x-refs (file 81.1, fields 4-BEGIN CPT RANGE, and
+1 ; 5-END CPT RANGE)
+2 ; CAT = category type; used to determine x-ref "M" or "R"
+3 ; where "M" is used only for Major categories, and
+4 ; "R" is used for all others (not major) categories.
+5 ;
CSET(DA,ICPTX,CAT) ; category range x-ref on END range
+1 NEW ICPTA
+2 ; begin cpt range
SET ICPTA=$PIECE(^DIC(81.1,DA,0),U,4)
SET ICPTA=$$NUM^ICPTAPIU(ICPTA)
+3 SET ICPTX=$$NUM^ICPTAPIU(ICPTX)
+4 DO CXSET
+5 QUIT
+6 ;
CKIL(DA,CAT) ; x-ref kill on END range
+1 NEW ICPTA
+2 SET ICPTA=$PIECE(^DIC(81.1,DA,0),U,4)
SET ICPTA=$$NUM^ICPTAPIU(ICPTA)
+3 IF ICPTA<0
QUIT
+4 DO CXKIL
+5 QUIT
+6 ;
+7 ;
CBSET(DA,ICPTA) ; x-ref on begin range for categories
+1 ;
+2 NEW ICPTX,CAT
+3 DO CVAR
+4 SET ICPTA=$$NUM^ICPTAPIU(ICPTA)
SET ICPTX=$$NUM^ICPTAPIU(ICPTX)
+5 DO CXSET
+6 QUIT
+7 ;
CBKIL(DA,ICPTA) ; x-ref kill on begin range for categories
+1 NEW ICPTX,CAT
+2 DO CVAR
+3 SET ICPTA=$$NUM^ICPTAPIU(ICPTA)
+4 DO CXKIL
+5 QUIT
+6 ;
CVAR ; set begin range x-ref variables.
+1 ; ICPTX = end range
+2 NEW ICPTSTR
+3 SET ICPTSTR=^DIC(81.1,DA,0)
SET CAT=$SELECT($PIECE(ICPTSTR,U,2)="m":"M",1:"R")
SET ICPTX=$PIECE(ICPTSTR,U,5)
+4 QUIT
+5 ;
CXSET ; set of category x-ref
+1 SET ^DIC(81.1,CAT,ICPTA,DA)=ICPTX
+2 QUIT
+3 ;
CXKIL ; kill of category x-ref
+1 KILL ^DIC(81.1,CAT,ICPTA,DA)
+2 QUIT
+3 ;
MODIFIER ; Mod x-refs
+1 ; ICPTA = begin range
+2 ; ICPTX = end range
+3 ; M = If $G(M), do whole file x-ref,
+4 ; else, just x-ref within multiple
+5 ;
MSET(DA,ICPTX,M) ; x-ref on end range
+1 NEW ICPTA
+2 SET ICPTA=$PIECE(^DIC(81.3,DA(1),10,DA,0),U)
SET ICPTA=$$NUM^ICPTAPIU(ICPTA)
+3 SET ICPTX=$$NUM^ICPTAPIU(ICPTX)
+4 IF $GET(M)
DO MXMSET
QUIT
+5 DO MXSET
+6 QUIT
+7 ;
MKIL(DA,ICPTX,M) ; x-ref kill on end range
+1 NEW ICPTA
+2 SET ICPTA=$PIECE(^DIC(81.3,DA(1),10,DA,0),U)
SET ICPTA=$$NUM^ICPTAPIU(ICPTA)
+3 SET ICPTX=$$NUM^ICPTAPIU(ICPTX)
+4 IF $GET(M)
DO MXMKIL
QUIT
+5 DO MXKIL
+6 QUIT
+7 ;
MBSET(DA,ICPTA,M) ; modifier begin range x-ref
+1 NEW ICPTX
+2 SET ICPTX=$PIECE(^DIC(81.3,DA(1),10,DA,0),U,2)
SET ICPTX=$$NUM^ICPTAPIU(ICPTX)
+3 SET ICPTA=$$NUM^ICPTAPIU(ICPTA)
+4 IF $GET(M)
DO MXMSET
QUIT
+5 DO MXSET
+6 QUIT
+7 ;
MBKIL(DA,ICPTA,M) ; modifier begin range x-ref kill
+1 NEW ICPTX
+2 SET ICPTX=$PIECE(^DIC(81.3,DA(1),10,DA,0),U,2)
SET ICPTX=$$NUM^ICPTAPIU(ICPTX)
+3 SET ICPTA=$$NUM^ICPTAPIU(ICPTA)
+4 IF $GET(M)
DO MXMKIL
QUIT
+5 DO MXKIL
+6 QUIT
+7 ;
MXSET ; set modifier x-ref
+1 SET ^DIC(81.3,DA(1),"M",ICPTA)=ICPTX
+2 QUIT
+3 ;
MXKIL ; kill modifier x-ref
+1 KILL ^DIC(81.3,DA(1),"M",ICPTA)
+2 QUIT
+3 ;
MXMSET ; set full file x-ref on range
+1 SET ^DIC(81.3,"M",ICPTA,ICPTX,DA(1))=DA
+2 QUIT
MXMKIL ; kill full file x-ref on range
+1 KILL ^DIC(81.3,"M",ICPTA,ICPTX,DA(1))
+2 QUIT
