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