IBY343PO ;PRXM/KJH - Post-Install for IB patch 343 ;28-JUL-2006
;;2.0;INTEGRATED BILLING;**343**;21-MAR-94;Build 16
EN ; Standard Entry Point
D RESTORE
D INDEX
D SETPARM
Q
RESTORE ; Restore data elements for a global node change that occurred between test versions 14 and 15.
; These were saved during the pre-install.
N IBPAR,IBIEN,DA,DIK
D FIELD^DID(355.93,40,"","GLOBAL SUBSCRIPT LOCATION","IBPAR")
I $P($G(IBPAR("GLOBAL SUBSCRIPT LOCATION")),";")="NPISTATUS",'$D(^TMP("IBY343",$J)) Q ; Update has already occurred.
; Restore the "NPI" nodes for each entry in file 355.93.
S IBIEN=0
F S IBIEN=$O(^TMP("IBY343",$J,IBIEN)) Q:'IBIEN D
. M ^IBA(355.93,IBIEN,"NPISTATUS")=^TMP("IBY343",$J,IBIEN,"NPI")
. Q
; Remove the temporary global.
K ^TMP("IBY343",$J)
RESTOREX ;
Q
;
INDEX ; Re-index the new "NPISTATUS" x-refs in file 355.93
N IBIEN,DA,DIK,DIC,X,Y
I $D(^IBA(355.93,"NPI42")) Q ; Update has already occurred.
S IBIEN=0
F S IBIEN=$O(^IBA(355.93,IBIEN)) Q:'IBIEN D
. S DA(1)=IBIEN,DIK="^IBA(355.93,"_DA(1)_",""NPISTATUS"",",DIK(1)=".03^NPI42^C" D ENALL^DIK
. Q
INDEXX ;
Q
;
SETPARM ; Set an entry in file 8989.5 (PARAMETERS) for XUSNPI QUALIFIED IDENTIFIER.
N XUSPCK,XUSPR
S XUSPCK=$O(^DIC(9.4,"B","KERNEL",0))
I 'XUSPCK Q
S XUSPCK=XUSPCK_";DIC(9.4,"
S XUSPR="Non_VA_Provider_ID;IBA(355.93,"
D PUT^XPAR(XUSPCK,"XUSNPI QUALIFIED IDENTIFIER",$P(XUSPR,";"),$P(XUSPR,";",2))
SETPARMX ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY343PO 1465 printed Nov 22, 2024@17:43:45 Page 2
IBY343PO ;PRXM/KJH - Post-Install for IB patch 343 ;28-JUL-2006
+1 ;;2.0;INTEGRATED BILLING;**343**;21-MAR-94;Build 16
EN ; Standard Entry Point
+1 DO RESTORE
+2 DO INDEX
+3 DO SETPARM
+4 QUIT
RESTORE ; Restore data elements for a global node change that occurred between test versions 14 and 15.
+1 ; These were saved during the pre-install.
+2 NEW IBPAR,IBIEN,DA,DIK
+3 DO FIELD^DID(355.93,40,"","GLOBAL SUBSCRIPT LOCATION","IBPAR")
+4 ; Update has already occurred.
IF $PIECE($GET(IBPAR("GLOBAL SUBSCRIPT LOCATION")),";")="NPISTATUS"
IF '$DATA(^TMP("IBY343",$JOB))
QUIT
+5 ; Restore the "NPI" nodes for each entry in file 355.93.
+6 SET IBIEN=0
+7 FOR
SET IBIEN=$ORDER(^TMP("IBY343",$JOB,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:1
+8 MERGE ^IBA(355.93,IBIEN,"NPISTATUS")=^TMP("IBY343",$JOB,IBIEN,"NPI")
+9 QUIT
End DoDot:1
+10 ; Remove the temporary global.
+11 KILL ^TMP("IBY343",$JOB)
RESTOREX ;
+1 QUIT
+2 ;
INDEX ; Re-index the new "NPISTATUS" x-refs in file 355.93
+1 NEW IBIEN,DA,DIK,DIC,X,Y
+2 ; Update has already occurred.
IF $DATA(^IBA(355.93,"NPI42"))
QUIT
+3 SET IBIEN=0
+4 FOR
SET IBIEN=$ORDER(^IBA(355.93,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:1
+5 SET DA(1)=IBIEN
SET DIK="^IBA(355.93,"_DA(1)_",""NPISTATUS"","
SET DIK(1)=".03^NPI42^C"
DO ENALL^DIK
+6 QUIT
End DoDot:1
INDEXX ;
+1 QUIT
+2 ;
SETPARM ; Set an entry in file 8989.5 (PARAMETERS) for XUSNPI QUALIFIED IDENTIFIER.
+1 NEW XUSPCK,XUSPR
+2 SET XUSPCK=$ORDER(^DIC(9.4,"B","KERNEL",0))
+3 IF 'XUSPCK
QUIT
+4 SET XUSPCK=XUSPCK_";DIC(9.4,"
+5 SET XUSPR="Non_VA_Provider_ID;IBA(355.93,"
+6 DO PUT^XPAR(XUSPCK,"XUSNPI QUALIFIED IDENTIFIER",$PIECE(XUSPR,";"),$PIECE(XUSPR,";",2))
SETPARMX ;
+1 QUIT
