Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XPDDCS

XPDDCS.m

Go to the documentation of this file. 
  1. XPDDCS ;SFISC/RSD - Display Checksum for a package ;05/05/2008
  1.  ;;8.0;KERNEL;**2,44,108,202,393,511,547**;Jul 10, 1995;Build 16
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1. EN1 ;Verify checksums in Transport Global
  1.  N D0,DIC,X,XPD,XPDS,XPDSHW,XPDST,XPDT,Y,Z
  1.  ;S DIC="^XPD(9.7,",DIC(0)="AEQMZ",DIC("S")="I $D(^XTMP(""XPDI"",Y))"
  1.  ;D ^DIC Q:Y<0
  1.  S XPDS="I $D(^XTMP(""XPDI"",Y))"
  1.  S XPDST=$$LOOK^XPDI1(XPDS) Q:XPDST'>0
  1.  S XPDSHW=$$ASK Q:$D(DIRUT)
  1.  S XPD("XPDT(")="",XPD("XPDST")="",XPD("XPDSHW")="",X="XUTMDEVQ"
  1.  ;during Virgin install, XUTMDEVQ might not exists
  1.  X ^%ZOSF("TEST") E  D  Q
  1.  .S IOSL=99999,IOM=80,IOF="#",IOST="",$Y=0 D LST1(9.7)
  1.  S Y="LST1^XPDDCS(9.7)",Z="Checksum Print"
  1.  ;p345-rename AND* to XPD* - Patch was Cancelled keep code for future.
  1.  I '$G(XPDAUTO) D EN^XUTMDEVQ(Y,Z,.XPD)
  1.  I $G(XPDAUTO) S IO=XPDDEV U XPDDEV D LST1^XPDDCS(9.7)
  1.  Q
  1.  ;
  1. ASK() ;Ask if want each routine listed
  1.  N DIR
  1.  I $D(XPDAUTO) Q 1
  1.  S DIR(0)="YAO",DIR("A")="Want each Routine Listed with Checksums: ",DIR("A",1)="",DIR("B")="Yes"
  1.  D ^DIR
  1.  Q Y
  1.  ;
  1. EN2 ;print from build (system)
  1.  N D0,DIC,XPD,XPDT,XPDST,Y,Z
  1.  ;S DIC="^XPD(9.6,",DIC(0)="AEQMZ"
  1.  ;D ^DIC Q:Y<0
  1.  S XPDST=$$LOOK^XPDB1() Q:XPDST'>0
  1.  S XPDSHW=$$ASK Q:$D(DIRUT)
  1.  S XPD("XPDT(")="",XPD("XPDSHW")="",Y="LST1^XPDDCS(9.6)",Z="Checksum Print"
  1.  ;p345-rename AND* to XPD*- Patch was Cancelled keep code for future.
  1.  I '$G(XPDAUTO) D EN^XUTMDEVQ(Y,Z,.XPD)
  1.  I $G(XPDAUTO) S:'$D(XPDDEV) XPDDEV=0 U XPDDEV D LST1^XPDDCS(9.6)
  1.  Q
  1.  ;
  1. LST1(FILE) ;Print group
  1.  N XPDI S XPDI=0
  1.  F  S XPDI=$O(XPDT(XPDI)) Q:XPDI'>0  S D0=+XPDT(XPDI) D PNT(FILE)
  1.  Q
  1.  ;
  1. PNT(XPDFIL) ;print
  1.  N XPD0,XPDC,XPDDT,XPDE,XPDI,XPDJ,XPDPG,XPDQ,XPDUL,XPDBCS,X
  1.  Q:'$D(^XPD(XPDFIL,D0,0))  S XPD0=^(0),XPDPG=1,$P(XPDUL,"-",IOM)="",XPDDT=$$HTE^XLFDT($H,"1PM")
  1.  W:$E(IOST,1,2)="C-" @IOF D HDR
  1.  W !
  1.  S XPDI="",(XPDQ,XPDE)=0
  1.  ;XPDFIL=9.7  use transport global exists
  1.  I XPDFIL=9.7 D
  1.  .I '$D(^XTMP("XPDI",D0)) W !!," ** Transport Global doesn't exist **" S XPDQ=1 Q
  1.  .;check for missing nodes in transport global
  1.  .I '$D(^XTMP("XPDI",D0,"BLD"))="" W !!," **Transport Global corrupted, please reload **" S XPDQ=1 Q
  1.  .F XPDC=0:1 S XPDI=$O(^XTMP("XPDI",D0,"RTN",XPDI)) Q:XPDI=""  S XPDJ=$G(^(XPDI)) D  Q:XPDQ
  1.  ..I XPDJ="" W !," **Transport Global corrupted, please reload **" S XPDQ=1 Q
  1.  ..;if deleting at site, there is no checksum
  1.  ..I +XPDJ=1 S XPDC=XPDC-1 Q
  1.  ..;if no before checksum, get from FORUM, XPDBCS(routine)=checksum, doesn't work no web service on Forum
  1.  ..;I $P(XPDJ,U,4)="" D:'$D(XPDBCS) CHKS^XPDIST($P(XPD0,U),.XPDBCS) S $P(XPDJ,U,4)=$G(XPDBCS(XPDI))
  1.  ..D SUM(XPDI,$NA(^XTMP("XPDI",D0,"RTN",XPDI)),$P(XPDJ,U,3),$P(XPDJ,U,4))
  1.  ..S XPDQ=$$CHK(4)
  1.  ;check build file
  1.  E  D
  1.  .F XPDC=0:1 S XPDI=$O(^XPD(9.6,D0,"KRN",9.8,"NM","B",XPDI)) Q:XPDI=""  S XPDJ=$O(^(XPDI,0)) D  Q:XPDQ
  1.  ..Q:'$D(^XPD(9.6,D0,"KRN",9.8,"NM",+XPDJ,0))  S XPDJ=$P(^(0),U,4)
  1.  ..;quit if no checksum, routine wasn't loaded
  1.  ..I XPDJ="" S XPDC=XPDC-1 Q
  1.  ..N DIF,XCNP,%N
  1.  ..S X=XPDI,DIF="^TMP($J,""RTN"",XPDI,",XCNP=0
  1.  ..X ^%ZOSF("TEST") E  W !,XPDI,?10,"Doesn't Exist" Q
  1.  ..X ^%ZOSF("LOAD")
  1.  ..D SUM(XPDI,$NA(^TMP($J,"RTN",XPDI)),XPDJ,"")
  1.  ..S XPDQ=$$CHK(4)
  1.  Q:XPDQ
  1.  W !!?3,XPDC," Routine"_$S(XPDC>1:"s",1:"")_" checked, ",XPDE," failed.",!
  1.  ;p345-rename AND* to XPD*-Patch was Cancelled keep code for future.
  1.  I $G(XPDAUTO) S XPDCHKSM=XPDE
  1.  Q
  1.  ;
  1.  ;XPDR=routine name, Z=global root, XPD=check sum, XPDBS=before Checksum from FORUM
  1. SUM(XPDR,Z,XPD,XPDBS) ;check checksum
  1.  N Y
  1.  ;See if we have a before checksum and compare.
  1.  I $L(XPDBS) D BEFORE(XPDR,XPDBS)
  1.  ;first char. is the sum tag used in XPDRSUM
  1.  I XPD'?1U1.N W !,XPDR,?10,"ERROR in Checksum" S XPDE=XPDE+1 Q
  1.  S @("Y=$$SUM"_$E(XPD)_"^XPDRSUM(Z)"),XPD=$E(XPD,2,255)
  1.  I Y=XPD,XPDSHW W !,XPDR,?10,"Calculated "_$J(XPD,10)
  1.  I Y'=XPD W !,XPDR,?10,"Calculated "_$C(7)_$J(Y,10)_", expected value "_XPD S XPDE=XPDE+1
  1.  Q
  1.  ;
  1. BEFORE(RN,SUM) ;Check a before Checksum
  1.  N DIF,XCNP,%N,X
  1.  I SUM'?1U1.N Q
  1.  K ^TMP($J,"XPDDCS",RN) ;patch 511
  1.  S X=RN,DIF="^TMP($J,""XPDDCS"",RN,",XCNP=0
  1.  X ^%ZOSF("TEST") E  W !,RN,?10,"Not on current system." Q
  1.  X ^%ZOSF("LOAD")
  1.  S DIF=$NA(^TMP($J,"XPDDCS",RN))
  1.  S @("Y=$$SUM"_$E(SUM)_"^XPDRSUM(DIF)"),SUM=$E(SUM,2,255)
  1.  I Y'=SUM W !,RN,?10,"Before Checksum Calculated "_Y_" expected value "_SUM
  1.  Q
  1.  ;
  1. CHK(Y) ;Y=excess lines, return 1 to exit
  1.  Q:$Y<(IOSL-Y) 0
  1.  I $E(IOST,1,2)="C-" D  Q:'Y 1
  1.  .N DIR,I,J,K,X
  1.  .S DIR(0)="E" D ^DIR
  1.  S XPDPG=XPDPG+1
  1.  W @IOF D HDR
  1.  Q 0
  1.  ;
  1. HDR W !,"PACKAGE: ",$P(XPD0,U),"     ",XPDDT,?70,"PAGE ",XPDPG,!,XPDUL,!
  1.  Q