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

BLRBBDDC.m

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