BLRBBDDC ; IHS/OIT/MKK - BLOOD BANK DATA DICTIONARY CORRECTION(S) [12/07/05 1:43 PM]
;;5.2;LR;**1022**;September 20, 2007
;;
EEP ;
D EEP^BLRGMENU
Q
;
PEP ;
; Check all of DD files for instances of $$SITE^VASITE
; and correct, if possible. This mainly appears to be
; an issue with the Blood Bank dictionaries.
D ^XBCLS
D BLRHEADR("BLOOD BANK DATA DICTIONARY INPUT TRANSFORM","MODIFY $$SITE^VASITE to $P($$SITE^VASITE,U,3)",$TR($J("",80)," ","-"))
NEW CNT,CNTREC,TAB,DICN,FUZZY
NEW D0,D1,D2,D3
S (CNT,CNTREC)=0,FUZZY="|"
S (D0,D1,D2,D3)=""
F S D0=$O(^DD(D0)) Q:D0="" D
. S DICN=$P(D0,".",1)
. S CNTREC=CNTREC+1
. ;
. F S D1=$O(^DD(D0,D1)) Q:D1="" D
.. D WARMFZZY
.. I $G(^DD(D0,D1))["$$SITE^VASITE" D
... I $G(^DD(D0,D1))["$P($$SITE^VASITE,U,3)" Q ; Valid
... D FIXIT(D0,D1)
.. ;
.. F S D2=$O(^DD(D0,D1,D2)) Q:D2="" D
... D WARMFZZY
... I $G(^DD(D0,D1,D2))["$$SITE" D
.... I $G(^DD(D0,D1,D2))["$P($$SITE^VASITE,U,3)" Q ; Valid
.... D FIXIT(D0,D1,D2)
... ;
... F S D3=$O(^DD(D0,D1,D2,D3)) Q:D3="" D
.... D WARMFZZY
.... I $G(^DD(D0,D1,D2,D3))["$$SITE" D
..... I $G(^DD(D0,D1,D2,D3))["$P($$SITE^VASITE,U,3)" Q ; Valid
..... D FIXIT(D0,D1,D2,D3)
;
W !!,"Done.",!!
;
I CNT>0 D
. W "Number of records corrected:",CNT,!!
;
I CNT<1 D
. W "Number of records searched:",CNTREC,!!
. W ?10,"No corrections necessary.",!!
Q
;
WARMFZZY ;
I CNTREC#500'=0 Q
W "."
I $X>70 W !
Q
;
; At this point, there is a $$SITE^VASITE call that does
; not have the $P($$SITE^VASITE,U,3) correction. This means
; that no matter what is using that call, it is incorrect,
; be it a Blood Bank dictionary or not.
FIXIT(D0,D1,D2,D3) ;
NEW STR,SUBSTR
NEW SPEC
S SPEC("$$SITE^VASITE")="$P($$SITE^VASITE,U,3)"
;
; Write out the offending line
S CNT=CNT+1
W $J(CNT,3)
W ?5,"D0:",D0
W ?15,"D1:",D1
W:$G(D2)'="" ?25,"D2:",D2
W:$G(D3)'="" ?35,"D3:",D3
W !
I $G(D3)'="" W ?5,$E($G(^DD(D0,D1,D2,D3)),1,73),!
I $G(D2)'=""&($G(D3)="") W ?5,$E($G(^DD(D0,D1,D2)),1,73),!
I $G(D2)=""&($G(D3)="") W ?5,$E($G(^DD(D0,D1)),1,73),!
;
; Now, try to fix.
I $G(D3)'="" D Q
. S STR=$G(^DD(D0,D1,D2,D3))
. S STR=$$REPLACE^XLFSTR(STR,.SPEC)
. S SUBSTR="^DD(D0,D1,D2,D3)"
. S @SUBSTR=STR
. W ?5,$E(STR,1,73),!!
;
I $G(D2)'="" D Q
. S STR=$G(^DD(D0,D1,D2))
. S STR=$$REPLACE^XLFSTR(STR,.SPEC)
. S SUBSTR="^DD(D0,D1,D2)"
. S @SUBSTR=STR
. W ?5,$E(STR,1,73),!!
;
S STR=$G(^DD(D0,D1))
S STR=$$REPLACE^XLFSTR(STR,.SPEC)
S SUBSTR="^DD(D0,D1)"
S @SUBSTR=STR
W ?5,$E(STR,1,73),!!
;
Q
;
BLRHEADR(LINE1,LINE2,LINE3) ; HEADER subroutine
NEW TMPLN
W $$CJ^XLFSTR($$LOC^XBFUNC,IOM) ; Location
;
S TMPLN=$$CJ^XLFSTR(LINE1,IOM)
S $E(TMPLN,1,13)="Date:"_$$HTE^XLFDT($H,"2DZ") ; Today's Date
S $E(TMPLN,IOM-15)=$J("Time:"_$$NOWTIME,16) ; Current Time
S TMPLN=$$TRIM^XLFSTR(TMPLN,"R"," ") ; Trim extra spaces
W TMPLN,!
;
I $G(LINE2)="" Q
;
W $$CJ^XLFSTR(LINE2,IOM),!
;
I $G(LINE3)="" Q
;
W $$CJ^XLFSTR(LINE3,IOM),!
;
Q
;
NOWTIME() ; EP - return NOW TIME in xx:xx AM/PM format
NEW X
S X=$$HTE^XLFDT($H,"2MPZ") ; MM/DD/YY HH:MM am/pm format
S X=$P(X," ",2,3) ; Get HH:MM am/pm
S X=$$UP^XLFSTR(X) ; Uppercase am/pm to AM/PM
Q X
BLRBBDDC ; IHS/OIT/MKK - BLOOD BANK DATA DICTIONARY CORRECTION(S) [12/07/05 1:43 PM]
+1 ;;5.2;LR;**1022**;September 20, 2007
+2 ;;
EEP ;
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
PEP ;
+1 ; Check all of DD files for instances of $$SITE^VASITE
+2 ; and correct, if possible. This mainly appears to be
+3 ; an issue with the Blood Bank dictionaries.
+4 DO ^XBCLS
+5 DO BLRHEADR("BLOOD BANK DATA DICTIONARY INPUT TRANSFORM","MODIFY $$SITE^VASITE to $P($$SITE^VASITE,U,3)",$TRANSLATE($JUSTIFY("",80)," ","-"))
+6 NEW CNT,CNTREC,TAB,DICN,FUZZY
+7 NEW D0,D1,D2,D3
+8 SET (CNT,CNTREC)=0
SET FUZZY="|"
+9 SET (D0,D1,D2,D3)=""
+10 FOR
SET D0=$ORDER(^DD(D0))
IF D0=""
QUIT
Begin DoDot:1
+11 SET DICN=$PIECE(D0,".",1)
+12 SET CNTREC=CNTREC+1
+13 ;
+14 FOR
SET D1=$ORDER(^DD(D0,D1))
IF D1=""
QUIT
Begin DoDot:2
+15 DO WARMFZZY
+16 IF $GET(^DD(D0,D1))["$$SITE^VASITE"
Begin DoDot:3
+17 ; Valid
IF $GET(^DD(D0,D1))["$P($$SITE^VASITE,U,3)"
QUIT
+18 DO FIXIT(D0,D1)
End DoDot:3
+19 ;
+20 FOR
SET D2=$ORDER(^DD(D0,D1,D2))
IF D2=""
QUIT
Begin DoDot:3
+21 DO WARMFZZY
+22 IF $GET(^DD(D0,D1,D2))["$$SITE"
Begin DoDot:4
+23 ; Valid
IF $GET(^DD(D0,D1,D2))["$P($$SITE^VASITE,U,3)"
QUIT
+24 DO FIXIT(D0,D1,D2)
End DoDot:4
+25 ;
+26 FOR
SET D3=$ORDER(^DD(D0,D1,D2,D3))
IF D3=""
QUIT
Begin DoDot:4
+27 DO WARMFZZY
+28 IF $GET(^DD(D0,D1,D2,D3))["$$SITE"
Begin DoDot:5
+29 ; Valid
IF $GET(^DD(D0,D1,D2,D3))["$P($$SITE^VASITE,U,3)"
QUIT
+30 DO FIXIT(D0,D1,D2,D3)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+31 ;
+32 WRITE !!,"Done.",!!
+33 ;
+34 IF CNT>0
Begin DoDot:1
+35 WRITE "Number of records corrected:",CNT,!!
End DoDot:1
+36 ;
+37 IF CNT<1
Begin DoDot:1
+38 WRITE "Number of records searched:",CNTREC,!!
+39 WRITE ?10,"No corrections necessary.",!!
End DoDot:1
+40 QUIT
+41 ;
WARMFZZY ;
+1 IF CNTREC#500'=0
QUIT
+2 WRITE "."
+3 IF $X>70
WRITE !
+4 QUIT
+5 ;
+6 ; At this point, there is a $$SITE^VASITE call that does
+7 ; not have the $P($$SITE^VASITE,U,3) correction. This means
+8 ; that no matter what is using that call, it is incorrect,
+9 ; be it a Blood Bank dictionary or not.
FIXIT(D0,D1,D2,D3) ;
+1 NEW STR,SUBSTR
+2 NEW SPEC
+3 SET SPEC("$$SITE^VASITE")="$P($$SITE^VASITE,U,3)"
+4 ;
+5 ; Write out the offending line
+6 SET CNT=CNT+1
+7 WRITE $JUSTIFY(CNT,3)
+8 WRITE ?5,"D0:",D0
+9 WRITE ?15,"D1:",D1
+10 IF $GET(D2)'=""
WRITE ?25,"D2:",D2
+11 IF $GET(D3)'=""
WRITE ?35,"D3:",D3
+12 WRITE !
+13 IF $GET(D3)'=""
WRITE ?5,$EXTRACT($GET(^DD(D0,D1,D2,D3)),1,73),!
+14 IF $GET(D2)'=""&($GET(D3)="")
WRITE ?5,$EXTRACT($GET(^DD(D0,D1,D2)),1,73),!
+15 IF $GET(D2)=""&($GET(D3)="")
WRITE ?5,$EXTRACT($GET(^DD(D0,D1)),1,73),!
+16 ;
+17 ; Now, try to fix.
+18 IF $GET(D3)'=""
Begin DoDot:1
+19 SET STR=$GET(^DD(D0,D1,D2,D3))
+20 SET STR=$$REPLACE^XLFSTR(STR,.SPEC)
+21 SET SUBSTR="^DD(D0,D1,D2,D3)"
+22 SET @SUBSTR=STR
+23 WRITE ?5,$EXTRACT(STR,1,73),!!
End DoDot:1
QUIT
+24 ;
+25 IF $GET(D2)'=""
Begin DoDot:1
+26 SET STR=$GET(^DD(D0,D1,D2))
+27 SET STR=$$REPLACE^XLFSTR(STR,.SPEC)
+28 SET SUBSTR="^DD(D0,D1,D2)"
+29 SET @SUBSTR=STR
+30 WRITE ?5,$EXTRACT(STR,1,73),!!
End DoDot:1
QUIT
+31 ;
+32 SET STR=$GET(^DD(D0,D1))
+33 SET STR=$$REPLACE^XLFSTR(STR,.SPEC)
+34 SET SUBSTR="^DD(D0,D1)"
+35 SET @SUBSTR=STR
+36 WRITE ?5,$EXTRACT(STR,1,73),!!
+37 ;
+38 QUIT
+39 ;
BLRHEADR(LINE1,LINE2,LINE3) ; HEADER subroutine
+1 NEW TMPLN
+2 ; Location
WRITE $$CJ^XLFSTR($$LOC^XBFUNC,IOM)
+3 ;
+4 SET TMPLN=$$CJ^XLFSTR(LINE1,IOM)
+5 ; Today's Date
SET $EXTRACT(TMPLN,1,13)="Date:"_$$HTE^XLFDT($HOROLOG,"2DZ")
+6 ; Current Time
SET $EXTRACT(TMPLN,IOM-15)=$JUSTIFY("Time:"_$$NOWTIME,16)
+7 ; Trim extra spaces
SET TMPLN=$$TRIM^XLFSTR(TMPLN,"R"," ")
+8 WRITE TMPLN,!
+9 ;
+10 IF $GET(LINE2)=""
QUIT
+11 ;
+12 WRITE $$CJ^XLFSTR(LINE2,IOM),!
+13 ;
+14 IF $GET(LINE3)=""
QUIT
+15 ;
+16 WRITE $$CJ^XLFSTR(LINE3,IOM),!
+17 ;
+18 QUIT
+19 ;
NOWTIME() ; EP - return NOW TIME in xx:xx AM/PM format
+1 NEW X
+2 ; MM/DD/YY HH:MM am/pm format
SET X=$$HTE^XLFDT($HOROLOG,"2MPZ")
+3 ; Get HH:MM am/pm
SET X=$PIECE(X," ",2,3)
+4 ; Uppercase am/pm to AM/PM
SET X=$$UP^XLFSTR(X)
+5 QUIT X
