- XUSTAX ;PRXM/GCD, TAXONOMY CODE LOOKUP FOR INTEGRATED BILLING ;8/3/07
- ;;8.0;KERNEL;**410,452,454,467**; July 10, 1995;Build 12
- ;
- ; Must call at an entry point.
- Q
- ;
- ; TAXIND - Extrinsic function to retrieve the taxonomy code
- ; for a given record in the NEW PERSON file (#200).
- ;
- ; Input
- ; XUIEN - IEN of the record in file #200
- ; Output
- ; Piece 1 = Taxonomy X12 code of the record in file #200
- ; Piece 2 = Taxonomy IEN from file 8932.1
- TAXIND(XUIEN) ; Get taxonomy for an individual
- N U S U="^"
- I $G(XUIEN)'>0 Q U
- ;I (XUIEN?.N)=0 Q U
- I ((XUIEN?.N)!(XUIEN?.N1"."1N.N))=0 Q "-1^Invalid IEN"
- N IEN,XUPTR,XUTAXARR,DIC,DR,DA,DIQ,DI,D0,XUTAX
- S IEN=0,XUPTR=""
- F S IEN=$O(^VA(200,XUIEN,"USC1",IEN)) Q:'IEN D ;Q:XUPTR'=""
- . S DIC=200,DR=8932.1,DA=XUIEN,DR(200.05)=".01:3",DA(200.05)=IEN,DIQ="XUTAXARR",DIQ(0)="I"
- . D EN^DIQ1
- . I XUTAXARR(200.05,IEN,"2","I")>DT Q ; Not effective yet
- . I XUTAXARR(200.05,IEN,"3","I")'="",XUTAXARR(200.05,IEN,"3","I")<DT Q ; Expired
- . S XUPTR=XUTAXARR(200.05,IEN,".01","I")
- S XUTAX=$$GET1^DIQ(8932.1,XUPTR,"X12 CODE")
- Q XUTAX_U_XUPTR
- ;
- ; TAXORG - Extrinsic function to retrieve the taxonomy code
- ; for a given record in the INSTITUTION file (#4).
- ;
- ; Input
- ; XUIEN - IEN of the record in file #4
- ; Output
- ; Piece 1 = Taxonomy X12 code of the record in file #4
- ; Piece 2 = Taxonomy IEN from file 8932.1
- TAXORG(XUIEN) ; Get taxonomy for an organization
- N U S U="^"
- I $G(XUIEN)'>0 Q U
- ;I (XUIEN?.N)=0 Q U
- I ((XUIEN?.N)!(XUIEN?.N1"."1N.N))=0 Q "-1^Invalid IEN"
- N IEN,XUPTR,XUTAXAR,DIC,DR,DA,DIQ,DI,D0,XUTAX
- S IEN=0,XUPTR=""
- F S IEN=$O(^DIC(4,XUIEN,"TAXONOMY",IEN)) Q:'IEN D
- . S DIC=4,DR=43,DA=XUIEN,DR(4.043)=".01:.03",DA(4.043)=IEN,DIQ="XUTAXARR",DIQ(0)="IE"
- . D EN^DIQ1
- . I XUTAXARR(4.043,IEN,".03","E")'="ACTIVE" Q
- . I XUTAXARR(4.043,IEN,".02","E")="YES" S XUPTR=XUTAXARR(4.043,IEN,".01","I") Q
- . I XUPTR="" S XUPTR=XUTAXARR(4.043,IEN,".01","I")
- S XUTAX=$$GET1^DIQ(8932.1,XUPTR,"X12 CODE")
- Q XUTAX_U_XUPTR
- ;
- TAXINQ(XUIEN) ;Get the last taxonomy for an individual
- I +$G(XUIEN)'=$G(XUIEN) Q ""
- N IEN,XUI,XUY,XUEXF S IEN=0,XUI="",XUEXF="-Expired"
- F S IEN=$O(^VA(200,XUIEN,"USC1",IEN)) Q:'IEN D
- . S XUY=+$G(^VA(200,XUIEN,"USC1",IEN,0))
- . S XUI=$G(^USC(8932.1,XUY,0))
- . S XUI=$P(XUI,"^",7)
- I +$$GET^XUA4A72(XUIEN)=-2,XUI'="" S XUI=XUI_XUEXF
- Q XUI
- XUSTAX ;PRXM/GCD, TAXONOMY CODE LOOKUP FOR INTEGRATED BILLING ;8/3/07
- +1 ;;8.0;KERNEL;**410,452,454,467**; July 10, 1995;Build 12
- +2 ;
- +3 ; Must call at an entry point.
- +4 QUIT
- +5 ;
- +6 ; TAXIND - Extrinsic function to retrieve the taxonomy code
- +7 ; for a given record in the NEW PERSON file (#200).
- +8 ;
- +9 ; Input
- +10 ; XUIEN - IEN of the record in file #200
- +11 ; Output
- +12 ; Piece 1 = Taxonomy X12 code of the record in file #200
- +13 ; Piece 2 = Taxonomy IEN from file 8932.1
- TAXIND(XUIEN) ; Get taxonomy for an individual
- +1 NEW U
- SET U="^"
- +2 IF $GET(XUIEN)'>0
- QUIT U
- +3 ;I (XUIEN?.N)=0 Q U
- +4 IF ((XUIEN?.N)!(XUIEN?.N1"."1N.N))=0
- QUIT "-1^Invalid IEN"
- +5 NEW IEN,XUPTR,XUTAXARR,DIC,DR,DA,DIQ,DI,D0,XUTAX
- +6 SET IEN=0
- SET XUPTR=""
- +7 ;Q:XUPTR'=""
- FOR
- SET IEN=$ORDER(^VA(200,XUIEN,"USC1",IEN))
- IF 'IEN
- QUIT
- Begin DoDot:1
- +8 SET DIC=200
- SET DR=8932.1
- SET DA=XUIEN
- SET DR(200.05)=".01:3"
- SET DA(200.05)=IEN
- SET DIQ="XUTAXARR"
- SET DIQ(0)="I"
- +9 DO EN^DIQ1
- +10 ; Not effective yet
- IF XUTAXARR(200.05,IEN,"2","I")>DT
- QUIT
- +11 ; Expired
- IF XUTAXARR(200.05,IEN,"3","I")'=""
- IF XUTAXARR(200.05,IEN,"3","I")<DT
- QUIT
- +12 SET XUPTR=XUTAXARR(200.05,IEN,".01","I")
- End DoDot:1
- +13 SET XUTAX=$$GET1^DIQ(8932.1,XUPTR,"X12 CODE")
- +14 QUIT XUTAX_U_XUPTR
- +15 ;
- +16 ; TAXORG - Extrinsic function to retrieve the taxonomy code
- +17 ; for a given record in the INSTITUTION file (#4).
- +18 ;
- +19 ; Input
- +20 ; XUIEN - IEN of the record in file #4
- +21 ; Output
- +22 ; Piece 1 = Taxonomy X12 code of the record in file #4
- +23 ; Piece 2 = Taxonomy IEN from file 8932.1
- TAXORG(XUIEN) ; Get taxonomy for an organization
- +1 NEW U
- SET U="^"
- +2 IF $GET(XUIEN)'>0
- QUIT U
- +3 ;I (XUIEN?.N)=0 Q U
- +4 IF ((XUIEN?.N)!(XUIEN?.N1"."1N.N))=0
- QUIT "-1^Invalid IEN"
- +5 NEW IEN,XUPTR,XUTAXAR,DIC,DR,DA,DIQ,DI,D0,XUTAX
- +6 SET IEN=0
- SET XUPTR=""
- +7 FOR
- SET IEN=$ORDER(^DIC(4,XUIEN,"TAXONOMY",IEN))
- IF 'IEN
- QUIT
- Begin DoDot:1
- +8 SET DIC=4
- SET DR=43
- SET DA=XUIEN
- SET DR(4.043)=".01:.03"
- SET DA(4.043)=IEN
- SET DIQ="XUTAXARR"
- SET DIQ(0)="IE"
- +9 DO EN^DIQ1
- +10 IF XUTAXARR(4.043,IEN,".03","E")'="ACTIVE"
- QUIT
- +11 IF XUTAXARR(4.043,IEN,".02","E")="YES"
- SET XUPTR=XUTAXARR(4.043,IEN,".01","I")
- QUIT
- +12 IF XUPTR=""
- SET XUPTR=XUTAXARR(4.043,IEN,".01","I")
- End DoDot:1
- +13 SET XUTAX=$$GET1^DIQ(8932.1,XUPTR,"X12 CODE")
- +14 QUIT XUTAX_U_XUPTR
- +15 ;
- TAXINQ(XUIEN) ;Get the last taxonomy for an individual
- +1 IF +$GET(XUIEN)'=$GET(XUIEN)
- QUIT ""
- +2 NEW IEN,XUI,XUY,XUEXF
- SET IEN=0
- SET XUI=""
- SET XUEXF="-Expired"
- +3 FOR
- SET IEN=$ORDER(^VA(200,XUIEN,"USC1",IEN))
- IF 'IEN
- QUIT
- Begin DoDot:1
- +4 SET XUY=+$GET(^VA(200,XUIEN,"USC1",IEN,0))
- +5 SET XUI=$GET(^USC(8932.1,XUY,0))
- +6 SET XUI=$PIECE(XUI,"^",7)
- End DoDot:1
- +7 IF +$$GET^XUA4A72(XUIEN)=-2
- IF XUI'=""
- SET XUI=XUI_XUEXF
- +8 QUIT XUI
