- 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 Feb 18, 2025@23:29:06 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