XU8P420 ;OAK_BP/BDT,JLI - NATIONAL PROVIDER IDENTIFIER 3/7/06 ;7/17/06 15:38
;;8.0;KERNEL;**420**; July 10, 1995;Build 20
;;
PRE ; run pre-routine
Q
;
POST ; run post-routine
D SLAYGO
D SETOPT
D SPRM
D POSTINIT^XUSNPIED ; jli
N I
F I=0:0 S I=$O(^USC(8932.1,I)) Q:I'>0 I $$GET1^DIQ(8932.1,I_",",90002)="" D
. N FDA S FDA(8932.1,I_",",90002)="I" D FILE^DIE("","FDA")
. Q
Q
SLAYGO ;
; Set un-editable for STATUS field (#.02) in EFFECTIVE DATE/TIME subfile (#200.042)
I $P(^DD(200.042,.02,0),"^",2)'["I" D
. S $P(^DD(200.042,.02,0),"^",2)=$P(^DD(200.042,.02,0),"^",2)_"I"
; Set un-editable for STATUS field (#.02) in EFFECTIVE DATE/TIEM subfile (#4.042)
I $P(^DD(4.042,.02,0),"^",2)'["I" D
. S $P(^DD(4.042,.02,0),"^",2)=$P(^DD(4.042,.02,0),"^",2)_"I"
; Set DEL-LAYGO for NPI field (#41.99) in INSTITUTION file (#4)
S ^DD(4,41.99,"DEL",11,0)="D:'$D(XUMF) EN^DDIOL(""Entries must be inactivated via the Master File Server(MFS)."","""",""!?5,$C(7)"") I $D(XUMF)"
Q
;
SETOPT ;put options under XUCOMMAND and XU USER SIGN-ON menu
Q
;
SPRM ; Add new Kernel parameters on file
N XUSPR,XUSPCK
S XUSPCK=$O(^DIC(9.4,"B","KERNEL",0))
I 'XUSPCK Q
S XUSPCK=XUSPCK_";DIC(9.4,"
F XUSPR="Individual_ID;VA(200,","Organization_ID;DIC(4,","Pharmacy_ID;PS(59," D
. D PUT^XPAR(XUSPCK,"XUSNPI QUALIFIED IDENTIFIER",$P(XUSPR,";"),$P(XUSPR,";",2))
; delete Provider_ID if it is present
D DEL^XPAR(XUSPCK,"XUSNPI QUALIFIED IDENTIFIER","Provider_ID")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P420 1500 printed Nov 22, 2024@17:17:44 Page 2
XU8P420 ;OAK_BP/BDT,JLI - NATIONAL PROVIDER IDENTIFIER 3/7/06 ;7/17/06 15:38
+1 ;;8.0;KERNEL;**420**; July 10, 1995;Build 20
+2 ;;
PRE ; run pre-routine
+1 QUIT
+2 ;
POST ; run post-routine
+1 DO SLAYGO
+2 DO SETOPT
+3 DO SPRM
+4 ; jli
DO POSTINIT^XUSNPIED
+5 NEW I
+6 FOR I=0:0
SET I=$ORDER(^USC(8932.1,I))
if I'>0
QUIT
IF $$GET1^DIQ(8932.1,I_",",90002)=""
Begin DoDot:1
+7 NEW FDA
SET FDA(8932.1,I_",",90002)="I"
DO FILE^DIE("","FDA")
+8 QUIT
End DoDot:1
+9 QUIT
SLAYGO ;
+1 ; Set un-editable for STATUS field (#.02) in EFFECTIVE DATE/TIME subfile (#200.042)
+2 IF $PIECE(^DD(200.042,.02,0),"^",2)'["I"
Begin DoDot:1
+3 SET $PIECE(^DD(200.042,.02,0),"^",2)=$PIECE(^DD(200.042,.02,0),"^",2)_"I"
End DoDot:1
+4 ; Set un-editable for STATUS field (#.02) in EFFECTIVE DATE/TIEM subfile (#4.042)
+5 IF $PIECE(^DD(4.042,.02,0),"^",2)'["I"
Begin DoDot:1
+6 SET $PIECE(^DD(4.042,.02,0),"^",2)=$PIECE(^DD(4.042,.02,0),"^",2)_"I"
End DoDot:1
+7 ; Set DEL-LAYGO for NPI field (#41.99) in INSTITUTION file (#4)
+8 SET ^DD(4,41.99,"DEL",11,0)="D:'$D(XUMF) EN^DDIOL(""Entries must be inactivated via the Master File Server(MFS)."","""",""!?5,$C(7)"") I $D(XUMF)"
+9 QUIT
+10 ;
SETOPT ;put options under XUCOMMAND and XU USER SIGN-ON menu
+1 QUIT
+2 ;
SPRM ; Add new Kernel parameters on file
+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 FOR XUSPR="Individual_ID;VA(200,","Organization_ID;DIC(4,","Pharmacy_ID;PS(59,"
Begin DoDot:1
+6 DO PUT^XPAR(XUSPCK,"XUSNPI QUALIFIED IDENTIFIER",$PIECE(XUSPR,";"),$PIECE(XUSPR,";",2))
End DoDot:1
+7 ; delete Provider_ID if it is present
+8 DO DEL^XPAR(XUSPCK,"XUSNPI QUALIFIED IDENTIFIER","Provider_ID")
+9 QUIT
