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

XBCDIC.m

Go to the documentation of this file.
  1. XBCDIC ; IHS/ADC/GTH - CLEAN UP ^DIC AND ^DD ; [ 02/07/97 3:02 PM ]
  1. ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
  1. ;
  1. ; PROGRAMMERS NOTE:
  1. ; THIS FUNCTIONALITY HAS BEEN INCLUDED IN THE FILEMAN
  1. ; DD UTILITIES, BEGINNING WITH V 19.0. WE RECOMMEND
  1. ; IT'S USE AS IT IS MORE LIKELY TO BE CURRENT.
  1. ; 3-20-96
  1. ;
  1. ; This routine cleans up ^DIC and ^DD by a range of
  1. ; dictionary numbers. All files in ^DIC within the range
  1. ; of dictionary numbers are checked for the following:
  1. ;
  1. ; They must have a NAME in ^DIC.
  1. ; The NAME in ^DIC must match the NAME in ^DD.
  1. ; The NAME must exist in ^DIC("B" with the correct number,
  1. ; and that number cannot occur more than once in ^DIC("B".
  1. ; They must have a data global specified in ^DIC.
  1. ; The data global must be in the correct form.
  1. ; The data global must exist.
  1. ; The data global must have a 0th node.
  1. ; The NAME and NUMBER in the data global must match ^DIC.
  1. ; The data globals 0th node must be consistent with
  1. ; the data (Exact count not checked).
  1. ;
  1. ; They must have valid entries in ^DD as follows:
  1. ; The ^DD entry must have a .01 field.
  1. ; All "SB" pointers must point to existing sub-files.
  1. ; All sub-files must point back to correct parent.
  1. ; All "TRB" entries must exist.
  1. ; All "PT" entries must exist.
  1. ; All "ACOMP" entries must exist.
  1. ;
  1. ; When discrepancies are found the entries are corrected
  1. ; automatically where ever possible. If this is not possible
  1. ; operator interaction occurs to make the corrections. If
  1. ; the file cannot be corrected, it will be deleted.
  1. ;
  1. ; After all dictionaries within the range of dictionary
  1. ; numbers are checked, all other entries within the range
  1. ; will be deleted.
  1. ;
  1. ; The last step is to set the 0th node of the FILE OF FILES
  1. ; to the correct high DFN and the correct count of entries.
  1. ;
  1. BEGIN ;
  1. S U="^"
  1. W !!,"THIS FUNCTIONALITY HAS BEEN INCLUDED IN THE FILEMAN"
  1. W !,"DD UTILITIES, BEGINNING WITH V 19.0. WE RECOMMEND"
  1. W !,"IT'S USE AS IT IS MORE LIKELY TO BE CURRENT."
  1. W !," 3-20-96",!!
  1. Q:'$$DIR^XBDIR("E")
  1. W !!,"This routine cleans up ^DIC and ^DD by a range of dictionary numbers."
  1. LO ;
  1. R !!,"Enter low number of range: ",XBCDLO:$G(DTIME,999)
  1. G:XBCDLO'=+XBCDLO EOJ
  1. HI ;
  1. R !,"Enter high number of range: ",XBCDHI:$G(DTIME,999)
  1. S:XBCDHI="" XBCDHI=XBCDLO
  1. G:XBCDHI'=+XBCDHI!(XBCDHI<XBCDLO) EOJ
  1. I XBCDLO<2 W !!,"*** Don't mess with files less than 2!! ***",*7 G EOJ
  1. S XBDSLO=XBCDLO,XBDSHI=XBCDHI
  1. D EN1^XBDSET
  1. I '$D(^UTILITY("XBDSET",$J)) W !!,"No dictionaries were selected!" G EOJ
  1. D ^XBCDIC2 ; Check names and data globals *****
  1. D ^XBCDICD ; Delete bad files found by ^XBCDIC2 *****
  1. S XBDSLO=XBCDLO,XBDSHI=XBCDHI
  1. D EN1^XBDSET ; Get list again *****
  1. D ^XBCDIC3 ; Check ^DD entries *****
  1. S XBRLO=XBCDLO,XBRHI=XBCDHI
  1. D EN1^XBRESID ; Check dangling ^DD entries *****
  1. W !!,"Now confirming ^DIC(""B"")"
  1. S XBCDX=""
  1. F XBCDL=0:0 S XBCDX=$O(^DIC("B",XBCDX)) Q:XBCDX="" S XBCDFILE="" F XBCDL=0:0 S XBCDFILE=$O(^DIC("B",XBCDX,XBCDFILE)) Q:XBCDFILE="" I XBCDFILE'<XBCDLO,XBCDFILE'>XBCDHI W "." D BCHK
  1. S XBCDFILE=XBCDLO-.00000001
  1. F XBCDL=0:0 S XBCDFILE=$O(^DIC(XBCDFILE)) Q:XBCDFILE'=+XBCDFILE I XBCDFILE'>XBCDHI W "." S XBCDNDIC=$P(^DIC(XBCDFILE,0),U,1) I XBCDNDIC]"",'$D(^DIC("B",XBCDNDIC,XBCDFILE)) S ^(XBCDFILE)="" W "|"
  1. G EOJ
  1. ;
  1. BCHK ;
  1. I '$D(^DIC(XBCDFILE,0))#2 KILL ^DIC("B",XBCDX,XBCDFILE) W "|" Q
  1. I XBCDX'=$P(^DIC(XBCDFILE,0),U,1) KILL ^DIC("B",XBCDX,XBCDFILE) W "|"
  1. Q
  1. EOJ ;
  1. KILL XBCDLO,XBCDHI,XBCDUCI,XBCDL,XBCDFILE,XBCDX,XBCDNDIC
  1. KILL ^UTILITY("XBDSET",$J)
  1. Q
  1. ;
  1. W !,"Package ",XBBPPRFX," has no pre-initialization routine entry!",!
  1. Q
  1. ;
  1. EOJ3 ;
  1. KILL ^UTILITY("XBBPI",$J),^UTILITY("XBBPPGM",$J),^UTILITY("XBBPI EXEC",$J)
  1. KILL %,%DT,DIE,XCN
  1. KILL XBBPDFN,XBBPFLE,XBBPFLG,XBBPI,XBBPL,XBBPP,XBBPPGM,XBBPPRFX,XBBPX,XBBPY
  1. Q
  1. ;
  1. DTA ;
  1. ;; K ^UTILITY("XBDSET",$J) F XBBPI=1:1 S XBBPIX=$P($T(Q+XBBPI),";;",2) Q:XBBPIX="" S XBBPIY=$P(XBBPIX,"=",2,99),XBBPIX=$P(XBBPIX,"=",1) S @XBBPIX=XBBPIY
  1. ;; K XBBPI,XBBPIX,XBBPIY D EN2^XBKD
  1. ;;Q Q
  1. ; ex: D to denote DUZ
  1. ; '|' Separator
  1. ;
  1. ; variable1 User's choice of the local variable
  1. ; ex: DUZ
  1. ; '*' Repetative marker if more than one
  1. ; mnemonic is indicated
  1. ;
  1. ; USE The mnemonic reference can be used any where
  1. ; in the WP form.
  1. ; Format ~mnemonic|variable subscript~
  1. ;
  1. ; '~' Beginning marker for the variable
  1. ;
  1. ; mnemonic1 User's mnemonic
  1. ;
  1. ; '|' Separator
  1. ;
  1. ; subscript The subscript of the variable to be used
  1. ;
  1. ; '~' Ending marker for the variable
  1. ;
  1. ; ex: ~D|~ for DUZ
  1. ; ~D|0~ for DUZ(0)
  1. ; ~I|.01~ for BARIPT(.01)
  1. ;
  1. ; MUMPS OUTPUT A simple mumps output transform is also
  1. ; TRANSFORM provided to aid in form design. A variable or
  1. ; mnemonic indicated will have its output
  1. ; transformed prior to being put into the form.
  1. ;
  1. ; SETUP
  1. ;
  1. ; *var1!mumps code1*var2!mumps code2
  1. ; *mnemonic3!mumps code3*mnemonic4!mumps code4
  1. ;
  1. ; Ex: *DUZ(2)!$J(X,10,2) will output $J(DUZ(2),10,2)
  1. ; *D|2!$J(X,10,2) mnemonic notation of same
  1. ;
  1. ; '*' Output Transform marker in column one. At TOF
  1. ;
  1. ; Variable/ Variable or mnemonic as it would appear in the
  1. ; Mneumonic form between '~'s.
  1. ;
  1. ; '!' Separator
  1. ;
  1. ; mumps code Mumps code expression as a function of x.
  1. ; Do not state 'S X=f(x)'
  1. ; Enter the function only, f(x).
  1. ;
  1. ; '*' Separator if more than one is put on one line.
  1. ;
  1. ; SPECIAL OUTPUT TRANSFORMS provided by XBARRAY
  1. ;
  1. ; xxx!$$MDY(X) a literal ~"NOW"~ or variable ~IT|9~
  1. ; ex: *"NOW"!$$MDY(X) or *IT|9!$$MDY(X)
  1. ; returns mm/dd/yy
  1. ;
  1. ; xxx!$$WP("X") for a word processing field
  1. ; NOTE: "X" IS ABSOLUTELY NECESSARY
  1. ; The variable array must have the form
  1. ; VAR(subcript,n) where n = 1:1
  1. ;
  1. DOCE ;
  1. ;
  1. TEST ; If you have A/R installed, uncomment the following lines for a
  1. ; demonstration.
  1. ; D INIT^BARUTL
  1. ; D ENP^XBDIQ1(200,DUZ,".01:.116","BARU(")
  1. ; S BARFORM="PW TEST"
  1. ; D EDIT^XBARRAY(.BARFORM,90053.01,1000)
  1. ; S Y=$$GEN^XBARRAY(.BARFORM,90053.01,1000,"BARFM",0,10)
  1. ; K BARFORM(BARFORM)
  1. ; Q
  1. ;
  1. NEW I,W
  1. S XBLWP=$G(XBLLINE),W=$P(X,")")
  1. F I=0:1 S X=$Q(@X) Q:X="" Q:(W'=$P(X,",")) D
  1. . S T=@X,XBLLINE=XBLWP+I
  1. . S:'$G(XBFMT) XBZ(XBL+XBLLINE)=T
  1. . S:($G(XBFMT)=1) XBZ(XBL+XBLLINE,0)=T
  1. Q ""
  1. ;