- 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 Feb 19, 2025@00:01:32 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