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