IBY650PO ;EDE/JWS - POST-INSTALL FOR IB*2.0*650 ;20-JAN-2021
;;2.0;INTEGRATED BILLING;**650**;20-JAN-21;Build 21
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
EN ;Entry Point
N IBA
S IBA(2)="IB*2*650 Post-Install...",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
D FIX
S IBA(2)="IB*2*650 Post-Install Complete.",(IBA(1),IBA(3))=" " D MES^XPDUTL(.IBA) K IBA
Q
;
;
FIX ;fix orphaned 364 entries that are not in a final status
N DA,D0,DR,DIE,DIC,IB399,IB364,IBOSTAT,IBSTATUS
S IB399=0
F S IB399=$O(^IBA(364,"B",IB399)) Q:IB399="" D
. S IB364=$O(^IBA(364,"B",IB399,"A"),-1) I IB364="" Q
. I '$O(^IBA(364,"B",IB399,IB364),-1) Q
. S IBSTATUS=$P(^IBA(364,IB364,0),"^",3)
. F S IB364=$O(^IBA(364,"B",IB399,IB364),-1) Q:IB364="" D
.. S IBOSTAT=$P(^IBA(364,IB364,0),"^",3)
.. I "CREZ"[IBOSTAT Q
.. S DA=IB364 I DA="" Q
.. S DR=".03////R;.12////"_IBOSTAT
.. S DIE="^IBA(364,"
.. D ^DIE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY650PO 961 printed Dec 13, 2024@02:34:55 Page 2
IBY650PO ;EDE/JWS - POST-INSTALL FOR IB*2.0*650 ;20-JAN-2021
+1 ;;2.0;INTEGRATED BILLING;**650**;20-JAN-21;Build 21
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
EN ;Entry Point
+1 NEW IBA
+2 SET IBA(2)="IB*2*650 Post-Install..."
SET (IBA(1),IBA(3))=" "
DO MES^XPDUTL(.IBA)
KILL IBA
+3 DO FIX
+4 SET IBA(2)="IB*2*650 Post-Install Complete."
SET (IBA(1),IBA(3))=" "
DO MES^XPDUTL(.IBA)
KILL IBA
+5 QUIT
+6 ;
+7 ;
FIX ;fix orphaned 364 entries that are not in a final status
+1 NEW DA,D0,DR,DIE,DIC,IB399,IB364,IBOSTAT,IBSTATUS
+2 SET IB399=0
+3 FOR
SET IB399=$ORDER(^IBA(364,"B",IB399))
if IB399=""
QUIT
Begin DoDot:1
+4 SET IB364=$ORDER(^IBA(364,"B",IB399,"A"),-1)
IF IB364=""
QUIT
+5 IF '$ORDER(^IBA(364,"B",IB399,IB364),-1)
QUIT
+6 SET IBSTATUS=$PIECE(^IBA(364,IB364,0),"^",3)
+7 FOR
SET IB364=$ORDER(^IBA(364,"B",IB399,IB364),-1)
if IB364=""
QUIT
Begin DoDot:2
+8 SET IBOSTAT=$PIECE(^IBA(364,IB364,0),"^",3)
+9 IF "CREZ"[IBOSTAT
QUIT
+10 SET DA=IB364
IF DA=""
QUIT
+11 SET DR=".03////R;.12////"_IBOSTAT
+12 SET DIE="^IBA(364,"
+13 DO ^DIE
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
