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/XUSNPIED.m@ 701

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

revised back to 6/30/08 version

File size: 5.1 KB
Line 
1XUSNPIED ;FO-OAKLAND/JLI - DATA ENTRY FOR INITIAL NPI VALUES ;11/20/06 11:20
2 ;;8.0;KERNEL;**420,410,435**;Jul 10, 1995;Build 10
3 Q
4 ;
5SIGNON ; run at user sign-on to display message if NPI value is needed.
6 D SIGNON^XUSNPIE1
7 Q
8 ;
9CLEREDIT ; Input editing of NPI value for clerical staff - ask provider
10 N IEN,DIC,PROVNAME,DATEVAL,DESCRIP,DONE,IENS,NPIVAL1,NPIVAL2,Y,XX
11 F W ! S DIC="^VA(200,",DIC(0)="AEQ" S DIC("A")="Select Provider: " D ^DIC Q:Y'>0 S IEN=+Y D EDITNPI(IEN)
12 Q
13 ;
14USEREDIT ; Entry point for provider to enter own data
15 I $$NPISTATS(DUZ)="" W !,$C(7),"Please see your local NPI facilitator to add the NPI",! H 3 Q
16 D EDITNPI(DUZ)
17 Q
18 ;
19EDITNPI(IEN) ;
20 D EDITNPI^XUSNPIE1(IEN)
21 Q
22 ;
23CLERXMPT ;
24 D CLERXMPT^XUSNPIE1
25 Q
26 ;
27CHKGLOB() ; returns global location of TAXONOMY values also rebuilds if they are missing
28 Q $$CHKGLOB^XUSNPIDA()
29 ;
30DOUSER(XUUSER,XUGLOB) ; check user for needing an NPI status value
31 N PCLASS,XUDONE,PVAL,CODE,NPISTATS,XUVALUE,D0,EXPIRATN,I,NPIFLD,NPISUBFL
32 S NPISTATS=41.98,NPISUBFL=200.042,NPIFLD=.03
33 I $$GET1^DIQ(200,XUUSER_",",NPISTATS)'="" Q ; user is already flagged
34 S PCLASS=0,XUDONE=0 F S PCLASS=$O(^VA(200,XUUSER,"USC1",PCLASS)) Q:PCLASS'>0 S D0=^(PCLASS,0) D Q:XUDONE
35 . S EXPIRATN=$P(D0,U,3)>0 I EXPIRATN Q
36 . S PVAL=$P(D0,U),CODE=$$GET1^DIQ(8932.1,PVAL_",",6) I CODE'="",$D(@XUGLOB@(CODE)) D S XUDONE=1 Q
37 . . S XUVALUE="N" N NPIVAL F I=1:1 S NPIVAL=$$GET1^DIQ(NPISUBFL,I_","_XUUSER_",",NPIFLD) Q:NPIVAL="" S XUVALUE="D" Q
38 . . N XUFDA S XUFDA(200,XUUSER_",",NPISTATS)=XUVALUE
39 . . D FILE^DIE("","XUFDA")
40 . . Q
41 . Q
42 Q
43 ;
44CBOLIST ; list ^ delimited output to CBO exchange mail group.
45 N DATE,DOMAIN,ADDRESS,STATNAME,COUNT,DOB,GLOBLOC,GLOBOUT
46 N IEN,NPI,PROVNAME,SSN,TAXDESCR,TAXONOMY,STATION,STATUS,OPTION
47 I '$$PROD^XUPROD() Q ; messages from production systems only
48 S DATE=(1700+$E(DT,1,3))_"-"_$E(DT,4,5)_"-"_$E(DT,6,7)
49 S DOMAIN=$G(^XTV(8989.3,1,0)),DOMAIN=$P(DOMAIN,U)
50 S STATION=$$NS^XUAF4($$KSP^XUPARAM("INST"))
51 S ADDRESS=$P(STATION,U) ;$$GET1^DIQ(4.2,DOMAIN_",",.01)
52 S STATION=$P(STATION,U,2) ;$$GET1^DIQ(4.2,DOMAIN_",",5.5)
53 S OPTION=3
54 S GLOBLOC=$$GETDATA(OPTION,0,0) ; get most of data into location specified by GLOBLOC
55 S COUNT=0,GLOBOUT=$NA(^TMP($J,"XUSNPIOUT")) K @GLOBOUT
56 S COUNT=1,@GLOBOUT@(COUNT)="--START"
57 S GLOBLOC=$NA(@GLOBLOC@(" "," "))
58 S PROVNAME="" F S PROVNAME=$O(@GLOBLOC@(PROVNAME)) Q:PROVNAME="" S IEN=0 F S IEN=$O(@GLOBLOC@(PROVNAME,IEN)) Q:IEN'>0 D
59 . S TAXDESCR="" F S TAXDESCR=$O(@GLOBLOC@(PROVNAME,IEN,TAXDESCR)) Q:TAXDESCR="" S TAXONOMY=$P(^(TAXDESCR),U,4),NPI=$P(^(TAXDESCR),U,3) D
60 . . S DOB=$P($G(^VA(200,IEN,1)),U,3),SSN=$E($$GET1^DIQ(200,IEN_",",9),6,9) S:DOB'="" DOB=$$DATE10(DOB) S STATUS=$$NPISTATS(IEN)
61 . . S COUNT=COUNT+1,@GLOBOUT@(COUNT)=PROVNAME_U_STATION_U_NPI_U_SSN_U_DOB_U_TAXONOMY_U_TAXDESCR_U_DATE_U_STATUS
62 . . Q
63 . Q
64 S COUNT=COUNT+1,@GLOBOUT@(COUNT)="--END"
65 ; and generate mail message
66 N XMTEXT,XMDUZ,XMY,XMSUB
67 S XMTEXT=$E(GLOBOUT,1,$L(GLOBOUT)-1)_",",XMDUZ=0.5,XMY("VHACONPINPF@VA.GOV")=""
68 S XMSUB="NPI LIST "_DATE_" FOR "_ADDRESS_" ("_STATION_")"
69 D ^XMD
70 Q
71 ;
72PRINTOPT ;
73 D PRINTOPT^XUSNPIE2
74 Q
75GETDATA(OPTION,XUSSORT,XUSDIV) ; get data for reports for providers
76 Q $$GETDATA^XUSNPIE2(OPTION,XUSSORT,XUSDIV)
77 ;
78CHEKNPI(IEN) ; returns whether status is Needs, will check and update if not set
79 N VALUE,FDA
80 S VALUE=$E($$GET1^DIQ(200,IEN_",",41.98))
81 I VALUE="N" S FDA(200,IEN_",",41.98)="" D FILE^DIE("","FDA") S VALUE="" ; XU*8*435 JLI
82 I VALUE="",$$CHKTAXON(IEN) K FDA S FDA(200,IEN_",",41.98)="N" D FILE^DIE("","FDA") S VALUE="N"
83 Q VALUE="N"
84 ;
85NEEDSNPI(IEN) ; returns whether current status is N
86 Q $$NPISTATS(IEN)="N"
87 ;
88HASNPI(IEN) ; returns whether current status is D (Done)
89 Q $$NPISTATS(IEN)="D"
90 ;
91EXMPTNPI(IEN) ; returns whether current status is E (Exempt)
92 Q $$NPISTATS(IEN)="E"
93 ;
94NPISTATS(IEN) ; returns one letter status indicator
95 N VAL
96 S VAL=$E($$GET1^DIQ(200,IEN_",",41.98))
97 I (VAL="")!(VAL="N") S VAL=$$CHEKNPI(IEN)
98 Q $E($$GET1^DIQ(200,IEN_",",41.98))
99 ;
100GETNPI(IEN) ; returns current NPI value
101 Q $$GET1^DIQ(200,IEN_",",41.99)
102 ;
103GETTAXON(IEN,DESCRREF) ; returns Taxonomy value (X12) and sets description in DESCRREF, otherwise -1
104 N I,POINTER,TAXON
105 S TAXON=-1,DESCRREF=" "
106 ;F I=0:0 S I=$O(^VA(200,IEN,"USC1",I)) Q:I'>0 I $P(^(I,0),U,3)'>0 S POINTER=+^(0) S TAXON=$$GET1^DIQ(8932.1,POINTER_",",6),DESCRREF=$$GET1^DIQ(8932.1,POINTER_",",1) Q
107 S POINTER=+$$GET^XUA4A72(IEN) I POINTER>0 S TAXON=$$GET1^DIQ(8932.1,POINTER_",",6),DESCRREF=$$GET1^DIQ(8932.1,POINTER_",",1) ; XU*8*435 make sure active on today
108 I TAXON="" S TAXON=-1,DESCRREF=" "
109 Q TAXON
110 ;
111CHKTAXON(IEN,TAXONOMY) ; checks whether taxonomy value (X12) is in list of billable otherwise 0-1
112 N DESCRIP,XUSGLOB
113 I $G(TAXONOMY)="" S TAXONOMY=$$GETTAXON(IEN,.DESCRIP)
114 S XUSGLOB=$$CHKGLOB()
115 Q $D(@XUSGLOB@(TAXONOMY))
116 ;
117DATE10(DATE) ; returns date in mm/dd/yyyyy format
118 Q $E(DATE,4,5)_"/"_$E(DATE,6,7)_"/"_(1700+$E(DATE,1,3))
119 ;
120POSTINIT ; runs post init
121 D POSTINIT^XUSNPIE1
122 Q
123 ;
124CBOQUEUE ; queues CBO List to run on first day of month
125 D CBOQUEUE^XUSNPIE1
126 Q
127ALIGNRGT(TEXT,WIDTH) ; align text right in a specified width
128 Q $$ALIGNRGT^XUSNPIE2(TEXT,WIDTH)
Note: See TracBrowser for help on using the repository browser.