Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IB20P411

IB20P411.m

Go to the documentation of this file.
  1. IB20P411 ;OAK/ELZ - IB*2.0*411 POST INIT ;23-JAN-2009
  1. ;;2.0;INTEGRATED BILLING;**411**;21-MAR-94;Build 29
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;
  1. POST ;
  1. N IBA
  1. S IBA(1)="",IBA(2)=" IB*2*411 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
  1. D BCID
  1. D CLEANAG
  1. S IBA(1)="",IBA(2)=" IB*2*411 Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
  1. Q
  1. ;
  1. BCID ; loop through all BCID's and make sure they are 7 characters long
  1. D MES^XPDUTL(" >>Cleaning up the BCID's in 399")
  1. N BCID,IBIEN,IBC,NBCID,IBCF,X,Y,DIE,DA,DR
  1. S BCID="",(IBCF,IBC)=0
  1. F S BCID=$O(^DGCR(399,"AG",BCID)) Q:BCID="" S IBIEN=0 F S IBIEN=$O(^DGCR(399,"AG",BCID,IBIEN)) Q:'IBIEN D
  1. . S IBC=IBC+1
  1. . I IBC#100=0 W "."
  1. . I $L($P(BCID,";"))=7 Q
  1. . S NBCID=$$BCID^IBNCPDP4(+BCID,$P(BCID,";",2))
  1. . S DIE="^DGCR(399,",DA=IBIEN,DR="460////^S X=NBCID" D ^DIE
  1. . S IBCF=IBCF+1
  1. D MES^XPDUTL(" - "_IBCF_" needed to be fixed")
  1. D MES^XPDUTL(" >>Done cleaning up the BCID's in 399")
  1. Q
  1. ;
  1. CLEANAG ; Clean up of the "AG" node, removing part of the non-fm standard
  1. ; xref's that are not true x-refs with tasked job 2 days out
  1. N IBT,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
  1. D MES^XPDUTL(" - Queuing task to clean up ""AG"" x-ref in 3 days")
  1. S ZTRTN="DQ^IB20P411",ZTDESC="Post Install IB*2*411, Clean-up of x-ref"
  1. S (IBT,ZTDTH)=$$FMADD^XLFDT($$NOW^XLFDT,3),ZTIO=""
  1. D ^%ZTLOAD
  1. I $G(ZTSK) D
  1. .D MES^XPDUTL(" - Task Queued, #"_ZTSK_" to run at "_$$FMTE^XLFDT(IBT))
  1. E D MES^XPDUTL(" - ERROR: Task not queued!!!")
  1. Q
  1. ;
  1. DQ ; post-install task job
  1. N BCID,IBIEN,IBT,XMSUB,XMZ,XMTEXT,XMY,XMDUZ
  1. K ^TMP("IB20P411",$J)
  1. S BCID="" F S BCID=$O(^DGCR(399,"AG",BCID)) Q:BCID="" M ^TMP("IB20P411",$J,BCID)=^DGCR(399,"AG",BCID) K ^DGCR(399,"AG",BCID) S IBIEN=0 F S IBIEN=$O(^TMP("IB20P411",$J,BCID,IBIEN)) Q:'IBIEN S ^DGCR(399,"AG",BCID,IBIEN)=""
  1. K ^TMP("IB20P411",$J)
  1. ;
  1. ; notify installer complete
  1. S IBT(1)="The cleanup of the x-ref from the install of IB*2*411 has finished. The"
  1. S IBT(2)="post install routine IB20P411 may now be optionally deleted."
  1. S XMSUB="IB*2.0*411 installation has been completed"
  1. S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT(",XMY(DUZ)=""
  1. D ^XMD
  1. Q