BLRF44DR ; IHS/MSC/MKK - Hospital Locations (# 44) File Duplicate Abbreviation(s) Report ; [ February 29, 2012 8:00 AM ]
;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997
;
EEP ; EP - Ersatz Entry Point
D EEP^BLRGMENU
Q
;
PEP ; EP
EP ; EP
NEW ABBREV,BLRVERN,CNT,CURUCI,IEN,IEN2
NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
;
Q:$$INITVARS()="Q"
D REPORT
;
Q
;
INITVARS() ; EP
S BLRVERN=$$TRIM^XLFSTR($P($T(+1),";"),"R"," ")
;
S HEADER(1)="Hospital Location (# 44) File"
S HEADER(2)="Duplicate Abbreviation Report"
S HEADER(3)=" "
;
D HEADERDT^BLRGMENU
D ^%ZIS
I POP D Q "Q"
. W !,?4,"Device Not Available. Routine Ends.",!!
. D PRESSKEY^BLRGMENU(9)
U IO
;
I IOST["C-VT" D HEADONE2^BLRLUAC2(.HD1) W !
;
S MAXLINES=IOSL-4
S LINES=MAXLINES+10
S HEADER(4)=$TR($$CJ^XLFSTR("@HOSPITAL@LOCATION@",51)," @","= ")
S $E(HEADER(4),55)=$TR($$CJ^XLFSTR("@INSTITUTION@",26)," @","= ")
S HEADER(5)="IEN"
S $E(HEADER(5),10)="Description"
S $E(HEADER(5),45)="Abbrev"
S $E(HEADER(5),55)="IEN"
S $E(HEADER(5),65)="Description"
;
S (CNT,PG)=0,QFLG="NO"
;
Q "OK"
;
REPORT ; EP
S ABBREV=""
F S ABBREV=$O(^SC("C",ABBREV)) Q:ABBREV=""!(QFLG="Q") D
. S IEN=0
. S IEN=+$O(^SC("C",ABBREV,IEN))
. S IEN2=+$O(^SC("C",ABBREV,IEN))
. Q:IEN2<1
. ;
. D DUPLINE ; There are duplicates
;
W:QFLG'="Q" !!,?4,"Number of Distinct Duplicate Abbreviations = ",CNT,!
;
D ^%ZISC
;
D:QFLG'="Q"&(IOST["VT") PRESSKEY^BLRGMENU(4)
;
Q
;
DUPLINE ; EP
S:CNT<1 CNT=CNT+1
S:$L($TR(ABBREV," ")) CNT=CNT+1
S IEN=0
F S IEN=$O(^SC("C",ABBREV,IEN)) Q:IEN<1!(QFLG="Q") D
. I LINES>MAXLINES D HEADERPG^BLRGMENU(.PG,.QFLG,HD1) Q:QFLG="Q"
. W IEN
. W ?9,$E($P($G(^SC(IEN,0)),"^"),1,38)
. W ?44,$S($L($TR(ABBREV," "))>0:ABBREV,1:"<BLANK>")
. W ?54,$P($G(^SC(IEN,0)),"^",4)
. W ?64,$E($P($G(^DIC(4,+$P($G(^SC(IEN,0)),"^",4),0)),"^"),1,16)
. W !
. S LINES=LINES+1
Q
;
HEADONE(HD1) ; EP -- Asks if user wants only 1 header line
D ^XBFMK
S DIR("A")="One Header Line ONLY"
S DIR("B")="NO"
S DIR(0)="YO"
D ^DIR
S HD1=$S(+$G(Y)=1:"YES",1:"NO")
Q
;
TASKREPT ; EP - Task the report
NEW BLRDUZ,IOP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
;
S ZTRTN="TASKIT^BLRF44DR"
S ZTDESC="BLRF44DR Tasked Compilation"
;
M BLRDUZ=DUZ
S ZTSAVE("*")=""
S ZTDTH=$H
S ZTIO=""
S IOP="Q"
D ^%ZTLOAD
W !,?4,"Job ",ZTSK," Queued",!
D PRESSKEY^BLRGMENU(9)
Q
;
TASKIT ; EP - Tasked Report
NEW ABBREV,BLRVERN,CNT,IEN,IEN2,LINE,MMSGSTR
;
I $D(ZTQUEUED) S ZTREQ="@"
;
D TASKITIN
;
S ABBREV=""
F S ABBREV=$O(^SC("C",ABBREV)) Q:ABBREV="" D
. S IEN=0
. S IEN=+$O(^SC("C",ABBREV,IEN))
. S IEN2=+$O(^SC("C",ABBREV,IEN))
. Q:IEN2<1
. ;
. D TASKLINE
;
D:CNT>0 TROUBLE
;
Q
;
TASKITIN ; EP - Tasked Initialization of variables
K MMSGSTR
;
S MMSGSTR(1)="Duplicate Abbreviations Exist in HOSPITAL LOCATION (# 44) File."
S MMSGSTR(2)=" "
S MMSGSTR(3)=" The potential for erroneous Hospital Location statistics is high."
S MMSGSTR(4)=" Report follows:"
S MMSGSTR(5)=" "
;
; Header of Report
S MMSGSTR(6)=$$TRIM^XLFSTR($$CJ^XLFSTR($$LOC^XBFUNC,80),"R"," ")
S MMSGSTR(7)=$$TRIM^XLFSTR($$CJ^XLFSTR("Hospital Location (# 44) File",80),"R"," ")
S MMSGSTR(8)=$$TRIM^XLFSTR($$CJ^XLFSTR("Duplicate Abbreviation Report",80),"R"," ")
;
S MMSGSTR(9)=" "
S MMSGSTR(10)=$TR($$CJ^XLFSTR("@HOSPITAL@LOCATION@",51)," @","= ")
S $E(MMSGSTR(10),55)=$TR($$CJ^XLFSTR("@INSTITUTION@",25)," @","= ")
S MMSGSTR(11)="IEN"
S $E(MMSGSTR(11),10)="Description"
S $E(MMSGSTR(11),45)="Abbrev"
S $E(MMSGSTR(11),55)="IEN"
S $E(MMSGSTR(11),65)="Description"
S MMSGSTR(12)=$TR($J("",IOM)," ","-")
;
S LINE=13
;
S CNT=0
;
Q
;
TASKLINE ; EP
S:CNT<1 CNT=CNT+1
S:$L($TR(ABBREV," ")) CNT=CNT+1
S IEN=0
F S IEN=$O(^SC("C",ABBREV,IEN)) Q:IEN<1 D
. S MMSGSTR(LINE)=IEN
. S $E(MMSGSTR(LINE),10)=$E($P($G(^SC(IEN,0)),"^"),1,28)
. ; S $E(MMSGSTR(LINE),40)=CNT
. S $E(MMSGSTR(LINE),45)=$S($L($TR(ABBREV," "))>0:ABBREV,1:"<BLANK>")
. S $E(MMSGSTR(LINE),55)=$P($G(^SC(IEN,0)),"^",4)
. S $E(MMSGSTR(LINE),65)=$E($P($G(^DIC(4,+$P($G(^SC(IEN,0)),"^",4),0)),"^"),1,14)
. S LINE=LINE+1
Q
;
;
TROUBLE(WOT) ; EP - There are duplicate Abbreviations, which are trouble. Send Alert & MailMan message.
; D SNDALERT^BLRUTIL3(CNT_" Duplicate Abbreviations Exist in HOSPITAL LOCATION (# 44) File.")
;
D SENDMAIL^BLRUTIL3("Duplicate Abbreviations Exist in HOSPITAL LOCATION (# 44) File",.MMSGSTR,"BLRF44DR")
Q
BLRF44DR ; IHS/MSC/MKK - Hospital Locations (# 44) File Duplicate Abbreviation(s) Report ; [ February 29, 2012 8:00 AM ]
+1 ;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997
+2 ;
EEP ; EP - Ersatz Entry Point
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
PEP ; EP
EP ; EP
+1 NEW ABBREV,BLRVERN,CNT,CURUCI,IEN,IEN2
+2 NEW HD1,HEADER,LINES,MAXLINES,PG,QFLG
+3 ;
+4 IF $$INITVARS()="Q"
QUIT
+5 DO REPORT
+6 ;
+7 QUIT
+8 ;
INITVARS() ; EP
+1 SET BLRVERN=$$TRIM^XLFSTR($PIECE($TEXT(+1),";"),"R"," ")
+2 ;
+3 SET HEADER(1)="Hospital Location (# 44) File"
+4 SET HEADER(2)="Duplicate Abbreviation Report"
+5 SET HEADER(3)=" "
+6 ;
+7 DO HEADERDT^BLRGMENU
+8 DO ^%ZIS
+9 IF POP
Begin DoDot:1
+10 WRITE !,?4,"Device Not Available. Routine Ends.",!!
+11 DO PRESSKEY^BLRGMENU(9)
End DoDot:1
QUIT "Q"
+12 USE IO
+13 ;
+14 IF IOST["C-VT"
DO HEADONE2^BLRLUAC2(.HD1)
WRITE !
+15 ;
+16 SET MAXLINES=IOSL-4
+17 SET LINES=MAXLINES+10
+18 SET HEADER(4)=$TRANSLATE($$CJ^XLFSTR("@HOSPITAL@LOCATION@",51)," @","= ")
+19 SET $EXTRACT(HEADER(4),55)=$TRANSLATE($$CJ^XLFSTR("@INSTITUTION@",26)," @","= ")
+20 SET HEADER(5)="IEN"
+21 SET $EXTRACT(HEADER(5),10)="Description"
+22 SET $EXTRACT(HEADER(5),45)="Abbrev"
+23 SET $EXTRACT(HEADER(5),55)="IEN"
+24 SET $EXTRACT(HEADER(5),65)="Description"
+25 ;
+26 SET (CNT,PG)=0
SET QFLG="NO"
+27 ;
+28 QUIT "OK"
+29 ;
REPORT ; EP
+1 SET ABBREV=""
+2 FOR
SET ABBREV=$ORDER(^SC("C",ABBREV))
IF ABBREV=""!(QFLG="Q")
QUIT
Begin DoDot:1
+3 SET IEN=0
+4 SET IEN=+$ORDER(^SC("C",ABBREV,IEN))
+5 SET IEN2=+$ORDER(^SC("C",ABBREV,IEN))
+6 IF IEN2<1
QUIT
+7 ;
+8 ; There are duplicates
DO DUPLINE
End DoDot:1
+9 ;
+10 IF QFLG'="Q"
WRITE !!,?4,"Number of Distinct Duplicate Abbreviations = ",CNT,!
+11 ;
+12 DO ^%ZISC
+13 ;
+14 IF QFLG'="Q"&(IOST["VT")
DO PRESSKEY^BLRGMENU(4)
+15 ;
+16 QUIT
+17 ;
DUPLINE ; EP
+1 IF CNT<1
SET CNT=CNT+1
+2 IF $LENGTH($TRANSLATE(ABBREV," "))
SET CNT=CNT+1
+3 SET IEN=0
+4 FOR
SET IEN=$ORDER(^SC("C",ABBREV,IEN))
IF IEN<1!(QFLG="Q")
QUIT
Begin DoDot:1
+5 IF LINES>MAXLINES
DO HEADERPG^BLRGMENU(.PG,.QFLG,HD1)
IF QFLG="Q"
QUIT
+6 WRITE IEN
+7 WRITE ?9,$EXTRACT($PIECE($GET(^SC(IEN,0)),"^"),1,38)
+8 WRITE ?44,$SELECT($LENGTH($TRANSLATE(ABBREV," "))>0:ABBREV,1:"<BLANK>")
+9 WRITE ?54,$PIECE($GET(^SC(IEN,0)),"^",4)
+10 WRITE ?64,$EXTRACT($PIECE($GET(^DIC(4,+$PIECE($GET(^SC(IEN,0)),"^",4),0)),"^"),1,16)
+11 WRITE !
+12 SET LINES=LINES+1
End DoDot:1
+13 QUIT
+14 ;
HEADONE(HD1) ; EP -- Asks if user wants only 1 header line
+1 DO ^XBFMK
+2 SET DIR("A")="One Header Line ONLY"
+3 SET DIR("B")="NO"
+4 SET DIR(0)="YO"
+5 DO ^DIR
+6 SET HD1=$SELECT(+$GET(Y)=1:"YES",1:"NO")
+7 QUIT
+8 ;
TASKREPT ; EP - Task the report
+1 NEW BLRDUZ,IOP,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+2 ;
+3 SET ZTRTN="TASKIT^BLRF44DR"
+4 SET ZTDESC="BLRF44DR Tasked Compilation"
+5 ;
+6 MERGE BLRDUZ=DUZ
+7 SET ZTSAVE("*")=""
+8 SET ZTDTH=$HOROLOG
+9 SET ZTIO=""
+10 SET IOP="Q"
+11 DO ^%ZTLOAD
+12 WRITE !,?4,"Job ",ZTSK," Queued",!
+13 DO PRESSKEY^BLRGMENU(9)
+14 QUIT
+15 ;
TASKIT ; EP - Tasked Report
+1 NEW ABBREV,BLRVERN,CNT,IEN,IEN2,LINE,MMSGSTR
+2 ;
+3 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 ;
+5 DO TASKITIN
+6 ;
+7 SET ABBREV=""
+8 FOR
SET ABBREV=$ORDER(^SC("C",ABBREV))
IF ABBREV=""
QUIT
Begin DoDot:1
+9 SET IEN=0
+10 SET IEN=+$ORDER(^SC("C",ABBREV,IEN))
+11 SET IEN2=+$ORDER(^SC("C",ABBREV,IEN))
+12 IF IEN2<1
QUIT
+13 ;
+14 DO TASKLINE
End DoDot:1
+15 ;
+16 IF CNT>0
DO TROUBLE
+17 ;
+18 QUIT
+19 ;
TASKITIN ; EP - Tasked Initialization of variables
+1 KILL MMSGSTR
+2 ;
+3 SET MMSGSTR(1)="Duplicate Abbreviations Exist in HOSPITAL LOCATION (# 44) File."
+4 SET MMSGSTR(2)=" "
+5 SET MMSGSTR(3)=" The potential for erroneous Hospital Location statistics is high."
+6 SET MMSGSTR(4)=" Report follows:"
+7 SET MMSGSTR(5)=" "
+8 ;
+9 ; Header of Report
+10 SET MMSGSTR(6)=$$TRIM^XLFSTR($$CJ^XLFSTR($$LOC^XBFUNC,80),"R"," ")
+11 SET MMSGSTR(7)=$$TRIM^XLFSTR($$CJ^XLFSTR("Hospital Location (# 44) File",80),"R"," ")
+12 SET MMSGSTR(8)=$$TRIM^XLFSTR($$CJ^XLFSTR("Duplicate Abbreviation Report",80),"R"," ")
+13 ;
+14 SET MMSGSTR(9)=" "
+15 SET MMSGSTR(10)=$TRANSLATE($$CJ^XLFSTR("@HOSPITAL@LOCATION@",51)," @","= ")
+16 SET $EXTRACT(MMSGSTR(10),55)=$TRANSLATE($$CJ^XLFSTR("@INSTITUTION@",25)," @","= ")
+17 SET MMSGSTR(11)="IEN"
+18 SET $EXTRACT(MMSGSTR(11),10)="Description"
+19 SET $EXTRACT(MMSGSTR(11),45)="Abbrev"
+20 SET $EXTRACT(MMSGSTR(11),55)="IEN"
+21 SET $EXTRACT(MMSGSTR(11),65)="Description"
+22 SET MMSGSTR(12)=$TRANSLATE($JUSTIFY("",IOM)," ","-")
+23 ;
+24 SET LINE=13
+25 ;
+26 SET CNT=0
+27 ;
+28 QUIT
+29 ;
TASKLINE ; EP
+1 IF CNT<1
SET CNT=CNT+1
+2 IF $LENGTH($TRANSLATE(ABBREV," "))
SET CNT=CNT+1
+3 SET IEN=0
+4 FOR
SET IEN=$ORDER(^SC("C",ABBREV,IEN))
IF IEN<1
QUIT
Begin DoDot:1
+5 SET MMSGSTR(LINE)=IEN
+6 SET $EXTRACT(MMSGSTR(LINE),10)=$EXTRACT($PIECE($GET(^SC(IEN,0)),"^"),1,28)
+7 ; S $E(MMSGSTR(LINE),40)=CNT
+8 SET $EXTRACT(MMSGSTR(LINE),45)=$SELECT($LENGTH($TRANSLATE(ABBREV," "))>0:ABBREV,1:"<BLANK>")
+9 SET $EXTRACT(MMSGSTR(LINE),55)=$PIECE($GET(^SC(IEN,0)),"^",4)
+10 SET $EXTRACT(MMSGSTR(LINE),65)=$EXTRACT($PIECE($GET(^DIC(4,+$PIECE($GET(^SC(IEN,0)),"^",4),0)),"^"),1,14)
+11 SET LINE=LINE+1
End DoDot:1
+12 QUIT
+13 ;
+14 ;
TROUBLE(WOT) ; EP - There are duplicate Abbreviations, which are trouble. Send Alert & MailMan message.
+1 ; D SNDALERT^BLRUTIL3(CNT_" Duplicate Abbreviations Exist in HOSPITAL LOCATION (# 44) File.")
+2 ;
+3 DO SENDMAIL^BLRUTIL3("Duplicate Abbreviations Exist in HOSPITAL LOCATION (# 44) File",.MMSGSTR,"BLRF44DR")
+4 QUIT
