IB20P411 ;OAK/ELZ - IB*2.0*411 POST INIT ;23-JAN-2009
;;2.0;INTEGRATED BILLING;**411**;21-MAR-94;Build 29
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;
POST ;
N IBA
S IBA(1)="",IBA(2)=" IB*2*411 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
D BCID
D CLEANAG
S IBA(1)="",IBA(2)=" IB*2*411 Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
Q
;
BCID ; loop through all BCID's and make sure they are 7 characters long
D MES^XPDUTL(" >>Cleaning up the BCID's in 399")
N BCID,IBIEN,IBC,NBCID,IBCF,X,Y,DIE,DA,DR
S BCID="",(IBCF,IBC)=0
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
. S IBC=IBC+1
. I IBC#100=0 W "."
. I $L($P(BCID,";"))=7 Q
. S NBCID=$$BCID^IBNCPDP4(+BCID,$P(BCID,";",2))
. S DIE="^DGCR(399,",DA=IBIEN,DR="460////^S X=NBCID" D ^DIE
. S IBCF=IBCF+1
D MES^XPDUTL(" - "_IBCF_" needed to be fixed")
D MES^XPDUTL(" >>Done cleaning up the BCID's in 399")
Q
;
CLEANAG ; Clean up of the "AG" node, removing part of the non-fm standard
; xref's that are not true x-refs with tasked job 2 days out
N IBT,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
D MES^XPDUTL(" - Queuing task to clean up ""AG"" x-ref in 3 days")
S ZTRTN="DQ^IB20P411",ZTDESC="Post Install IB*2*411, Clean-up of x-ref"
S (IBT,ZTDTH)=$$FMADD^XLFDT($$NOW^XLFDT,3),ZTIO=""
D ^%ZTLOAD
I $G(ZTSK) D
.D MES^XPDUTL(" - Task Queued, #"_ZTSK_" to run at "_$$FMTE^XLFDT(IBT))
E D MES^XPDUTL(" - ERROR: Task not queued!!!")
Q
;
DQ ; post-install task job
N BCID,IBIEN,IBT,XMSUB,XMZ,XMTEXT,XMY,XMDUZ
K ^TMP("IB20P411",$J)
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)=""
K ^TMP("IB20P411",$J)
;
; notify installer complete
S IBT(1)="The cleanup of the x-ref from the install of IB*2*411 has finished. The"
S IBT(2)="post install routine IB20P411 may now be optionally deleted."
S XMSUB="IB*2.0*411 installation has been completed"
S XMDUZ="INTEGRATED BILLING PACKAGE",XMTEXT="IBT(",XMY(DUZ)=""
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P411 2256 printed Dec 13, 2024@02:02:43 Page 2
IB20P411 ;OAK/ELZ - IB*2.0*411 POST INIT ;23-JAN-2009
+1 ;;2.0;INTEGRATED BILLING;**411**;21-MAR-94;Build 29
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;
POST ;
+1 NEW IBA
+2 SET IBA(1)=""
SET IBA(2)=" IB*2*411 Post-Install ....."
SET IBA(3)=""
DO MES^XPDUTL(.IBA)
KILL IBA
+3 DO BCID
+4 DO CLEANAG
+5 SET IBA(1)=""
SET IBA(2)=" IB*2*411 Post-Install Complete"
SET IBA(3)=""
DO MES^XPDUTL(.IBA)
KILL IBA
+6 QUIT
+7 ;
BCID ; loop through all BCID's and make sure they are 7 characters long
+1 DO MES^XPDUTL(" >>Cleaning up the BCID's in 399")
+2 NEW BCID,IBIEN,IBC,NBCID,IBCF,X,Y,DIE,DA,DR
+3 SET BCID=""
SET (IBCF,IBC)=0
+4 FOR
SET BCID=$ORDER(^DGCR(399,"AG",BCID))
if BCID=""
QUIT
SET IBIEN=0
FOR
SET IBIEN=$ORDER(^DGCR(399,"AG",BCID,IBIEN))
if 'IBIEN
QUIT
Begin DoDot:1
+5 SET IBC=IBC+1
+6 IF IBC#100=0
WRITE "."
+7 IF $LENGTH($PIECE(BCID,";"))=7
QUIT
+8 SET NBCID=$$BCID^IBNCPDP4(+BCID,$PIECE(BCID,";",2))
+9 SET DIE="^DGCR(399,"
SET DA=IBIEN
SET DR="460////^S X=NBCID"
DO ^DIE
+10 SET IBCF=IBCF+1
End DoDot:1
+11 DO MES^XPDUTL(" - "_IBCF_" needed to be fixed")
+12 DO MES^XPDUTL(" >>Done cleaning up the BCID's in 399")
+13 QUIT
+14 ;
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
+2 NEW IBT,ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
+3 DO MES^XPDUTL(" - Queuing task to clean up ""AG"" x-ref in 3 days")
+4 SET ZTRTN="DQ^IB20P411"
SET ZTDESC="Post Install IB*2*411, Clean-up of x-ref"
+5 SET (IBT,ZTDTH)=$$FMADD^XLFDT($$NOW^XLFDT,3)
SET ZTIO=""
+6 DO ^%ZTLOAD
+7 IF $GET(ZTSK)
Begin DoDot:1
+8 DO MES^XPDUTL(" - Task Queued, #"_ZTSK_" to run at "_$$FMTE^XLFDT(IBT))
End DoDot:1
+9 IF '$TEST
DO MES^XPDUTL(" - ERROR: Task not queued!!!")
+10 QUIT
+11 ;
DQ ; post-install task job
+1 NEW BCID,IBIEN,IBT,XMSUB,XMZ,XMTEXT,XMY,XMDUZ
+2 KILL ^TMP("IB20P411",$JOB)
+3 SET BCID=""
FOR
SET BCID=$ORDER(^DGCR(399,"AG",BCID))
if BCID=""
QUIT
MERGE ^TMP("IB20P411",$JOB,BCID)=^DGCR(399,"AG",BCID)
KILL ^DGCR(399,"AG",BCID)
SET IBIEN=0
FOR
SET IBIEN=$ORDER(^TMP("IB20P411",$JOB,BCID,IBIEN))
if 'IBIEN
QUIT
SET ^DGCR(399,"AG",BCID,IBIEN)=""
+4 KILL ^TMP("IB20P411",$JOB)
+5 ;
+6 ; notify installer complete
+7 SET IBT(1)="The cleanup of the x-ref from the install of IB*2*411 has finished. The"
+8 SET IBT(2)="post install routine IB20P411 may now be optionally deleted."
+9 SET XMSUB="IB*2.0*411 installation has been completed"
+10 SET XMDUZ="INTEGRATED BILLING PACKAGE"
SET XMTEXT="IBT("
SET XMY(DUZ)=""
+11 DO ^XMD
+12 QUIT
