FBXIP133 ;DSS/BPD - PATCH INSTALL ROUTINE;OCT 13, 2011
;;3.5;FEE BASIS;**133**;APR 04, 2011;Build 5
;;Per VHA Directive 10-93-142, this routine should not be modified.
;DBIA# Supported Reference
;----- --------------------------------
;10141 $$VERSION^XPDUTL
;10141 MES^XPDUTL
;
Q
PRE ;PATCH 133 PRE-INSTALL ROUTINE
; DELETE THE FOLLOWING FIELDS FROM THE 162 FILE SO THEY CAN BE MOVED TO A DIFFERENT SUB-FILE
; VIA INSTALLATION OF THE FILE IN THE KID BUILD
;DELETE FIELD #58 - ATTENDING PROV NAME, DELETE FIELD #59 - ATTENDING PROV NPI
;DELETE FIELD #60 - ATTENDING PROV TAXONOMY CODE, DELETE FIELD #61 - OPERATING PROV NAME
;DELETE FIELD #62 - OPERATING PROV NPI, DELETE FIELD #63 - RENDERING PROV NAME
;DELETE FIELD #64 - RENDERING PROV NPI, DELETE FIELD #65 - RENDERING PROV TAXONOMY CODE
;DELETE FIELD #66 - SERVICING PROV NAME, DELETE FIELD #67 - SERVICING PROV NPI
;DELETE FIELD #68 - REFERRING PROV NAME, DELETE FIELD #69 - REFERRING PROV NPI
;DELETE FIELD #76 - SERVICING FACILITY ADDRESS, DELETE FIELD #77 - SERVICING FACILITY CITY
;DELETE FIELD #78 - SERVICING FACILITY STATE, DELETE FIELD #79 - SERVICING FACILITY ZIP
N FLD
F FLD=58,59,60,61,62,63,64,65,66,67,68,69,76,77,78,79 D
.I $$VFILE^DSICFM06(,162.02,1)>0,$$VFIELD^DSICFM06(,162.02,FLD,1)>0 D
..N DA,DD,DO,DIK S DA(1)=162.02,DA=FLD,DIK="^DD(162.02," D ^DIK
..Q
S ^TMP("FBXIP133",$J)=$$PATCH^XPDUTL("FB*3.5*133")
Q
DATADEL ;
N FBPAT,FBVEN,FBDAT,CNT S FBPAT=0,FBVEN=0,FBDAT=0,CNT=1,FBRET=$NA(^TMP("FBXIP133",$J))
F S FBPAT=$O(^FBAAC(FBPAT)) Q:'FBPAT D
.S FBVEN=0 F S FBVEN=$O(^FBAAC(FBPAT,1,FBVEN)) Q:'FBVEN D
..S FBDAT=0 F S FBDAT=$O(^FBAAC(FBPAT,1,FBVEN,1,FBDAT)) Q:'FBDAT D
...I $D(^FBAAC(FBPAT,1,FBVEN,1,FBDAT,2)) K ^FBAAC(FBPAT,1,FBVEN,1,FBDAT,2) S @FBRET@(CNT)="KILLED ^FBAAC("_FBPAT_",1,"_FBVEN_",1,"_FBDAT_",2)",CNT=CNT+1
...I $D(^FBAAC(FBPAT,1,FBVEN,1,FBDAT,4)) K ^FBAAC(FBPAT,1,FBVEN,1,FBDAT,4) S @FBRET@(CNT)="KILLED ^FBAAC("_FBPAT_",1,"_FBVEN_",1,"_FBDAT_",4)",CNT=CNT+1
Q
POST ;
;
;Queue off visit date fix
N M S M(1)=" This part of the post-install will be queued, but may "
S M(2)=" take some time to run. It loops through the FEE BASIS PAYMENT "
S M(3)=" file and removes any data that existed in the fields being moved "
S M(4)=" to a different location within FEE BASIS PAYMENT."
S M(5)=" The fields being deleted and re-added in a new location are: "
S M(6)=" Fields: 59,60,61,62,63,64,65,66,67,68,69,76,77,78,79"
D MES^DSICXPDU(.M,1)
I ^TMP("FBXIP133",$J)=0 D TASK ; Task off repairing Visit dates
;
K ^TMP("FBXIP133",$J)
Q
TASK ; Create a queued task to perform visit date fix caused
; in P57 when undeleting transactions
N X,Y,Z,ZTSK,ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC
I '$D(XPDNM) D Q:'X
.I $G(DUZ)<.5 W !!,"Please sign on properly through the Kernel" S X=0
.E D HOME^%ZIS,DT^DICRW S X=1
.Q
S ZTIO="",ZTDTH=$H,ZTRTN="DATADEL^FBXIP133",ZTDESC="FB PATCH 133 POST-INSTALL"
D ^%ZTLOAD S X="Patch 133 post-install successfully queued, task# "_$G(ZTSK)
I $G(ZTSK) D MSG(X)
I '$G(ZTSK) D MSG("Could not queue the Post-Install!"),MSG("Enter a Remedy ticket.")
Q
MSG(X) ;
S X=" >> "_X_" <<"
D MES^DSICXPDU(X,1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFBXIP133 3223 printed Nov 22, 2024@17:11:25 Page 2
FBXIP133 ;DSS/BPD - PATCH INSTALL ROUTINE;OCT 13, 2011
+1 ;;3.5;FEE BASIS;**133**;APR 04, 2011;Build 5
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;DBIA# Supported Reference
+4 ;----- --------------------------------
+5 ;10141 $$VERSION^XPDUTL
+6 ;10141 MES^XPDUTL
+7 ;
+8 QUIT
PRE ;PATCH 133 PRE-INSTALL ROUTINE
+1 ; DELETE THE FOLLOWING FIELDS FROM THE 162 FILE SO THEY CAN BE MOVED TO A DIFFERENT SUB-FILE
+2 ; VIA INSTALLATION OF THE FILE IN THE KID BUILD
+3 ;DELETE FIELD #58 - ATTENDING PROV NAME, DELETE FIELD #59 - ATTENDING PROV NPI
+4 ;DELETE FIELD #60 - ATTENDING PROV TAXONOMY CODE, DELETE FIELD #61 - OPERATING PROV NAME
+5 ;DELETE FIELD #62 - OPERATING PROV NPI, DELETE FIELD #63 - RENDERING PROV NAME
+6 ;DELETE FIELD #64 - RENDERING PROV NPI, DELETE FIELD #65 - RENDERING PROV TAXONOMY CODE
+7 ;DELETE FIELD #66 - SERVICING PROV NAME, DELETE FIELD #67 - SERVICING PROV NPI
+8 ;DELETE FIELD #68 - REFERRING PROV NAME, DELETE FIELD #69 - REFERRING PROV NPI
+9 ;DELETE FIELD #76 - SERVICING FACILITY ADDRESS, DELETE FIELD #77 - SERVICING FACILITY CITY
+10 ;DELETE FIELD #78 - SERVICING FACILITY STATE, DELETE FIELD #79 - SERVICING FACILITY ZIP
+11 NEW FLD
+12 FOR FLD=58,59,60,61,62,63,64,65,66,67,68,69,76,77,78,79
Begin DoDot:1
+13 IF $$VFILE^DSICFM06(,162.02,1)>0
IF $$VFIELD^DSICFM06(,162.02,FLD,1)>0
Begin DoDot:2
+14 NEW DA,DD,DO,DIK
SET DA(1)=162.02
SET DA=FLD
SET DIK="^DD(162.02,"
DO ^DIK
+15 QUIT
End DoDot:2
End DoDot:1
+16 SET ^TMP("FBXIP133",$JOB)=$$PATCH^XPDUTL("FB*3.5*133")
+17 QUIT
DATADEL ;
+1 NEW FBPAT,FBVEN,FBDAT,CNT
SET FBPAT=0
SET FBVEN=0
SET FBDAT=0
SET CNT=1
SET FBRET=$NAME(^TMP("FBXIP133",$JOB))
+2 FOR
SET FBPAT=$ORDER(^FBAAC(FBPAT))
if 'FBPAT
QUIT
Begin DoDot:1
+3 SET FBVEN=0
FOR
SET FBVEN=$ORDER(^FBAAC(FBPAT,1,FBVEN))
if 'FBVEN
QUIT
Begin DoDot:2
+4 SET FBDAT=0
FOR
SET FBDAT=$ORDER(^FBAAC(FBPAT,1,FBVEN,1,FBDAT))
if 'FBDAT
QUIT
Begin DoDot:3
+5 IF $DATA(^FBAAC(FBPAT,1,FBVEN,1,FBDAT,2))
KILL ^FBAAC(FBPAT,1,FBVEN,1,FBDAT,2)
SET @FBRET@(CNT)="KILLED ^FBAAC("_FBPAT_",1,"_FBVEN_",1,"_FBDAT_",2)"
SET CNT=CNT+1
+6 IF $DATA(^FBAAC(FBPAT,1,FBVEN,1,FBDAT,4))
KILL ^FBAAC(FBPAT,1,FBVEN,1,FBDAT,4)
SET @FBRET@(CNT)="KILLED ^FBAAC("_FBPAT_",1,"_FBVEN_",1,"_FBDAT_",4)"
SET CNT=CNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+7 QUIT
POST ;
+1 ;
+2 ;Queue off visit date fix
+3 NEW M
SET M(1)=" This part of the post-install will be queued, but may "
+4 SET M(2)=" take some time to run. It loops through the FEE BASIS PAYMENT "
+5 SET M(3)=" file and removes any data that existed in the fields being moved "
+6 SET M(4)=" to a different location within FEE BASIS PAYMENT."
+7 SET M(5)=" The fields being deleted and re-added in a new location are: "
+8 SET M(6)=" Fields: 59,60,61,62,63,64,65,66,67,68,69,76,77,78,79"
+9 DO MES^DSICXPDU(.M,1)
+10 ; Task off repairing Visit dates
IF ^TMP("FBXIP133",$JOB)=0
DO TASK
+11 ;
+12 KILL ^TMP("FBXIP133",$JOB)
+13 QUIT
TASK ; Create a queued task to perform visit date fix caused
+1 ; in P57 when undeleting transactions
+2 NEW X,Y,Z,ZTSK,ZTIO,ZTRTN,ZTDTH,ZTSAVE,ZTDESC
+3 IF '$DATA(XPDNM)
Begin DoDot:1
+4 IF $GET(DUZ)<.5
WRITE !!,"Please sign on properly through the Kernel"
SET X=0
+5 IF '$TEST
DO HOME^%ZIS
DO DT^DICRW
SET X=1
+6 QUIT
End DoDot:1
if 'X
QUIT
+7 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTRTN="DATADEL^FBXIP133"
SET ZTDESC="FB PATCH 133 POST-INSTALL"
+8 DO ^%ZTLOAD
SET X="Patch 133 post-install successfully queued, task# "_$GET(ZTSK)
+9 IF $GET(ZTSK)
DO MSG(X)
+10 IF '$GET(ZTSK)
DO MSG("Could not queue the Post-Install!")
DO MSG("Enter a Remedy ticket.")
+11 QUIT
MSG(X) ;
+1 SET X=" >> "_X_" <<"
+2 DO MES^DSICXPDU(X,1)
+3 QUIT
