Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: AZAXPTR

AZAXPTR.m

Go to the documentation of this file. 
  1. AZAXPTR ;IHS/PHXAO/AEF - FIND POINTERS TO REVENUE CODES
  1.  ;;V1.0;ANNE'S SPECIAL ROUTINES;;FEB 26, 2004
  1.  ;
  1.  ;      FINDS POINTERS TO THE REVENUE CODES FILE AND PUTS THEM INTO ARRAY
  1.  ;      ^TMP("AZAX",$J,"PTR",CNT,0)=GLOBALREF^PIECE^PTRVALUE
  1.  ;      
  1.  ;      
  1. EN ;EP -- MAIN ENTRY POINT
  1.  ;
  1.  D ^XBKVAR
  1.  ;
  1.  D BLD
  1.  ;
  1.  K ^TMP("AZAX",$J,"PTR")
  1.  ;
  1.  D FIND
  1.  ;
  1.  Q
  1. FIND ;FIND THE POINTERS
  1.  ;
  1.  N CNT,D0,D1,D2,DATA,DUZ,I,T
  1.  ;
  1.  S CNT=0
  1.  ;
  1.  F I=1:1:7,18,29,30 S T="P"_I D @T
  1.  ;
  1.  Q
  1. P1 ;DEFAULT REVENUE CODE field (#9999999.02) of the CPT File (#81)
  1.  S D0=0
  1.  F  S D0=$O(^ICPT(D0)) Q:'D0  D
  1.  . S PTR=$P($G(^ICPT(D0,9999999)),U,2)
  1.  . D SET(2,.PTR)
  1.  Q
  1.  ;
  1. P2 ;DEFAULT REVENUE CODE field (#9999999.01) of the CPT CATEGORY File (#81.1)
  1.  S D0=0
  1.  F  S D0=$O(^DIC(81.1,D0)) Q:'D0  D
  1.  . S PTR=$P($G(^DIC(81.1,D0,9999999)),U)
  1.  . D SET(1,.PTR)
  1.  Q
  1.  ;
  1. P3 ;REVENUE CODE field (#.09) of the V TRANSACTION CODES File (#9000010.33)
  1.  S D0=0
  1.  F  S D0=$O(^AUPNVTC(D0)) Q:'D0  D
  1.  . S PTR=$P($G(^AUPNVTC(D0,0)),U,9)
  1.  . D SET(9,.PTR)
  1.  Q
  1.  ;
  1. P4 ;CPT/ADA/REV CODE field (#.01) of the CPT,ADA, OR REV INFORMATION sub-field
  1.  ;  (#9002080.197) of the DOCUMENT sub-field (#9002080.01) of the CHS FACILITY
  1.  ;  File (#9002080)
  1.  ;  NOTE: this is a variable pointer so is handled differently
  1.  S D0=0
  1.  F  S D0=$O(^ACHSF(D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^ACHSF(D0,"D",D1)) Q:'D1  D
  1.  . . S D2=0
  1.  . . F  S D2=$O(^ACHSF(D0,"D",D1,11,D2)) Q:'D2  D
  1.  . . . S DATA=$P($G(^ACHSF(D0,"D",D1,11,D2,0)),U)
  1.  . . . S PTR=$P(DATA,";")
  1.  . . . Q:PTR']""
  1.  . . . I $D(PTR(PTR)),DATA=PTR_";AUTTREVN(" D
  1.  . . . . S CNT=CNT+1
  1.  . . . . S ^TMP("AZAX",$J,"PTR",CNT,0)=$ZR_U_1_U_PTR
  1.  Q
  1.  ;
  1. P5 ;REVENUE CODE Field (#.01) of the REVENUE CODE sub-field (#9002274.0131)
  1.  ;  of the 3P FEE TABLE File (#9002274.01)
  1.  S D0=0
  1.  F  S D0=$O(^ABMDFEE(D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^ABMDFEE(D0,31,D1)) Q:'D1  D
  1.  . . S PTR=$P($G(^ABMDFEE(D0,31,D1,0)),U)
  1.  . . D SET(1,.PTR)
  1.  Q
  1.  ;
  1. P6 ;REVENUE CODE field (#.03) of the VISIT TYPE sub-field (#9002274.091) of
  1.  ;  the 3P INSURER File (#9002274.09)
  1.  S DUZ(2)=0
  1.  F  S DUZ(2)=$O(^ABMNINS(DUZ(2))) Q:'DUZ(2)  D
  1.  . S D0=0
  1.  . F  S D0=$O(^ABMNINS(DUZ(2),D0)) Q:'D0  D
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMNINS(DUZ(2),D0,1,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMNINS(DUZ(2),D0,1,D1,0)),U,3)
  1.  . . . D SET(3,.PTR)
  1.  Q
  1.  ;
  1. P7 ;*REVENUE CODE field (#.97) of the 3P CLAIM DATA File (#9002274.3)
  1.  S DUZ(2)=0
  1.  F  S DUZ(2)=$O(^ABMDCLM(DUZ(2)))  Q:'DUZ(2)  D
  1.  . S D0=0
  1.  . F  S D0=$O(^ABMDCLM(DUZ(2),D0)) Q:'D0  D
  1.  . . S PTR=$P($G(^ABMDCLM(DUZ(2),D0,9)),U,7)
  1.  . . D SET(7,.PTR)
  1.  . . ;
  1. P8 . . ;REVENUE CODE field (#.03) of the Surgical Procedure sub-field
  1.  . . ;of the 3P CLAIM DATA File (#9002274.3)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDCLM(DUZ(2),D0,21,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDCLM(DUZ(2),D0,21,D1,0)),U,3)
  1.  . . . D SET(3,.PTR)
  1.  . . ;
  1. P9 . . ;REVENUE CODE field (#.02) of the Pharmacy sub-field (#9002274.3023)
  1.  . . ;of the 3P CLAIM DATA File (#9002274.3)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDCLM(DUZ(2),D0,23,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDCLM(DUZ(2),D0,23,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P10 . . ;REVENUE CODE field (#.01) of the REVENUE CODE sub-field (#9002274.3025)
  1.  . . ;of the 3P CLAIM DATA File (#9002274.3)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDCLM(DUZ(2),D0,25,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDCLM(DUZ(2),D0,25,D1,0)),U)
  1.  . . . D SET(1,.PTR)
  1.  . . ;
  1. P11 . . ;REVENUE CODE field (#.02) of the Medical Procedure sub-field (#9002274.3027)
  1.  . . ;of the 3P CLAIM DATA File (#9002274.3)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDCLM(DUZ(2),D0,27,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDCLM(DUZ(2),D0,27,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P12 . . ;REVENUE CODE field (#.02) of the Dental sub-field (#9002274.3033) of the
  1.  . . ;3P CLAIM DATA File (#9002274.3)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDCLM(DUZ(2),D0,33,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDCLM(DUZ(2),D0,33,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P13 . . ;REVENUE CODE field (#.02) of the Radiology sub-field (#9002274.3035) of
  1.  . . ;the 3P CLAIM DATA File (#9002274.3)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDCLM(DUZ(2),D0,35,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDCLM(DUZ(2),D0,35,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P14 . . ;REVENUE CODE field (#.02) of the Laboratory sub-field (#9002274.3037)
  1.  . . ;of the 3P CLAIM DATA File (#9002274.3)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDCLM(DUZ(2),D0,37,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDCLM(DUZ(2),D0,37,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P15 . . ;REVENUE CODE field (#.02) of the Anesthesia sub-field (#9002274.3039)
  1.  . . ;of the 3P CLAIM DATA File (#9002274.3)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDCLM(DUZ(2),D0,39,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDCLM(DUZ(2),D0,39,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P16 . . ;REVENUE CODE field (#.02) of the Misc. Services sub-field (#9002274.3043)
  1.  . . ;of the 3P CLAIM DATA File (#9002274.3)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDCLM(DUZ(2),D0,43,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDCLM(DUZ(2),D0,43,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P17 . . ;REVENUE CODE field (#.05) of the Charge Master sub-field (#9002274.3045)
  1.  . . ;of the 3P CLAIM DATA File (#9002274.3)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDCLM(DUZ(2),D0,45,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDCLM(DUZ(2),D0,45,D1,0)),U,5)
  1.  . . . D SET(5,.PTR)
  1.  Q
  1.  ;
  1. P18 ;*REVENUE CODE field (#.97) of the 3P BILL File (#9002274.4)
  1.  S DUZ(2)=0
  1.  F  S DUZ(2)=$O(^ABMDBILL(DUZ(2))) Q:'DUZ(2)  D
  1.  . S D0=0
  1.  . F  S D0=$O(^ABMDBILL(DUZ(2),D0)) Q:'D0  D
  1.  . . S PTR=$P($G(^ABMDBILL(DUZ(2),D0,9)),U,7)
  1.  . . D SET(7,.PTR)
  1.  . . ;
  1. P19 . . ;REVENUE CODE field (#.03) of the Med/Surg Procedure sub-field (#9002274.4021)
  1.  . . ;of the 3P BILL File (#9002274.4)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDBILL(DUZ(2),D0,21,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDBILL(DUZ(2),D0,21,D1,0)),U,3)
  1.  . . . D SET(3,.PTR)
  1.  . . ;
  1. P20 . . ;REVENUE CODE field (#.02) of the Pharmacy sub-field (#9002274.4023) of the
  1.  . . ;3P BILL File (#9002274.4)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDBILL(DUZ(2),D0,23,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDBILL(DUZ(2),D0,23,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P21 . . ;REVENUE CODE field (#.01) of the Revenue Code sub-field (#9002274.4025) of
  1.  . . ;the 3P BILL File (#9002274.4)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDBILL(DUZ(2),D0,25,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDBILL(DUZ(2),D0,25,D1,0)),U)
  1.  . . . D SET(1,.PTR)
  1.  . . ;
  1. P22 . . ;REVENUE CODE field (#.02) of the Medical PRocedures sub-field (#9002274.4027)
  1.  . . ;of the 3P BILL File (#9002274.4)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDBILL(DUZ(2),D0,27,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDBILL(DUZ(2),D0,27,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P23 . . ;REVENUE CODE field (#.02) of the Dental sub-field (#9002274.4033) of the
  1.  . . ;3P BILL File (#9002274.4)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDBILL(DUZ(2),D0,33,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDBILL(DUZ(2),D0,33,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P24 . . ;REVENUE CODE field (#.02) of the Radiology sub-field (#9002274.4035) of the
  1.  . . ;3P BILL File (#9002274.4)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDBILL(DUZ(2),D0,35,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDBILL(DUZ(2),D0,35,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P25 . . ;REVENUE CODE field (#.02) of the Laboratory sub-field (#9002274.4037) of the
  1.  . . ;3P BILL File (#9002274.4)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDBILL(DUZ(2),D0,37,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDBILL(DUZ(2),D0,37,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P26 . . ;REVENUE CODE field (#.02) of the Anesthesia sub-field (#9002274.4039) of the
  1.  . . ;3P BILL File (#9002274.4)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDBILL(DUZ(2),D0,39,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDBILL(DUZ(2),D0,39,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P27 . . ;REVENUE CODE field (#.02) of the Misc. Services sub-field (#9002274.4043)
  1.  . . ;of the 3P BILL File (#9002274.4)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDBILL(DUZ(2),D0,43,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDBILL(DUZ(2),D0,43,D1,0)),U,2)
  1.  . . . D SET(2,.PTR)
  1.  . . ;
  1. P28 . . ;REVENUE CODE field (#.05) of the Charge Master sub-field (#9002274.4045)
  1.  . . ;of the 3P BILL File (#9002274.4)
  1.  . . S D1=0
  1.  . . F  S D1=$O(^ABMDBILL(DUZ(2),D0,45,D1)) Q:'D1  D
  1.  . . . S PTR=$P($G(^ABMDBILL(DUZ(2),D0,45,D1,0)),U,5)
  1.  . . . D SET(5,.PTR)
  1.  Q
  1.  ;
  1. P29 ;REVENUE CODE field (#.02) of the 3P CHARGE MASTER File (#9002274.75)
  1.  S D0=0
  1.  F  S D0=$O(^ABMCM(D0)) Q:'D0  D
  1.  . S PTR=$P($G(^ABMCM(D0,0)),U,2)
  1.  . D SET(2,.PTR)
  1.  Q
  1.  ;
  1. P30 ;REVENUE CODE field (#.03) of the VISIT TYPE sub-field (#9999999.183901)
  1.  ;of the INSURER File (#999999.18)
  1.  S D0=0
  1.  F  S D0=$O(^AUTNINS(D0)) Q:'D0  D
  1.  . S D1=0
  1.  . F  S D1=$O(^AUTNINS(D0,39,D1)) Q:'D1  D
  1.  . . S PTR=$P($G(^AUTNINS(D0,39,D1,0)),U,3)
  1.  . . D SET(3,.PTR)
  1.  Q
  1. SET(PIECE,PTR) ;
  1.  ;----- SET ^TMP GLOBAL
  1.  ;
  1.  Q:'$D(PTR(+PTR))
  1.  S CNT=CNT+1
  1.  S ^TMP("AZAX",$J,"PTR",CNT,0)=$ZR_U_PIECE_U_PTR
  1.  Q
  1. BLD ;----- BUILD ARRAY OF POINTER VALUES
  1.  ;
  1.  N I
  1.  K PTR
  1.  F I=999:1:9999 S PTR(I)=I
  1.  Q