ICPTCR.m

ICPTCR ;ALB/ABR - MUMPS CROSS REFERENCE ROUTINE ; 3/10/97

 ;;6.0;CPT/HCPCS;;May 19, 1997;Build 44

 ;

 ;  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

ICPTCR    ;ALB/ABR - MUMPS CROSS REFERENCE ROUTINE ; 3/10/97

 +1       ;;6.0;CPT/HCPCS;;May 19, 1997;Build 44

 +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