XUY687P ;EDE/TAZ - Pre-/Post Installation for Kernel Patch 687 ;
;;8.0;KERNEL;**687**;Jul 10, 1995;Build 7
;;Per VA Directive 6402, this routine should not be modified.
;
;ICR # 6864
;
POST ; POST ROUTINE(S)
N XPD,XPDIDTOT
S XPDIDTOT=3
;
; Delete the existing Cross Reference on Field 28
D DELXREF(1)
;
; Check/remove any link from an insurance to the National MBI Payer
D REINDEX(2)
; Set 'VR' and 'VRPK' fields
D SETFIELD(3)
;
; Displays the 'Done' message and finishes the progress bar
D MES^XPDUTL("")
D MES^XPDUTL("POST-Install Completed.")
Q
;
DELXREF(XPD) ; Delete traditional cross reference
N XUHIT,XUOUT,XUERR,XUXREF
D BMES^XPDUTL(" STEP "_XPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Deleting the E xRef from field 28 of file 200 ... ")
;
S (XUHIT,XUXREF)=0
F S XUXREF=$O(^DD(200,28,1,XUXREF)) Q:('+XUXREF)!(XUHIT) D
. I $P($G(^DD(200,28,1,XUXREF,0)),U,2)="E" D
.. S XUHIT=1
.. D DELIX^DDMOD(200,28,XUXREF,"K","XUOUT","XUERR")
.. ;
.. ; No error, xRef deleted
.. I '$D(XUERR) D MES^XPDUTL("The E cross reference was deleted.") Q
.. ;
.. ; Error encountered, xRef not deleted.
.. D MES^XPDUTL("ERROR encountered deleting the E cross reference.")
;
D:'XUHIT MES^XPDUTL("The E cross reference was not found.")
;
D MES^XPDUTL("STEP "_XPD_" of "_XPDIDTOT_" COMPLETE")
D UPDATE^XPDID(XPD)
Q
;
REINDEX(XPD) ; Post Install
D BMES^XPDUTL(" STEP "_XPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Re-Indexing the E xRef on field 29 of file 200 ... ")
;
N DIK
S DIK="^VA(200,"
S DIK(1)="29^E"
D ENALL^DIK
;
D MES^XPDUTL("STEP "_XPD_" of "_XPDIDTOT_" COMPLETE")
D UPDATE^XPDID(XPD)
Q
;
SETFIELD(XPD) ; Set 'VR' and 'VRPK' fields
N XUHIT,XUOUT,XUERR,XUXREF
D BMES^XPDUTL(" STEP "_XPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Setting the 'VR' and 'VRPK' fields ... ")
;
S ^DD(200,0,"VR")="8.0"
S ^DD(200,0,"VRPK")="XU"
;
D MES^XPDUTL("STEP "_XPD_" of "_XPDIDTOT_" COMPLETE")
D UPDATE^XPDID(XPD)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUY687P 2096 printed Apr 09, 2024@21:19:19 Page 2
XUY687P ;EDE/TAZ - Pre-/Post Installation for Kernel Patch 687 ;
+1 ;;8.0;KERNEL;**687**;Jul 10, 1995;Build 7
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;ICR # 6864
+5 ;
POST ; POST ROUTINE(S)
+1 NEW XPD,XPDIDTOT
+2 SET XPDIDTOT=3
+3 ;
+4 ; Delete the existing Cross Reference on Field 28
+5 DO DELXREF(1)
+6 ;
+7 ; Check/remove any link from an insurance to the National MBI Payer
+8 DO REINDEX(2)
+9 ; Set 'VR' and 'VRPK' fields
+10 DO SETFIELD(3)
+11 ;
+12 ; Displays the 'Done' message and finishes the progress bar
+13 DO MES^XPDUTL("")
+14 DO MES^XPDUTL("POST-Install Completed.")
+15 QUIT
+16 ;
DELXREF(XPD) ; Delete traditional cross reference
+1 NEW XUHIT,XUOUT,XUERR,XUXREF
+2 DO BMES^XPDUTL(" STEP "_XPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Deleting the E xRef from field 28 of file 200 ... ")
+5 ;
+6 SET (XUHIT,XUXREF)=0
+7 FOR
SET XUXREF=$ORDER(^DD(200,28,1,XUXREF))
if ('+XUXREF)!(XUHIT)
QUIT
Begin DoDot:1
+8 IF $PIECE($GET(^DD(200,28,1,XUXREF,0)),U,2)="E"
Begin DoDot:2
+9 SET XUHIT=1
+10 DO DELIX^DDMOD(200,28,XUXREF,"K","XUOUT","XUERR")
+11 ;
+12 ; No error, xRef deleted
+13 IF '$DATA(XUERR)
DO MES^XPDUTL("The E cross reference was deleted.")
QUIT
+14 ;
+15 ; Error encountered, xRef not deleted.
+16 DO MES^XPDUTL("ERROR encountered deleting the E cross reference.")
End DoDot:2
End DoDot:1
+17 ;
+18 if 'XUHIT
DO MES^XPDUTL("The E cross reference was not found.")
+19 ;
+20 DO MES^XPDUTL("STEP "_XPD_" of "_XPDIDTOT_" COMPLETE")
+21 DO UPDATE^XPDID(XPD)
+22 QUIT
+23 ;
REINDEX(XPD) ; Post Install
+1 DO BMES^XPDUTL(" STEP "_XPD_" of "_XPDIDTOT)
+2 DO MES^XPDUTL("-------------")
+3 DO MES^XPDUTL("Re-Indexing the E xRef on field 29 of file 200 ... ")
+4 ;
+5 NEW DIK
+6 SET DIK="^VA(200,"
+7 SET DIK(1)="29^E"
+8 DO ENALL^DIK
+9 ;
+10 DO MES^XPDUTL("STEP "_XPD_" of "_XPDIDTOT_" COMPLETE")
+11 DO UPDATE^XPDID(XPD)
+12 QUIT
+13 ;
SETFIELD(XPD) ; Set 'VR' and 'VRPK' fields
+1 NEW XUHIT,XUOUT,XUERR,XUXREF
+2 DO BMES^XPDUTL(" STEP "_XPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Setting the 'VR' and 'VRPK' fields ... ")
+5 ;
+6 SET ^DD(200,0,"VR")="8.0"
+7 SET ^DD(200,0,"VRPK")="XU"
+8 ;
+9 DO MES^XPDUTL("STEP "_XPD_" of "_XPDIDTOT_" COMPLETE")
+10 DO UPDATE^XPDID(XPD)
+11 QUIT
