source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUSTAX.m@ 771

Last change on this file since 771 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1XUSTAX ;PRXM/GCD, TAXONOMY CODE LOOKUP FOR INTEGRATED BILLING ;8/3/07
2 ;;8.0;KERNEL;**410,452,454,467**; July 10, 1995;Build 12
3 ;
4 ; Must call at an entry point.
5 Q
6 ;
7 ; TAXIND - Extrinsic function to retrieve the taxonomy code
8 ; for a given record in the NEW PERSON file (#200).
9 ;
10 ; Input
11 ; XUIEN - IEN of the record in file #200
12 ; Output
13 ; Piece 1 = Taxonomy X12 code of the record in file #200
14 ; Piece 2 = Taxonomy IEN from file 8932.1
15TAXIND(XUIEN) ; Get taxonomy for an individual
16 N U S U="^"
17 I $G(XUIEN)'>0 Q U
18 ;I (XUIEN?.N)=0 Q U
19 I ((XUIEN?.N)!(XUIEN?.N1"."1N.N))=0 Q "-1^Invalid IEN"
20 N IEN,XUPTR,XUTAXARR,DIC,DR,DA,DIQ,DI,D0,XUTAX
21 S IEN=0,XUPTR=""
22 F S IEN=$O(^VA(200,XUIEN,"USC1",IEN)) Q:'IEN D ;Q:XUPTR'=""
23 . S DIC=200,DR=8932.1,DA=XUIEN,DR(200.05)=".01:3",DA(200.05)=IEN,DIQ="XUTAXARR",DIQ(0)="I"
24 . D EN^DIQ1
25 . I XUTAXARR(200.05,IEN,"2","I")>DT Q ; Not effective yet
26 . I XUTAXARR(200.05,IEN,"3","I")'="",XUTAXARR(200.05,IEN,"3","I")<DT Q ; Expired
27 . S XUPTR=XUTAXARR(200.05,IEN,".01","I")
28 S XUTAX=$$GET1^DIQ(8932.1,XUPTR,"X12 CODE")
29 Q XUTAX_U_XUPTR
30 ;
31 ; TAXORG - Extrinsic function to retrieve the taxonomy code
32 ; for a given record in the INSTITUTION file (#4).
33 ;
34 ; Input
35 ; XUIEN - IEN of the record in file #4
36 ; Output
37 ; Piece 1 = Taxonomy X12 code of the record in file #4
38 ; Piece 2 = Taxonomy IEN from file 8932.1
39TAXORG(XUIEN) ; Get taxonomy for an organization
40 N U S U="^"
41 I $G(XUIEN)'>0 Q U
42 ;I (XUIEN?.N)=0 Q U
43 I ((XUIEN?.N)!(XUIEN?.N1"."1N.N))=0 Q "-1^Invalid IEN"
44 N IEN,XUPTR,XUTAXAR,DIC,DR,DA,DIQ,DI,D0,XUTAX
45 S IEN=0,XUPTR=""
46 F S IEN=$O(^DIC(4,XUIEN,"TAXONOMY",IEN)) Q:'IEN D
47 . S DIC=4,DR=43,DA=XUIEN,DR(4.043)=".01:.03",DA(4.043)=IEN,DIQ="XUTAXARR",DIQ(0)="IE"
48 . D EN^DIQ1
49 . I XUTAXARR(4.043,IEN,".03","E")'="ACTIVE" Q
50 . I XUTAXARR(4.043,IEN,".02","E")="YES" S XUPTR=XUTAXARR(4.043,IEN,".01","I") Q
51 . I XUPTR="" S XUPTR=XUTAXARR(4.043,IEN,".01","I")
52 S XUTAX=$$GET1^DIQ(8932.1,XUPTR,"X12 CODE")
53 Q XUTAX_U_XUPTR
54 ;
55TAXINQ(XUIEN) ;Get the last taxonomy for an individual
56 I +$G(XUIEN)'=$G(XUIEN) Q ""
57 N IEN,XUI,XUY,XUEXF S IEN=0,XUI="",XUEXF="-Expired"
58 F S IEN=$O(^VA(200,XUIEN,"USC1",IEN)) Q:'IEN D
59 . S XUY=+$G(^VA(200,XUIEN,"USC1",IEN,0))
60 . S XUI=$G(^USC(8932.1,XUY,0))
61 . S XUI=$P(XUI,"^",7)
62 I +$$GET^XUA4A72(XUIEN)=-2,XUI'="" S XUI=XUI_XUEXF
63 Q XUI
Note: See TracBrowser for help on using the repository browser.