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

YS60PRE.m

Go to the documentation of this file. 
  1. YS60PRE ; HIOFO/hrubovcak,FT - PATCH YS*5.01*60 pre-init. ;8/8/12 3:59pm
  1.  ;;5.01;MENTAL HEALTH;**60**;Dec 30, 1994;Build 47
  1.  ; pre-init  to delete Mental Health files
  1.  ;Reference to XLFDT APIs supported by DBIA #10103
  1.  ;Reference to XPDUTL APIs supported by DBIA #10141
  1.  ;Reference to LIST^DIC(19, supported by DBIA #10075
  1.  ;Reference to ^%ZOSF supported by IA #10096
  1.  ;
  1. EN ;
  1.  D ENTDEL,D60186,D60187
  1.  Q
  1.  ;
  1. ENTDEL ;file entry deletion
  1.  ;;605;MH TEXT;^YTX(
  1.  ;;627.99;DSM CONVERSION;^YSD(627.99,
  1.  ;;628;YSEXPERT;^YS(628,
  1.  ;* end of file list *
  1.  ;
  1.  D MES^XPDUTL("File entry deletion started "_$$NOW)
  1.  ; delete file entries first
  1.  K DA,DIK,DIU,X,Y,YSCNT,YSDA,YSDELDT,YSDTAFND,YSL,YSND,YSNOW,YSUB
  1.  F YSL=1:1 S X=$P($T(ENTDEL+YSL),";;",2) Q:X=""  D
  1.  .S DIK=$P(X,";",3),YSDA=0,YSCNT=0 D MES^XPDUTL("  Deleting entries for "_DIK)
  1.  .F  S YSDA=$O(@(DIK_YSDA_")")) Q:'YSDA  S DA=YSDA,YSCNT=YSCNT+1 D ^DIK
  1.  .S Y=" Deleted "_$S(YSCNT=0:"Zero",1:$FN(YSCNT,","))_" entr"_$S(YSCNT=1:"y",1:"ies")  D MES^XPDUTL(Y)
  1.  ;
  1.  ;backup and delete 1 file
  1.  ;624;JOB BANK;^YSG("JOB",
  1.  ;
  1.  ;YSDTAFND - flag, indicates data found
  1.  S YSND="YS*5.01*60",YSDTAFND=0
  1.  S YSNOW=$$NOW,YSDELDT=$$H2F^XLFDT($H+93) ; 3 months (93 days)
  1.  F YSUB="JOB" D
  1.  .Q:$O(^YSG(YSUB,0))=""  S X=$G(^(0))  ; quit if no data
  1.  .S Y=$P(X,U) D MES^XPDUTL("Saving "_Y_" data to ^XTMP("_YSND_")")
  1.  .M ^XTMP(YSND,YSNOW,YSUB)=^YSG(YSUB)  ; YSNOW allows multiple runs of pre-init
  1.  .; cleanup data, leave file's zero node
  1.  .S YSDTAFND=YSDTAFND+1,X=0 F  S X=$O(^YSG(YSUB,X)) Q:X=""  K ^YSG(YSUB,X)
  1.  .D MES^XPDUTL("Entries in "_Y_" deleted.")
  1.  ;
  1.  ; if data found set zero node
  1.  S:YSDTAFND ^XTMP(YSND,0)=YSDELDT_U_YSNOW_U_"Backup for "_YSND_" installation"
  1.  ;
  1.  D MES^XPDUTL("File entry deletion finished "_$$NOW)
  1.  ;
  1.  K DA,DIK,DIU,X,Y,YSCNT,YSDA,YSDELDT,YSDTAFND,YSL,YSND,YSNOW,YSUB
  1.  Q
  1.  ;
  1.  ; now, external format
  1. NOW() Q $$FMTE^XLFDT($$NOW^XLFDT)
  1.  ;
  1. CHKSUM(RTN) ; function, return routine Checksum
  1.  N %,%1,%2,%3,X,Y S X=$G(RTN) Q:X="" "*"
  1.  X ^%ZOSF("RSUM1") Q Y
  1.  ;
  1. D60186 ;Delete entries where SCALEGROUPNAME="RPCBroker1" in MH SCALEGROUPS file (601.86)
  1.  N DA,DIK,X,YSC,YSIEN
  1.  S YSC=0  ; counter
  1.  F YSIEN=127:1:131 D
  1.  .Q:$P($G(^YTT(601.86,YSIEN,0)),U,3)'="RPCBroker1"  ;wrong entry
  1.  .S DA=YSIEN,DIK="^YTT(601.86,"
  1.  .D ^DIK S YSC=YSC+1
  1.  ;
  1.  S X="Deleted "_$S(YSC:YSC,1:"zero")_" entr"_$S('(YSC=1):"ies",1:"y")_" in MH SCALEGROUPS File (#601.86)"
  1.  D MES^XPDUTL(X)
  1.  Q
  1. D60187 ;Delete entries where SCALE NAME="R1 Scale" in MH SCALES file (601.87)
  1.  N DA,DIK,X,YSC,YSIEN
  1.  S YSC=0  ; counter
  1.  F YSIEN=497,498 D
  1.  .Q:$P($G(^YTT(601.87,YSIEN,0)),U,4)'="R1 Scale"  ;wrong entry
  1.  .S DA=YSIEN,DIK="^YTT(601.87,"
  1.  .D ^DIK S YSC=YSC+1
  1.  ;
  1.  S X="Deleted "_$S(YSC:YSC,1:"zero")_" entr"_$S('(YSC=1):"ies",1:"y")_" in MH SCALES File (#601.87)"
  1.  D MES^XPDUTL(X)
  1.  Q
  1.  ;