IB20P565 ;ALB/CXW - IB*2.0*565 Post Init:Fix Visit Date/Time in CT;8-31-2016
;;2.0;INTEGRATED BILLING;**565**;21-MAR-94;Build 41
;;Per VA Directive 6402, this routine should not be modified.
Q
;
POST ; post-install of patch installation
; remove unnecessary visit date/time for INPAT in field/file (#.03/#356)
N IBA,IBCNT,IBCTIEN,IBCTY,IBVDTM,DA,DIE,DR,X,Y S U="^"
D MSG(" IB*2.0*565 Post-Install .....")
D MSG("")
D MSG(" >> Removing Existing Visit Date/Time for Inpatient Events, Please Wait...")
S IBCNT=0,IBVDTM=""
S IBCTY=$O(^IBE(356.6,"B","INPATIENT ADMISSION",0))
F S IBVDTM=$O(^IBT(356,"AVSIT",IBVDTM)) Q:IBVDTM="" D
. ; no change if visit is a pointer
. I $D(^AUPNVSIT(IBVDTM)) Q
. S IBCTIEN=0
. F S IBCTIEN=$O(^IBT(356,"AVSIT",IBVDTM,IBCTIEN)) Q:'IBCTIEN D
.. ; no change if not inpatient event
.. I IBCTY'=+$P($G(^IBT(356,IBCTIEN,0)),U,18) Q
.. S DA=IBCTIEN
.. ; override the input transform
.. S DIE="^IBT(356,",DR=".03////@" D ^DIE K DA,DIE,DR,X,Y
.. S IBCNT=IBCNT+1
D MSG(" Done. "_IBCNT_" existing inpatient claims tracking entries updated (#356)")
D MSG("")
D MSG(" IB*2.0*565 Post-Install Complete")
;
Q
MSG(IBA) ;
D MES^XPDUTL(IBA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P565 1233 printed Dec 13, 2024@02:03:46 Page 2
IB20P565 ;ALB/CXW - IB*2.0*565 Post Init:Fix Visit Date/Time in CT;8-31-2016
+1 ;;2.0;INTEGRATED BILLING;**565**;21-MAR-94;Build 41
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
POST ; post-install of patch installation
+1 ; remove unnecessary visit date/time for INPAT in field/file (#.03/#356)
+2 NEW IBA,IBCNT,IBCTIEN,IBCTY,IBVDTM,DA,DIE,DR,X,Y
SET U="^"
+3 DO MSG(" IB*2.0*565 Post-Install .....")
+4 DO MSG("")
+5 DO MSG(" >> Removing Existing Visit Date/Time for Inpatient Events, Please Wait...")
+6 SET IBCNT=0
SET IBVDTM=""
+7 SET IBCTY=$ORDER(^IBE(356.6,"B","INPATIENT ADMISSION",0))
+8 FOR
SET IBVDTM=$ORDER(^IBT(356,"AVSIT",IBVDTM))
if IBVDTM=""
QUIT
Begin DoDot:1
+9 ; no change if visit is a pointer
+10 IF $DATA(^AUPNVSIT(IBVDTM))
QUIT
+11 SET IBCTIEN=0
+12 FOR
SET IBCTIEN=$ORDER(^IBT(356,"AVSIT",IBVDTM,IBCTIEN))
if 'IBCTIEN
QUIT
Begin DoDot:2
+13 ; no change if not inpatient event
+14 IF IBCTY'=+$PIECE($GET(^IBT(356,IBCTIEN,0)),U,18)
QUIT
+15 SET DA=IBCTIEN
+16 ; override the input transform
+17 SET DIE="^IBT(356,"
SET DR=".03////@"
DO ^DIE
KILL DA,DIE,DR,X,Y
+18 SET IBCNT=IBCNT+1
End DoDot:2
End DoDot:1
+19 DO MSG(" Done. "_IBCNT_" existing inpatient claims tracking entries updated (#356)")
+20 DO MSG("")
+21 DO MSG(" IB*2.0*565 Post-Install Complete")
+22 ;
+23 QUIT
MSG(IBA) ;
+1 DO MES^XPDUTL(IBA)
+2 QUIT
