XU8P410.m

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 ---XU8P410   1234     printed  Apr 09, 2024@21:05:55                                                                                                                                                                                                     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