IBCNRXI1 ;BHAM ISC/DMK - Post-Installation procedure ;25-AUG-2004
;;2.0;INTEGRATED BILLING;**276**;21-MAR-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
; Description:
; This is a part of the IB*2.0*276 post-installation procedure.
; Its purpose is to review all PLAN file entries.
; If PLAN APPLICATION sub-file, LOCAL ACTIVE? = 1 (active)
; and USER EDITED LOCAL = "dummy" HL7 interface user, then
; reinitialize LOCAL ACTIVE = 0.
; Initial requirements called for initialization to 1, but this
; has changed.
;
; Applicable files, sub-files, and fields:
; 366.033 = PLAN APPLICATION sub-file
; .03 = LOCAL ACTIVE?
; .04 = USER EDITED LOCAL
; .05 = DATE/TIME LOCAL EDITED
;
1000 ; Control
;
; Call IBCNRXI2 to fix the USER EDITED LOCAL user
D EN^IBCNRXI2
;
; Compile List of plans that are being used
K ^TMP("IBCNRXI1",$J)
D COMPILE
;
; Initialization
N DATE,HL7DUZ,IEN,S
;
D INIT
I HL7DUZ="" Q
;
D GET1
K ^TMP("IBCNRXI1",$J)
Q
;
GET1 ; Get PLAN file (#366.03) IEN
S IEN(366.03)=0 F S IEN(366.03)=$O(^IBCNR(366.03,IEN(366.03))) Q:'IEN(366.03) D GET2
Q
;
GET2 ; Get PLAN APPLICATION sub-file (# 366.033) IEN
S IEN(366.033)=0 F S IEN(366.033)=$O(^IBCNR(366.03,IEN(366.03),3,IEN(366.033))) Q:'IEN(366.033) D GET3
Q
;
GET3 ; Check PLAN APPLICATION sub-file fields
S S=$G(^IBCNR(366.03,IEN(366.03),3,IEN(366.033),0))
I $P(S,U,3)=1,$P(S,U,4)=HL7DUZ,'$D(^TMP("IBCNRXI1",$J,IEN(366.03))) D FIX
Q
;
INIT ; Initialize local variables
I '$D(U) S U="^"
S HL7DUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB IIV") Q:'HL7DUZ
S DATE("NOW")=$$NOW^XLFDT()
Q
;
FIX ; Reinitialize (fix) PLAN APPLICATION sub-file fields
S $P(S,U,3)=0
S $P(S,U,5)=DATE("NOW")
S ^IBCNR(366.03,IEN(366.03),3,IEN(366.033),0)=S
Q
;
COMPILE ; Build list of plans that are in use
N IEN02,GRP,PL
S IEN02=0 F S IEN02=$O(^BPSC(IEN02)) Q:+IEN02=0 D
. S GRP=$P($G(^BPSC(IEN02,1)),"^",4)
. I GRP="" Q
. S PL=$P($G(^IBA(355.3,GRP,6)),"^",1)
. I PL="" Q
. S ^TMP("IBCNRXI1",$J,PL)=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRXI1 2111 printed Dec 13, 2024@02:16:35 Page 2
IBCNRXI1 ;BHAM ISC/DMK - Post-Installation procedure ;25-AUG-2004
+1 ;;2.0;INTEGRATED BILLING;**276**;21-MAR-94
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 ; Description:
+5 ; This is a part of the IB*2.0*276 post-installation procedure.
+6 ; Its purpose is to review all PLAN file entries.
+7 ; If PLAN APPLICATION sub-file, LOCAL ACTIVE? = 1 (active)
+8 ; and USER EDITED LOCAL = "dummy" HL7 interface user, then
+9 ; reinitialize LOCAL ACTIVE = 0.
+10 ; Initial requirements called for initialization to 1, but this
+11 ; has changed.
+12 ;
+13 ; Applicable files, sub-files, and fields:
+14 ; 366.033 = PLAN APPLICATION sub-file
+15 ; .03 = LOCAL ACTIVE?
+16 ; .04 = USER EDITED LOCAL
+17 ; .05 = DATE/TIME LOCAL EDITED
+18 ;
1000 ; Control
+1 ;
+2 ; Call IBCNRXI2 to fix the USER EDITED LOCAL user
+3 DO EN^IBCNRXI2
+4 ;
+5 ; Compile List of plans that are being used
+6 KILL ^TMP("IBCNRXI1",$JOB)
+7 DO COMPILE
+8 ;
+9 ; Initialization
+10 NEW DATE,HL7DUZ,IEN,S
+11 ;
+12 DO INIT
+13 IF HL7DUZ=""
QUIT
+14 ;
+15 DO GET1
+16 KILL ^TMP("IBCNRXI1",$JOB)
+17 QUIT
+18 ;
GET1 ; Get PLAN file (#366.03) IEN
+1 SET IEN(366.03)=0
FOR
SET IEN(366.03)=$ORDER(^IBCNR(366.03,IEN(366.03)))
if 'IEN(366.03)
QUIT
DO GET2
+2 QUIT
+3 ;
GET2 ; Get PLAN APPLICATION sub-file (# 366.033) IEN
+1 SET IEN(366.033)=0
FOR
SET IEN(366.033)=$ORDER(^IBCNR(366.03,IEN(366.03),3,IEN(366.033)))
if 'IEN(366.033)
QUIT
DO GET3
+2 QUIT
+3 ;
GET3 ; Check PLAN APPLICATION sub-file fields
+1 SET S=$GET(^IBCNR(366.03,IEN(366.03),3,IEN(366.033),0))
+2 IF $PIECE(S,U,3)=1
IF $PIECE(S,U,4)=HL7DUZ
IF '$DATA(^TMP("IBCNRXI1",$JOB,IEN(366.03)))
DO FIX
+3 QUIT
+4 ;
INIT ; Initialize local variables
+1 IF '$DATA(U)
SET U="^"
+2 SET HL7DUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB IIV")
if 'HL7DUZ
QUIT
+3 SET DATE("NOW")=$$NOW^XLFDT()
+4 QUIT
+5 ;
FIX ; Reinitialize (fix) PLAN APPLICATION sub-file fields
+1 SET $PIECE(S,U,3)=0
+2 SET $PIECE(S,U,5)=DATE("NOW")
+3 SET ^IBCNR(366.03,IEN(366.03),3,IEN(366.033),0)=S
+4 QUIT
+5 ;
COMPILE ; Build list of plans that are in use
+1 NEW IEN02,GRP,PL
+2 SET IEN02=0
FOR
SET IEN02=$ORDER(^BPSC(IEN02))
if +IEN02=0
QUIT
Begin DoDot:1
+3 SET GRP=$PIECE($GET(^BPSC(IEN02,1)),"^",4)
+4 IF GRP=""
QUIT
+5 SET PL=$PIECE($GET(^IBA(355.3,GRP,6)),"^",1)
+6 IF PL=""
QUIT
+7 SET ^TMP("IBCNRXI1",$JOB,PL)=""
End DoDot:1
+8 QUIT
