IBY696PO ;EDE/WCJ - POST-INSTALL FOR IB*2.0*696 ;07-FEB-2021
;;2.0;INTEGRATED BILLING;**696**;21-MAR-94;Build 3
;;Per VA Directive 6402, this routine should not be modified.
;
; IA# 10141 - MES^XPDUTL
;
EN ;Entry Point
N IBA
S IBA(2)="IB*2*696 Post-Install...",(IBA(1),IBA(3))=" "
D MES^XPDUTL(.IBA) K IBA
;
N IBSITE,IBFAC
D SITE^IBAUTL
;
;If site doing the billing is not the main site
I $$STA^XUAF4(IBFAC)'=IBSITE D ZERO($$IEN^XUAF4(IBSITE)) ; fix the zero problem
;
N SITEINFO
S SITEINFO=$$SITE^VASITE ; returns pointer^name^external
;
;If IEN to file 4 is not the same as site number.
I +SITEINFO'=+$P(SITEINFO,U,3) D FIXIT(SITEINFO)
;
S IBA(2)="IB*2*696 Post-Install Complete.",(IBA(1),IBA(3))=" "
D MES^XPDUTL(.IBA) K IBA
Q
;
ZERO(IENF4) ;
; IENF4 - IEN file 4
N IBUCIEN
S IBUCIEN=0 F S IBUCIEN=$O(^IBUC(351.82,IBUCIEN)) Q:'+IBUCIEN D
. N ZNODE
. S ZNODE=$G(^IBUC(351.82,IBUCIEN,0))
. Q:$P(ZNODE,U,2)'=0 ; quit if this not the site=0 problem
. ; update site (#.02) and set the UPDATED flag and get out. Let the daily push to the rest.
. D UPDATE(IBUCIEN,".02////"_IENF4_";")
.Q
Q
;
FIXIT(SITE) ;
; SITE - IEN File 4^Site Name^Station #
N IBUCIEN
S IBUCIEN=0 F S IBUCIEN=$O(^IBUC(351.82,IBUCIEN)) Q:'+IBUCIEN D
. N ZNODE
. S ZNODE=$G(^IBUC(351.82,IBUCIEN,0))
. Q:$P(ZNODE,U,2)'=+SITE ; quit if this is not the originating site
. ; set the UPDATED flag and get out. Let the daily push to the rest.
. D UPDATE(IBUCIEN,"")
.Q
Q
;
UPDATE(IBUCIEN,INDR) ;update UPDATED field
; IBUCIEN - File 351.82 ien
; INDR - Incoming DR String
N DIE,DA,DR,D0,DIC
S DIE="^IBUC(351.82,"
S DA=IBUCIEN,DR=INDR_"1.01////1"
D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY696PO 1737 printed Dec 13, 2024@02:35:04 Page 2
IBY696PO ;EDE/WCJ - POST-INSTALL FOR IB*2.0*696 ;07-FEB-2021
+1 ;;2.0;INTEGRATED BILLING;**696**;21-MAR-94;Build 3
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; IA# 10141 - MES^XPDUTL
+5 ;
EN ;Entry Point
+1 NEW IBA
+2 SET IBA(2)="IB*2*696 Post-Install..."
SET (IBA(1),IBA(3))=" "
+3 DO MES^XPDUTL(.IBA)
KILL IBA
+4 ;
+5 NEW IBSITE,IBFAC
+6 DO SITE^IBAUTL
+7 ;
+8 ;If site doing the billing is not the main site
+9 ; fix the zero problem
IF $$STA^XUAF4(IBFAC)'=IBSITE
DO ZERO($$IEN^XUAF4(IBSITE))
+10 ;
+11 NEW SITEINFO
+12 ; returns pointer^name^external
SET SITEINFO=$$SITE^VASITE
+13 ;
+14 ;If IEN to file 4 is not the same as site number.
+15 IF +SITEINFO'=+$PIECE(SITEINFO,U,3)
DO FIXIT(SITEINFO)
+16 ;
+17 SET IBA(2)="IB*2*696 Post-Install Complete."
SET (IBA(1),IBA(3))=" "
+18 DO MES^XPDUTL(.IBA)
KILL IBA
+19 QUIT
+20 ;
ZERO(IENF4) ;
+1 ; IENF4 - IEN file 4
+2 NEW IBUCIEN
+3 SET IBUCIEN=0
FOR
SET IBUCIEN=$ORDER(^IBUC(351.82,IBUCIEN))
if '+IBUCIEN
QUIT
Begin DoDot:1
+4 NEW ZNODE
+5 SET ZNODE=$GET(^IBUC(351.82,IBUCIEN,0))
+6 ; quit if this not the site=0 problem
if $PIECE(ZNODE,U,2)'=0
QUIT
+7 ; update site (#.02) and set the UPDATED flag and get out. Let the daily push to the rest.
+8 DO UPDATE(IBUCIEN,".02////"_IENF4_";")
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
FIXIT(SITE) ;
+1 ; SITE - IEN File 4^Site Name^Station #
+2 NEW IBUCIEN
+3 SET IBUCIEN=0
FOR
SET IBUCIEN=$ORDER(^IBUC(351.82,IBUCIEN))
if '+IBUCIEN
QUIT
Begin DoDot:1
+4 NEW ZNODE
+5 SET ZNODE=$GET(^IBUC(351.82,IBUCIEN,0))
+6 ; quit if this is not the originating site
if $PIECE(ZNODE,U,2)'=+SITE
QUIT
+7 ; set the UPDATED flag and get out. Let the daily push to the rest.
+8 DO UPDATE(IBUCIEN,"")
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
UPDATE(IBUCIEN,INDR) ;update UPDATED field
+1 ; IBUCIEN - File 351.82 ien
+2 ; INDR - Incoming DR String
+3 NEW DIE,DA,DR,D0,DIC
+4 SET DIE="^IBUC(351.82,"
+5 SET DA=IBUCIEN
SET DR=INDR_"1.01////1"
+6 DO ^DIE
+7 QUIT
