XU8P410 ;OAK_BP/BDT - NATIONAL PROVIDER IDENTIFIER; 7/27/06 ;8/22/06 11:32
;;8.0;KERNEL;**410**; July 10, 1997;Build 27
;;
PRE ; run pre-routine
K ERR
Q
;
POST ; run post-routine
D SPRM,RI4,RI200
N ZTDESC,ZTDTH,ZTIO,ZTRTN
; job off task to queue cbo list (can't do it in an install)
K ^XTMP("NPIVALS")
S ZTIO="",ZTDTH=$$NOW^XLFDT(),ZTRTN="CBOQUEUE^XUSNPIED",ZTDESC="XUS NPI CBOLIST QUEUEING" D ^%ZTLOAD
Q
SPRM ; Delete a parameter
N XUSPR,XUSPCK
S XUSPCK=$O(^DIC(9.4,"B","KERNEL",0))
I 'XUSPCK Q
S XUSPCK=XUSPCK_";DIC(9.4,"
D EN^XPAR(XUSPCK,"XUSNPI QUALIFIED IDENTIFIER","Pharmacy_ID","@",.ERR)
Q
RI200 ; Re-index "NPI42" file #200
N I S I=0
F S I=$O(^VA(200,I)) Q:I'>0 D
. I $D(^VA(200,I,"NPISTATUS"))'>0 Q
. N DIK,DA S DA(1)=I,DIK="^VA(200,DA(1),""NPISTATUS"",",DIK(1)=".03^NPI42" D ENALL2^DIK
. N DIK,DA S DA(1)=I,DIK="^VA(200,DA(1),""NPISTATUS"",",DIK(1)=".03^NPI42" D ENALL^DIK
Q
RI4 ; Re-index "NPI42" file #4
N I S I=0
F S I=$O(^DIC(4,I)) Q:I'>0 D
. I $D(^DIC(4,I,"NPISTATUS"))'>0 Q
. N DIK,DA S DA(1)=I,DIK="^DIC(4,DA(1),""NPISTATUS"",",DIK(1)=".03^NPI42" D ENALL2^DIK
. N DIK,DA S DA(1)=I,DIK="^DIC(4,DA(1),""NPISTATUS"",",DIK(1)=".03^NPI42" D ENALL^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P410 1234 printed Dec 13, 2024@02:07:33 Page 2
XU8P410 ;OAK_BP/BDT - NATIONAL PROVIDER IDENTIFIER; 7/27/06 ;8/22/06 11:32
+1 ;;8.0;KERNEL;**410**; July 10, 1997;Build 27
+2 ;;
PRE ; run pre-routine
+1 KILL ERR
+2 QUIT
+3 ;
POST ; run post-routine
+1 DO SPRM
DO RI4
DO RI200
+2 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN
+3 ; job off task to queue cbo list (can't do it in an install)
+4 KILL ^XTMP("NPIVALS")
+5 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT()
SET ZTRTN="CBOQUEUE^XUSNPIED"
SET ZTDESC="XUS NPI CBOLIST QUEUEING"
DO ^%ZTLOAD
+6 QUIT
SPRM ; Delete a parameter
+1 NEW XUSPR,XUSPCK
+2 SET XUSPCK=$ORDER(^DIC(9.4,"B","KERNEL",0))
+3 IF 'XUSPCK
QUIT
+4 SET XUSPCK=XUSPCK_";DIC(9.4,"
+5 DO EN^XPAR(XUSPCK,"XUSNPI QUALIFIED IDENTIFIER","Pharmacy_ID","@",.ERR)
+6 QUIT
RI200 ; Re-index "NPI42" file #200
+1 NEW I
SET I=0
+2 FOR
SET I=$ORDER(^VA(200,I))
if I'>0
QUIT
Begin DoDot:1
+3 IF $DATA(^VA(200,I,"NPISTATUS"))'>0
QUIT
+4 NEW DIK,DA
SET DA(1)=I
SET DIK="^VA(200,DA(1),""NPISTATUS"","
SET DIK(1)=".03^NPI42"
DO ENALL2^DIK
+5 NEW DIK,DA
SET DA(1)=I
SET DIK="^VA(200,DA(1),""NPISTATUS"","
SET DIK(1)=".03^NPI42"
DO ENALL^DIK
End DoDot:1
+6 QUIT
RI4 ; Re-index "NPI42" file #4
+1 NEW I
SET I=0
+2 FOR
SET I=$ORDER(^DIC(4,I))
if I'>0
QUIT
Begin DoDot:1
+3 IF $DATA(^DIC(4,I,"NPISTATUS"))'>0
QUIT
+4 NEW DIK,DA
SET DA(1)=I
SET DIK="^DIC(4,DA(1),""NPISTATUS"","
SET DIK(1)=".03^NPI42"
DO ENALL2^DIK
+5 NEW DIK,DA
SET DA(1)=I
SET DIK="^DIC(4,DA(1),""NPISTATUS"","
SET DIK(1)=".03^NPI42"
DO ENALL^DIK
End DoDot:1
+6 QUIT
