Released XU*8*753 SEQ #594 Extracted from mail message **KIDS**:XU*8.0*753^ **INSTALL NAME** XU*8.0*753 "BLD",1712,0) XU*8.0*753^KERNEL^0^3210331^y "BLD",1712,1,0) ^^2^2^3210330^ "BLD",1712,1,1,0) Kernel patch XU*8*753-FIX API $$CHKDGT-XUSNPIE1. Please refer to "BLD",1712,1,2,0) National Patch Module for detail information. "BLD",1712,4,0) ^9.64PA^4^1 "BLD",1712,4,4,0) 4 "BLD",1712,4,4,2,0) ^9.641^4.042^1 "BLD",1712,4,4,2,4.042,0) EFFECTIVE DATE/TIME (sub-file) "BLD",1712,4,4,2,4.042,1,0) ^9.6411^.03^1 "BLD",1712,4,4,2,4.042,1,.03,0) NPI "BLD",1712,4,4,222) y^n^p^^^^n^^n "BLD",1712,4,4,224) "BLD",1712,4,"APDD",4,4.042) "BLD",1712,4,"APDD",4,4.042,.03) "BLD",1712,4,"B",4,4) "BLD",1712,6) 1 "BLD",1712,6.3) 1 "BLD",1712,"KRN",0) ^9.67PA^1.5^26 "BLD",1712,"KRN",.4,0) .4 "BLD",1712,"KRN",.401,0) .401 "BLD",1712,"KRN",.402,0) .402 "BLD",1712,"KRN",.402,"NM",0) ^9.68A^1^1 "BLD",1712,"KRN",.402,"NM",1,0) XUEDIT CHARACTERISTICS FILE #200^200^0 "BLD",1712,"KRN",.402,"NM","B","XUEDIT CHARACTERISTICS FILE #200",1) "BLD",1712,"KRN",.403,0) .403 "BLD",1712,"KRN",.403,"NM",0) ^9.68A^1^1 "BLD",1712,"KRN",.403,"NM",1,0) XUEDIT CHARACTERISTICS FILE #200^200^0 "BLD",1712,"KRN",.403,"NM","B","XUEDIT CHARACTERISTICS FILE #200",1) "BLD",1712,"KRN",.5,0) .5 "BLD",1712,"KRN",.84,0) .84 "BLD",1712,"KRN",1.5,0) 1.5 "BLD",1712,"KRN",1.6,0) 1.6 "BLD",1712,"KRN",1.61,0) 1.61 "BLD",1712,"KRN",1.62,0) 1.62 "BLD",1712,"KRN",3.6,0) 3.6 "BLD",1712,"KRN",3.8,0) 3.8 "BLD",1712,"KRN",9.2,0) 9.2 "BLD",1712,"KRN",9.8,0) 9.8 "BLD",1712,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",1712,"KRN",9.8,"NM",1,0) XUSNPIE1^^0^B15569335 "BLD",1712,"KRN",9.8,"NM","B","XUSNPIE1",1) "BLD",1712,"KRN",19,0) 19 "BLD",1712,"KRN",19.1,0) 19.1 "BLD",1712,"KRN",101,0) 101 "BLD",1712,"KRN",409.61,0) 409.61 "BLD",1712,"KRN",771,0) 771 "BLD",1712,"KRN",779.2,0) 779.2 "BLD",1712,"KRN",870,0) 870 "BLD",1712,"KRN",8989.51,0) 8989.51 "BLD",1712,"KRN",8989.52,0) 8989.52 "BLD",1712,"KRN",8993,0) 8993 "BLD",1712,"KRN",8994,0) 8994 "BLD",1712,"KRN",9002226,0) 9002226 "BLD",1712,"KRN","B",.4,.4) "BLD",1712,"KRN","B",.401,.401) "BLD",1712,"KRN","B",.402,.402) "BLD",1712,"KRN","B",.403,.403) "BLD",1712,"KRN","B",.5,.5) "BLD",1712,"KRN","B",.84,.84) "BLD",1712,"KRN","B",1.5,1.5) "BLD",1712,"KRN","B",1.6,1.6) "BLD",1712,"KRN","B",1.61,1.61) "BLD",1712,"KRN","B",1.62,1.62) "BLD",1712,"KRN","B",3.6,3.6) "BLD",1712,"KRN","B",3.8,3.8) "BLD",1712,"KRN","B",9.2,9.2) "BLD",1712,"KRN","B",9.8,9.8) "BLD",1712,"KRN","B",19,19) "BLD",1712,"KRN","B",19.1,19.1) "BLD",1712,"KRN","B",101,101) "BLD",1712,"KRN","B",409.61,409.61) "BLD",1712,"KRN","B",771,771) "BLD",1712,"KRN","B",779.2,779.2) "BLD",1712,"KRN","B",870,870) "BLD",1712,"KRN","B",8989.51,8989.51) "BLD",1712,"KRN","B",8989.52,8989.52) "BLD",1712,"KRN","B",8993,8993) "BLD",1712,"KRN","B",8994,8994) "BLD",1712,"KRN","B",9002226,9002226) "BLD",1712,"QDEF") ^^^^NO^^^^NO^^NO "BLD",1712,"QUES",0) ^9.62^^ "BLD",1712,"REQB",0) ^9.611^1^1 "BLD",1712,"REQB",1,0) XU*8.0*480^0 "BLD",1712,"REQB","B","XU*8.0*480",1) "FIA",4) INSTITUTION "FIA",4,0) ^DIC(4, "FIA",4,0,0) 4I "FIA",4,0,1) y^n^p^^^^n^^n "FIA",4,0,10) "FIA",4,0,11) "FIA",4,0,"RLRO") "FIA",4,0,"VR") 8.0^XU "FIA",4,4) 1 "FIA",4,4.042) 1 "FIA",4,4.042,.03) "IX",4,4,"NPI42",0) 4^NPI42^NPI42 X-REF^R^^F^IR^W^4.042^^^^^LS "IX",4,4,"NPI42",1) S ^DIC(4,"NPI42",$E(X,1,10),DA(1),DA)="" "IX",4,4,"NPI42",2) K ^DIC(4,"NPI42",$E(X,1,10),DA(1),DA) "IX",4,4,"NPI42",2.5) K ^DIC(4,"NPI42") "IX",4,4,"NPI42",11.1,0) ^.114IA^1^1 "IX",4,4,"NPI42",11.1,1,0) 1^F^4.042^.03^10^1^F "IX",4,4,"NPI42",11.1,1,3) "KRN",.402,9,-1) 0^1 "KRN",.402,9,0) XUEDIT CHARACTERISTICS^3210329.0952^^200^^#^3210329 "KRN",.402,9,"DR",1,200) 11.1;1;13;200.05;200.06;200.09;31.2;31.3;.131;.132;501.1;508.1; "KRN",.403,2,-1) 0^1 "KRN",.403,2,0) XUEDIT CHARACTERISTICS^^^^2901206^^^200^0^0^1 "KRN",.403,2,40,0) ^.4031I^1^1 "KRN",.403,2,40,1,0) 1^XUEDIT CHARACTERISTICS HDR^1,1^^^^^^ "KRN",.403,2,40,1,1) Page 1 of 1 "KRN",.403,2,40,1,40,0) ^.4032PI^27^1 "KRN",.403,2,40,1,40,27,0) XUEDIT CHARACTERISTICS^1^5,1^e "KRN",.404,26,0) XUEDIT CHARACTERISTICS HDR^200^0^^ "KRN",.404,26,40,0) ^.4044I^4^4 "KRN",.404,26,40,1,0) 1^EDIT USER CHARACTERISTICS^1^ "KRN",.404,26,40,1,2) ^^1,28^ "KRN",.404,26,40,2,0) 2^NAME^3^ "KRN",.404,26,40,2,1) .01 "KRN",.404,26,40,2,2) 2,7^30^2,1 "KRN",.404,26,40,3,0) 3^PAGE 1 OF 1^1^ "KRN",.404,26,40,3,2) ^^2,69^ "KRN",.404,26,40,4,0) 4^_______________________________________________________________________________^1^ "KRN",.404,26,40,4,2) ^^3,1^ "KRN",.404,27,0) XUEDIT CHARACTERISTICS^200^^^ "KRN",.404,27,15,0) 1^^1^1^2930813^^^^ "KRN",.404,27,15,1,0) Part of KERNEL. "KRN",.404,27,40,0) ^.4044I^18^16 "KRN",.404,27,40,1,0) 1^INITIAL^3 "KRN",.404,27,40,1,1) 1 "KRN",.404,27,40,1,2) 1,16^5^1,7 "KRN",.404,27,40,1,11) N T S T(1)="To Exit form and save changes, enter: E",T(2)="To Quit form without saving changes, enter: Q" D HLP^DDSUTL(.T) "KRN",.404,27,40,3,0) 2^PHONE^3 "KRN",.404,27,40,3,1) .131 "KRN",.404,27,40,3,2) 1,62^15^1,55 "KRN",.404,27,40,4,0) 4^OFFICE PHONE^3 "KRN",.404,27,40,4,1) .132 "KRN",.404,27,40,4,2) 2,62^15^2,48 "KRN",.404,27,40,5,0) 7^ASK DEVICE TYPE AT SIGN-ON^3 "KRN",.404,27,40,5,1) 200.05 "KRN",.404,27,40,5,2) 5,33^9^5,5 "KRN",.404,27,40,6,0) 8^AUTO MENU^3 "KRN",.404,27,40,6,1) 200.06 "KRN",.404,27,40,6,2) 6,33^20^6,22 "KRN",.404,27,40,7,0) 9^TYPE-AHEAD^3 "KRN",.404,27,40,7,1) 200.09 "KRN",.404,27,40,7,2) 7,33^11^7,21 "KRN",.404,27,40,8,0) 10^TEXT TERMINATOR^3 "KRN",.404,27,40,8,1) 31.2 "KRN",.404,27,40,8,2) 8,33^5^8,16 "KRN",.404,27,40,9,0) 11^PREFERRED EDITOR^3 "KRN",.404,27,40,9,1) 31.3 "KRN",.404,27,40,9,2) 9,33^30^9,15 "KRN",.404,27,40,10,0) 13^Want to edit VERIFY CODE (Y/N)^3 "KRN",.404,27,40,10,1) 11.1 "KRN",.404,27,40,10,2) 13,33^3^13,1 "KRN",.404,27,40,11,0) 5^VOICE PAGER^3 "KRN",.404,27,40,11,1) .137 "KRN",.404,27,40,11,2) 3,62^15^3,49 "KRN",.404,27,40,12,0) 6^DIGITAL PAGER^3 "KRN",.404,27,40,12,1) .138 "KRN",.404,27,40,12,2) 4,62^15^4,47 "KRN",.404,27,40,13,0) 12^NETWORK USERNAME^3 "KRN",.404,27,40,13,1) 501.1 "KRN",.404,27,40,13,2) 10,33^15^10,15 "KRN",.404,27,40,14,0) 14^TITLE^3 "KRN",.404,27,40,14,1) 8 "KRN",.404,27,40,14,2) 3,16^30^3,9 "KRN",.404,27,40,15,0) 15^ELECTRONIC SIGNATURE CODE^3 "KRN",.404,27,40,15,1) 20.4 "KRN",.404,27,40,15,2) 11,33^20^11,6 "KRN",.404,27,40,17,0) 3^NICK NAME^3 "KRN",.404,27,40,17,1) 13 "KRN",.404,27,40,17,2) 2,16^10^2,5 "KRN",.404,27,40,18,0) 16^DISABILITY USER^3 "KRN",.404,27,40,18,1) 508.1 "KRN",.404,27,40,18,2) 13,62^3^13,45 "MBREQ") 0 "ORD",7,.402) .402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%) "ORD",7,.402,0) INPUT TEMPLATE "ORD",8,.403) .403;8;;;EDEOUT^DIFROMSO(.403,DA,"",XPDA);FPRE^DIFROMSI(.403,"",XPDA);EPRE^DIFROMSI(.403,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.403,DA,"",XPDA);DEL^DIFROMSK(.403,"",%) "ORD",8,.403,0) FORM "PKG",3,-1) 1^1 "PKG",3,0) KERNEL^XU^SIGN-ON, SECURITY, MENU DRIVER, DEVICES, TASKMAN^ "PKG",3,22,0) ^9.49I^1^1 "PKG",3,22,1,0) 8.0^3090706^3090706^6 "PKG",3,22,1,"PAH",1,0) 753^3210331 "PKG",3,22,1,"PAH",1,1,0) ^^2^2^3210331 "PKG",3,22,1,"PAH",1,1,1,0) Kernel patch XU*8*753-FIX API $$CHKDGT-XUSNPIE1. Please refer to "PKG",3,22,1,"PAH",1,1,2,0) National Patch Module for detail information. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","XUSNPIE1") 0^1^B15569335^B15300096 "RTN","XUSNPIE1",1,0) XUSNPIE1 ;FO-OAKLAND/JLI - NATIONAL PROVIDER IDENTIFIER DATA CAPTURE ;3/31/2021 "RTN","XUSNPIE1",2,0) ;;8.0;KERNEL;**420,410,435,454,462,480,753**; July 10, 1995;Build 1 "RTN","XUSNPIE1",3,0) ;;Per VHA Directive 2004-038, this routine should not be modified "RTN","XUSNPIE1",4,0) Q "RTN","XUSNPIE1",5,0) ; "RTN","XUSNPIE1",6,0) SET(XUSIEN,XUSNPI) ; "RTN","XUSNPIE1",7,0) ; set value for NPI related fields (#41.97-41.99) in file #200 "RTN","XUSNPIE1",8,0) N XUSFDA,XUSIENS,X "RTN","XUSNPIE1",9,0) S X=$G(^VA(200,XUSIEN,"NPI")) "RTN","XUSNPIE1",10,0) S XUSIENS=XUSIEN_"," "RTN","XUSNPIE1",11,0) S XUSFDA(200,XUSIENS,41.99)=XUSNPI "RTN","XUSNPIE1",12,0) S XUSFDA(200,XUSIENS,41.98)="D" "RTN","XUSNPIE1",13,0) S XUSFDA(200,XUSIENS,41.97)=1 "RTN","XUSNPIE1",14,0) D FILE^DIE("","XUSFDA") "RTN","XUSNPIE1",15,0) Q "RTN","XUSNPIE1",16,0) ; "RTN","XUSNPIE1",17,0) SET1(XUSIEN,XUSNPI) ; "RTN","XUSNPIE1",18,0) ; set value for NPI field (#41.99) in file #4 "RTN","XUSNPIE1",19,0) N OLDNPI S OLDNPI=$P($G(^DIC(4,XUSIEN,"NPI")),"^") "RTN","XUSNPIE1",20,0) I OLDNPI K ^DIC(4,"ANPI",OLDNPI,XUSIEN) "RTN","XUSNPIE1",21,0) S ^DIC(4,XUSIEN,"NPI")=XUSNPI,^DIC(4,"ANPI",XUSNPI,XUSIEN)="" "RTN","XUSNPIE1",22,0) Q "RTN","XUSNPIE1",23,0) ; "RTN","XUSNPIE1",24,0) SIGNON ; .ACT - run at user sign-on display message if NEEDS AN NPI "RTN","XUSNPIE1",25,0) N XVAL,DATETIME,OPT,XVALTIME "RTN","XUSNPIE1",26,0) I $$CHEKNPI^XUSNPIED(DUZ) W !!,"To enter your NPI value enter NPI at a menu prompt to jump to the",!,"edit option.",! H 1 "RTN","XUSNPIE1",27,0) ; following to insure CBO List is scheduled to run on first day of month "RTN","XUSNPIE1",28,0) S XVALTIME=$E(DT,6,7) I '((XVALTIME="01")!(XVALTIME="15")) Q "RTN","XUSNPIE1",29,0) S XVAL=+$E($$NOW^XLFDT(),6,10) I XVAL>(XVALTIME_".19"),XVAL<(XVALTIME_".1958") D ; 7 PM TO 7:58 PM ON 1ST OF MONTH "RTN","XUSNPIE1",30,0) . S OPT=$$FIND1^DIC(19.2,"","","XUS NPI CBO LIST") I OPT'>0 L +^TMP("XUS NPI CBO LOCK"):0 Q:'$T D CBOQUEUE L -^TMP("XUS NPI CBO LOCK") Q "RTN","XUSNPIE1",31,0) . S DATETIME=$$GET1^DIQ(19.2,OPT_",",2) "RTN","XUSNPIE1",32,0) . I DATETIME'=$$FMTE^XLFDT(DT_".2") L +^DIC(19.2,OPT):0 Q:'$T D SETQUEUE(OPT,DT_".2") L -^DIC(19.2,OPT) Q "RTN","XUSNPIE1",33,0) . I '$$GET1^DIQ(19.2,OPT_",",99.1) L +^DIC(19.2,OPT):0 Q:'$T D L -^DIC(19.2,OPT) "RTN","XUSNPIE1",34,0) . . D SETQUEUE(OPT,"@") "RTN","XUSNPIE1",35,0) . . D SETQUEUE(OPT,DT_".2") "RTN","XUSNPIE1",36,0) . . Q "RTN","XUSNPIE1",37,0) . Q "RTN","XUSNPIE1",38,0) Q "RTN","XUSNPIE1",39,0) ; "RTN","XUSNPIE1",40,0) SETQUEUE(OPT,VALUE) ; "RTN","XUSNPIE1",41,0) N FDA S FDA(19.2,OPT_",",2)=VALUE D FILE^DIE("","FDA") "RTN","XUSNPIE1",42,0) Q "RTN","XUSNPIE1",43,0) ; "RTN","XUSNPIE1",44,0) POSTINIT ; "RTN","XUSNPIE1",45,0) N XUGLOB,XUUSER,XIEN,X,ZTDESC,ZTDTH,ZTIO,ZTRTN "RTN","XUSNPIE1",46,0) ;S XIEN=$$FIND1^DIC(19,"","","XUCOMMAND") I XIEN>0,$$FIND1^DIC(19.01,","_XIEN_",","","XUS NPI PROVIDER SELF ENTRY")'>0 S X=$$ADD^XPDMENU("XUCOMMAND","XUS NPI PROVIDER SELF ENTRY","NPI","") "RTN","XUSNPIE1",47,0) ;S XIEN=$$FIND1^DIC(19,"","","XU USER SIGN-ON") I XIEN>0,$$FIND1^DIC(19.01,","_XIEN_",","","XUS NPI SIGNON CHECK")'>0 S X=$$ADD^XPDMENU("XU USER SIGN-ON","XUS NPI SIGNON CHECK","","") "RTN","XUSNPIE1",48,0) ; get global containing Taxonomy values "RTN","XUSNPIE1",49,0) S XUGLOB=$$CHKGLOB^XUSNPIED() "RTN","XUSNPIE1",50,0) ; go through file 200 and ma "RTN","XUSNPIE1",51,0) S XUUSER=0 F S XUUSER=$O(^VA(200,XUUSER)) Q:XUUSER'>0 I $$ACTIVE^XUSER(XUUSER) D DOUSER^XUSNPIED(XUUSER,XUGLOB) "RTN","XUSNPIE1",52,0) ; and send CBO a starting point list "RTN","XUSNPIE1",53,0) ;S ZTIO="",ZTDTH=$$NOW^XLFDT(),ZTRTN="CBOLIST^XUSNPIED",ZTDESC="XUS NPI CBOLIST MESSAGE GENERATION" D ^%ZTLOAD "RTN","XUSNPIE1",54,0) ; set up to generate CBO list monthly "RTN","XUSNPIE1",55,0) D CBOQUEUE "RTN","XUSNPIE1",56,0) Q "RTN","XUSNPIE1",57,0) ; "RTN","XUSNPIE1",58,0) CBOQUEUE ; "RTN","XUSNPIE1",59,0) N FDA,XUSVAL "RTN","XUSNPIE1",60,0) ; check for already queued "RTN","XUSNPIE1",61,0) S XUSVAL=$$FIND1^DIC(19.2,"","","XUS NPI CBO LIST") I XUSVAL>0 D Q "RTN","XUSNPIE1",62,0) . S FDA(19.2,XUSVAL_",",2)=$$SETDATE() "RTN","XUSNPIE1",63,0) . S FDA(19.2,XUSVAL_",",6)="1M(1@2000,15@2000)" "RTN","XUSNPIE1",64,0) . N ZTQUEUED S ZTQUEUED=1 D FILE^DIE("","FDA") K ZTQUEUED "RTN","XUSNPIE1",65,0) . Q "RTN","XUSNPIE1",66,0) ; no set up queued job "RTN","XUSNPIE1",67,0) S XUSVAL=$$FIND1^DIC(19,"","","XUS NPI CBO LIST") Q:XUSVAL'>0 S FDA(19.2,"+1,",.01)=XUSVAL "RTN","XUSNPIE1",68,0) S FDA(19.2,"+1,",2)=$$SETDATE() "RTN","XUSNPIE1",69,0) S FDA(19.2,"+1,",6)="1M(1@2000,15@2000)" "RTN","XUSNPIE1",70,0) N ZTQUEUED S ZTQUEUED=1 D UPDATE^DIE("","FDA") K ZTQUEUED "RTN","XUSNPIE1",71,0) Q "RTN","XUSNPIE1",72,0) ; "RTN","XUSNPIE1",73,0) SETDATE() ; "RTN","XUSNPIE1",74,0) Q $S($E($$NOW^XLFDT(),6,10)<1.2:DT,$E($$NOW^XLFDT(),6,10)<15.2:$E(DT,1,5)_"15",$E(DT,4,5)>11:(($E(DT,1,3)+1)_"0101"),1:($E(DT,1,5)+1)_"01")_".2" "RTN","XUSNPIE1",75,0) ; "RTN","XUSNPIE1",76,0) CHKOLD1(IEN) ; "RTN","XUSNPIE1",77,0) D CHKOLD1^XUSNPIE2(IEN) "RTN","XUSNPIE1",78,0) Q "RTN","XUSNPIE1",79,0) ; "RTN","XUSNPIE1",80,0) CLERXMPT ; "RTN","XUSNPIE1",81,0) D CLERXMPT^XUSNPIE2 "RTN","XUSNPIE1",82,0) Q "RTN","XUSNPIE1",83,0) ; "RTN","XUSNPIE1",84,0) CHKDGT(XUSNPI,XUSDA,XUSQI) ; INPUT TRANSFORM "RTN","XUSNPIE1",85,0) N XUS S XUS=$$CHKDGT^XUSNPI(XUSNPI) "RTN","XUSNPIE1",86,0) I XUS'>0 Q 0 "RTN","XUSNPIE1",87,0) N XUSQIK S XUSQIK=$$QI^XUSNPI(XUSNPI) I XUSQIK=0 Q 1 "RTN","XUSNPIE1",88,0) ; Check whether NPI is already being used. If so, issue error or warning. "RTN","XUSNPIE1",89,0) N NPIUSED,XUSRSLT "RTN","XUSNPIE1",90,0) S NPIUSED=$$NPIUSED^XUSNPI1(XUSNPI,XUSQI,XUSQIK,XUSDA,.XUSRSLT,1) "RTN","XUSNPIE1",91,0) ; If an error was encountered, quit 0. "RTN","XUSNPIE1",92,0) I NPIUSED=1 Q 0 "RTN","XUSNPIE1",93,0) ; If a warning was encountered, quit 1 (Person on file 200 and 355.93 can share NPI) "RTN","XUSNPIE1",94,0) I NPIUSED=2 Q 1 "RTN","XUSNPIE1",95,0) I XUSDA=$P(XUSQIK,"^",2) Q 1 ; p753 "RTN","XUSNPIE1",96,0) ; If current provider previously had this NPI, make sure the NPI being added is the most "RTN","XUSNPIE1",97,0) ; current one in the EFFECTIVE DATE/TIME multiple (history). "RTN","XUSNPIE1",98,0) N XUSROOT S XUSROOT=$$GET^XPAR("PKG.KERNEL","XUSNPI QUALIFIED IDENTIFIER",XUSQI) "RTN","XUSNPIE1",99,0) I $E(XUSROOT)'="^" S XUSROOT="^"_XUSROOT "RTN","XUSNPIE1",100,0) N XUS1 S XUS1=XUSROOT_XUSDA_","_"""NPISTATUS"""_","_"""A"""_")" "RTN","XUSNPIE1",101,0) N XUS2 S XUS2=$O(@XUS1,-1) I XUS2'>0 Q 1 "RTN","XUSNPIE1",102,0) S XUS1=XUSROOT_XUSDA_","_"""NPISTATUS"""_","_XUS2_","_0_")" "RTN","XUSNPIE1",103,0) S XUS2=$G(@XUS1) I $P(XUS2,"^",3)=XUSNPI Q 1 "RTN","XUSNPIE1",104,0) Q 0 "UP",4,4.042,-1) 4^NPISTATUS "UP",4,4.042,0) 4.042 "VER") 8.0^22.2 "^DD",4,4.042,.03,0) NPI^RFXJ30^^0;3^K:'($$CHKDGT^XUSNPIE1(X,DA(1),"Organization_ID")) X "^DD",4,4.042,.03,1,0) ^.1 "^DD",4,4.042,.03,1,1,0) 4.042^C "^DD",4,4.042,.03,1,1,1) S ^DIC(4,DA(1),"NPISTATUS","C",$E(X,1,30),DA)="" "^DD",4,4.042,.03,1,1,2) K ^DIC(4,DA(1),"NPISTATUS","C",$E(X,1,30),DA) "^DD",4,4.042,.03,1,1,"DT") 3060321 "^DD",4,4.042,.03,1,2,0) 4.042^AC^MUMPS "^DD",4,4.042,.03,1,2,1) D SET1^XUSNPIE1(DA(1),X) "^DD",4,4.042,.03,1,2,2) Q "^DD",4,4.042,.03,1,2,3) Special Trigger "^DD",4,4.042,.03,1,2,"%D",0) ^.101^1^1^3060512^^^^ "^DD",4,4.042,.03,1,2,"%D",1,0) his Special x-ref sets the NPI field (#41.99). "^DD",4,4.042,.03,1,2,"DT") 3060512 "^DD",4,4.042,.03,3) Answer must be 10 characters in length and not being used. "^DD",4,4.042,.03,"DT") 3180712 "BLD",1712,6) ^594 **END** **END**