PSBOST ;BIRMINGHAM/TEJ-UNABLE TO SCAN SUMMARY REPORT;Mar 2004 ; 29 Aug 2008 3:29 PM
;;3.0;BAR CODE MED ADMIN;**28**;Mar 2004;Build 9
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
;
; Reference/IA
; ^NURSF(211.4/1409
;
; Entry Point - GUI Report used by PSB MAN SCAN FAILURE key holders to produce
; total per BCMA scanning and scanning failures from the BCMA SCANNING FAILURE LOG File (#53.77).
;
EN ;BCMA UNABLE TO SCAN (Summary) REPORT
N PSBSEL,PSB05,PSBNU,PSBNULO
K PSBOUTP
S PSBDTST=+$P(PSBRPT(.1),U,6)_$P(PSBRPT(.1),U,7)
S PSBDTSP=+$P(PSBRPT(.1),U,8)_$P(PSBRPT(.1),U,9)
S Y=PSBDTST D DD^%DT S Y1=Y S Y=PSBDTSP D DD^%DT S Y2=Y
D NOW^%DTC S Y=% D DD^%DT S PSBDTTM=Y
S PSBLIST=""
S (NEWPAGE,PSBPGNUM,PSBLNTOT,PSBMORE,PSBTM,PSBTW,PSBTWKEY,PSBTMKEY,PSBTWUAS,PSBTMUAS,PSBTMMME,PSBTWSF,PSBTMSF,PSBTMEVT,PSBTWEVT)=0
I $P(PSBRPT(3),",",1)=1 D FACILITY
I $P(PSBRPT(3),",",2)=1 D NURSE
I $P(PSBRPT(3),",",3)=1 D WARD
K %,NEWPAGE,PSBDTSP,PSBDTST,PSBDTTM,PSBLIST,PSBLNTOT,PSBMBYPS,PSBMORE,PSBPG,PSBPGNUM,PSBPGRM,PSBRPT,PSBSTWD,PSBTM
K PSBTMEVT,PSBTMKEY,PSBTMMME,PSBOUTP,PSBTMSF,PSBTMUAS,PSBTSCAN,PSBTW,PSBTWEVT,PSBTWKEY,PSBTWSF,PSBTWUAS,PSBWBYPS
K PSBWRD,PSBX1,PSBX2,Y,Y1,Y2
Q
;
FACILITY ;Entire Facility Option
D WARDDIV(.PSBWARD,DUZ(2))
S PSBX1=$$FMADD^XLFDT(PSBDTST,,,,-.1) F S PSBX1=$O(^PSB(53.77,"ASFDT",PSBX1)) Q:(PSBX1>PSBDTSP)!(+PSBX1=0) D
.S PSBX2="" F S PSBX2=$O(^PSB(53.77,"ASFDT",PSBX1,PSBX2)) Q:PSBX2="" D
..S PSBWRD=$P($P($G(^PSB(53.77,PSBX2,0)),U,3),"$",1)_"$"
..I PSBWRD'["*UNIDENTIFIABLE PATIENT*",'$D(PSBWARD(PSBWRD)) Q ;Filter to users institution
..S PSB05=$P($G(^PSB(53.77,PSBX2,0)),U,5)
..I PSB05="MUAS" S PSBTMUAS=PSBTMUAS+1
..I PSB05="MKEY" S PSBTMKEY=PSBTMKEY+1
..I PSB05="MMME" S PSBTMMME=PSBTMMME+1
..I PSB05="MSCN" S PSBTM=PSBTM+1
..I PSB05="WUAS" S PSBTWUAS=PSBTWUAS+1
..I PSB05="WKEY" S PSBTWKEY=PSBTWKEY+1
..I PSB05="WSCN" S PSBTW=PSBTW+1
S PSBTMSF=PSBTMUAS+PSBTMKEY+PSBTMMME
S PSBTWSF=PSBTWUAS+PSBTWKEY
S PSBTMEVT=PSBTMSF+PSBTM
S PSBTWEVT=PSBTWSF+PSBTW
S PSBTSCAN=PSBTMEVT+PSBTWEVT
S PSBMBYPS=PSBTMKEY+PSBTMUAS+PSBTMMME
S PSBWBYPS=PSBTWKEY+PSBTWUAS
D BLDRPT
D WRTRPT
Q
;
NURSE ;Nurse Unit Option
K PSBWARD D WARDDIV(.PSBWARD,DUZ(2))
S PSBX1=$$FMADD^XLFDT(PSBDTST,,,,-.1) F S PSBX1=$O(^PSB(53.77,"ASFDT",PSBX1)) Q:(PSBX1>PSBDTSP)!(+PSBX1=0) D
.S PSBX2="" F S PSBX2=$O(^PSB(53.77,"ASFDT",PSBX1,PSBX2)) Q:PSBX2="" D
..S PSBWRD=$P($P($G(^PSB(53.77,PSBX2,0)),U,3),"$",1) I PSBWRD="" S PSBWRD=" "
..I PSBWRD'["*UNIDENTIFIABLE PATIENT*",'$D(PSBWARD(PSBWRD_"$")) Q ;Filter to users institution
..S PSB05=$P($G(^PSB(53.77,PSBX2,0)),U,5) I $G(PSB05)="" S PSB05=" "
..D ;Set Nurse Location
...I PSBWRD["*UNIDENTIFIABLE PATIENT*" S PSBNULO=PSBWRD Q
...S PSBNULO=$G(PSBWARD(PSBWRD_"$")) I PSBNULO="" S PSBNULO=" "
..I PSB05="MUAS" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
..I PSB05="MKEY" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
..I PSB05="MMME" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
..I PSB05="MSCN" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
..I PSB05="WUAS" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
..I PSB05="WKEY" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
..I PSB05="WSCN" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
S PSBNULO="" F S PSBNULO=$O(PSBNU(PSBNULO)) Q:PSBNULO="" D
.S PSBNU(PSBNULO,"WSF")=$G(PSBNU(PSBNULO,"WUAS"))+$G(PSBNU(PSBNULO,"WKEY"))
.S PSBNU(PSBNULO,"MSF")=$G(PSBNU(PSBNULO,"MUAS"))+$G(PSBNU(PSBNULO,"MKEY"))+$G(PSBNU(PSBNULO,"MMME"))
.S PSBNU(PSBNULO,"MEVT")=$G(PSBNU(PSBNULO,"MSF"))+$G(PSBNU(PSBNULO,"MSCN"))
.S PSBNU(PSBNULO,"WEVT")=$G(PSBNU(PSBNULO,"WSF"))+$G(PSBNU(PSBNULO,"WSCN"))
.S PSBNU(PSBNULO,"SCAN")=$G(PSBNU(PSBNULO,"MEVT"))+$G(PSBNU(PSBNULO,"WEVT"))
.S PSBNU(PSBNULO,"WBYPS")=$G(PSBNU(PSBNULO,"WKEY"))+$G(PSBNU(PSBNULO,"WUAS"))
.S PSBNU(PSBNULO,"MBYPS")=$G(PSBNU(PSBNULO,"MKEY"))+$G(PSBNU(PSBNULO,"MUAS"))+$G(PSBNU(PSBNULO,"MMME"))
.S PSBTMUAS=$G(PSBNU(PSBNULO,"MUAS"))
.S PSBTMKEY=$G(PSBNU(PSBNULO,"MKEY"))
.S PSBTMMME=$G(PSBNU(PSBNULO,"MMME"))
.S PSBTM=$G(PSBNU(PSBNULO,"MSCN"))
.S PSBTWUAS=$G(PSBNU(PSBNULO,"WUAS"))
.S PSBTWKEY=$G(PSBNU(PSBNULO,"WKEY"))
.S PSBTW=$G(PSBNU(PSBNULO,"WSCN"))
.S PSBTWSF=$G(PSBNU(PSBNULO,"WSF"))
.S PSBTMSF=$G(PSBNU(PSBNULO,"MSF"))
.S PSBTMEVT=$G(PSBNU(PSBNULO,"MEVT"))
.S PSBTWEVT=$G(PSBNU(PSBNULO,"WEVT"))
.S PSBTSCAN=$G(PSBNU(PSBNULO,"SCAN"))
.S PSBWBYPS=$G(PSBNU(PSBNULO,"WBYPS"))
.S PSBMBYPS=$G(PSBNU(PSBNULO,"MBYPS"))
.D BLDRPT
I +$G(PSBTSCAN)=0 D BLDRPT ;Call if data is not found so report will say 'not found'
D WRTRPT
Q
;
WARD ;Ward Option
S PSBSTWD=$P(PSBRPT(.1),U,3)
I $G(PSBSTWD)'="" D LISTWD^PSBOSF
S PSBX1=$$FMADD^XLFDT(PSBDTST,,,,-.1) F S PSBX1=$O(^PSB(53.77,"ASFDT",PSBX1)) Q:(PSBX1>PSBDTSP)!(+PSBX1=0) D
.S PSBX2="" F S PSBX2=$O(^PSB(53.77,"ASFDT",PSBX1,PSBX2)) Q:PSBX2="" D
..S PSBWRD=$P($P($G(^PSB(53.77,PSBX2,0)),U,3),"$",1)_"$"
..I '$D(PSBWARD(PSBSTWD,PSBWRD)) Q
..S PSB05=$P($G(^PSB(53.77,PSBX2,0)),U,5)
..I PSB05="MUAS" S PSBTMUAS=PSBTMUAS+1
..I PSB05="MKEY" S PSBTMKEY=PSBTMKEY+1
..I PSB05="MMME" S PSBTMMME=PSBTMMME+1
..I PSB05="MSCN" S PSBTM=PSBTM+1
..I PSB05="WUAS" S PSBTWUAS=PSBTWUAS+1
..I PSB05="WKEY" S PSBTWKEY=PSBTWKEY+1
..I PSB05="WSCN" S PSBTW=PSBTW+1
S PSBTMSF=PSBTMUAS+PSBTMKEY+PSBTMMME
S PSBTWSF=PSBTWUAS+PSBTWKEY
S PSBTMEVT=PSBTMSF+PSBTM
S PSBTWEVT=PSBTWSF+PSBTW
S PSBTSCAN=PSBTMEVT+PSBTWEVT
S PSBMBYPS=PSBTMKEY+PSBTMUAS+PSBTMMME
S PSBWBYPS=PSBTWKEY+PSBTWUAS
D BLDRPT
D WRTRPT
Q
;
BLDRPT ;Assemble report body from accumilated totals
I '$D(^XUSEC("PSB UNABLE TO SCAN",DUZ)) D Q
.S PSBPGNUM=1
.S PSBOUTP(0,14)="W !!,""<<<< BCMA UNABLE TO SCAN REPORTS HAVE RESTRICTED ACCESS >>>>"",!!"
I +$G(PSBTSCAN)'>0 D Q
.S PSBPGNUM=1
.S PSBOUTP(0,14)="W !!,""<<<< NO BCMA SCANNING ACTIVITY FOUND FOR THIS DATE RANGE >>>>"",!!"
S NEWPAGE=1
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Wristband Totals -"",?50,"" Count"",?82,""% total events"""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?50,"""_$TR($J(" ",21)," ","-")_$TR($J(" ",4)," "," ")_$TR($J(" ",21)," ","-")_""""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?7,""Processed via SCANNER "",$TR($J("""",(49-$X)),"" "","".""),"":"",?50,"""_$J($FN(PSBTW,","),10)_$TR($J(" ",25)," "," ")_$J($S(PSBTW>0:((PSBTW/PSBTWEVT)*100),1:0),5,1)_""""
S PSBOUTP($$PGTOT(2),PSBLNTOT)="W !!,?7,""Processed via SCANNER BY-PASS"",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$J($FN(PSBWBYPS,","),10)_$TR($J(" ",25)," "," ")_$J($S(PSBWBYPS>0:((PSBWBYPS/PSBTWEVT)*100),1:0),5,1)_""""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?15,""KEYED ENTRY"",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$TR($J(" ",11)," "," ")_$J($FN(PSBTWKEY,","),10)_$TR($J(" ",20)," "," ")_$J($S(PSBTWKEY>0:((PSBTWKEY/PSBTWEVT)*100),1:0),5,1)_""""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?15,""BCMA UNABLE TO SCAN Option "",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$TR($J(" ",11)," "," ")_$J($FN(PSBTWUAS,","),10)_$TR($J(" ",20)," "," ")_$J($S(PSBTWUAS>0:((PSBTWUAS/PSBTWEVT)*100),1:0),5,1)_""""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?50,"""_$TR($J(" ",21)," ","-")_$TR($J(" ",4)," "," ")_$TR($J(" ",21)," ","-")_""""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?7,""Total Wristband Scan Events "",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$J($FN(PSBTWEVT,","),10)_""""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,$TR($J("""",IOM),"" "",""-""),!"
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Medication Label Totals -"",?50,"" Count"",?82,""% total events"""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?50,"""_$TR($J(" ",21)," ","-")_$TR($J(" ",4)," "," ")_$TR($J(" ",21)," ","-")_""""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?7,""Processed via SCANNER "",$TR($J("""",(49-$X)),"" "","".""),"":"",?50,"""_$J($FN(PSBTM,","),10)_$TR($J(" ",25)," "," ")_$J($S(PSBTM>0:((PSBTM/PSBTMEVT)*100),1:0),5,1)_""""
S PSBOUTP($$PGTOT(2),PSBLNTOT)="W !!,?7,""Processed via SCANNER BY-PASS"",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$J($FN(PSBMBYPS,","),10)_$TR($J(" ",25)," "," ")_$J($S(PSBMBYPS>0:((PSBMBYPS/PSBTMEVT)*100),1:0),5,1)_""""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?15,""KEYED ENTRY"",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$TR($J(" ",11)," "," ")_$J($FN(PSBTMKEY,","),10)_$TR($J(" ",20)," "," ")_$J($S(PSBTMKEY>0:((PSBTMKEY/PSBTMEVT)*100),1:0),5,1)_""""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?15,""BCMA UNABLE TO SCAN "",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$TR($J(" ",11)," "," ")_$J($FN(PSBTMUAS,","),10)_$TR($J(" ",20)," "," ")_$J($S(PSBTMUAS>0:((PSBTMUAS/PSBTMEVT)*100),1:0),5,1)_""""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?15,""VISTA MANUAL MED ENTRY "",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$TR($J(" ",11)," "," ")_$J($FN(PSBTMMME,","),10)_$TR($J(" ",20)," "," ")_$J($S(PSBTMMME>0:((PSBTMMME/PSBTMEVT)*100),1:0),5,1)_""""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?50,"""_$TR($J(" ",21)," ","-")_$TR($J(" ",4)," "," ")_$TR($J(" ",21)," ","-")_""""
S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?7,""Total Medication Label Scan Events "",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$J($FN(PSBTMEVT,","),10)_""""
I $P(PSBRPT(3),",",2)=1 S PSBOUTP(PSBPGNUM)=PSBNULO
Q
;
WRTRPT ;Actually "WRITE" the report to output device
I $O(PSBOUTP(""),-1)<1 D Q
.D HDR
.X PSBOUTP($O(PSBOUTP(""),-1),14)
.D FTR
S PSBPGNUM=1
I $P(PSBRPT(3),",",2)=1 S PSBNULO=PSBOUTP(PSBPGNUM)
D HDR
S PSBX1="" F S PSBX1=$O(PSBOUTP(PSBX1)) Q:PSBX1="" D
.I PSBPGNUM'=PSBX1 D FTR S PSBPGNUM=PSBX1,PSBNULO=PSBOUTP(PSBPGNUM) D HDR
.S PSBX2="" F S PSBX2=$O(PSBOUTP(PSBX1,PSBX2)) Q:PSBX2="" D
..X PSBOUTP(PSBX1,PSBX2)
D FTR
Q
;
HDR ;Create Report Header
W:$Y>1 @IOF
W:$X>1 !
S PSBPG="Page: "_PSBPGNUM_" of "_$S(+$O(PSBOUTP(""),-1)=0:1,1:+$O(PSBOUTP(""),-1))
S PSBPGRM=IOM-($L(PSBPG)+12)
I $P(PSBRPT(0),U,4)="" S $P(PSBRPT(0),U,4)=DUZ(2)
W !!,"BCMA UNABLE TO SCAN (Summary)" W ?PSBPGRM,PSBPG
W !!,"Date/Time: "_PSBDTTM,!,"Report Date Range: Start Date: "_Y1_" Stop Date: "_Y2
W !,"Division: ",$P($G(^DIC(4,DUZ("2"),0)),U,1)
W " Nurse Location: " D
.I $G(PSBNULO)]"" W $$NURLOC(PSBNULO) Q
.I $G(PSBSTWD)]"" W $$NURLOC(PSBSTWD) Q
.W "All"
W !!,?5,"This is a summary report of BCMA Unable to Scan Events that have occurred within the given date range."
W !!,"Note: * Access to BCMA Unable to Scan Reports is RESTRICTED. *"
W !,$TR($J("",IOM)," ","="),!!
Q
;
FTR ;Create Report Footer
I (IOSL<100) F Q:$Y>(IOSL-12) W !!
W !!,$TR($J("",IOM)," ","="),!
W !,PSBDTTM,!,"BCMA UNABLE TO SCAN (Summary)"
W ?PSBPGRM,PSBPG,!
Q
;
PGTOT(X) ;Keep track of lines and PAGE Number...
S:'$D(X) PSBLNTOT=PSBLNTOT+1
S:$D(X) PSBLNTOT=PSBLNTOT+X
I PSBPGNUM=1,PSBLNTOT=1 S PSBLNTOT=14 S PSBMORE=PSBLNTOT+23 Q PSBPGNUM
I PSBLNTOT=PSBMORE S PSBMORE=PSBLNTOT+23
I (PSBMORE>(IOSL-7))!(NEWPAGE) S PSBPGNUM=PSBPGNUM+1,PSBLNTOT=14,PSBMORE=PSBLNTOT+23,NEWPAGE=0
Q PSBPGNUM
;
NURLOC(X) ;Nursing Location Name
I X["*UNIDENTIFIABLE PATIENT*" Q X
N PSBNURLC
S PSBNURLC=$G(^NURSF(211.4,X,0))
I PSBNURLC="" Q PSBNURLC
S PSBNURLC=$P($G(^SC(PSBNURLC,0)),"^",1)
Q PSBNURLC
;
WARDDIV(RESULTS,PSBINST) ; wards filtered by institution
N PSBIEN,PSBWIEN,PSBX
S PSBIEN=0 F S PSBIEN=$O(^NURSF(211.4,PSBIEN)) Q:PSBIEN'?.N D
.I $P($G(^SC($P($G(^NURSF(211.4,PSBIEN,0)),U,1),0)),U,4)'=PSBINST Q ;Screen out by INSTITUTION
.S PSBX=0 F S PSBX=$O(^NURSF(211.4,PSBIEN,3,PSBX)) Q:PSBX="" D
..S PSBWIEN=$P(^NURSF(211.4,PSBIEN,3,PSBX,0),"^")
..I $$GET1^DIQ(42,PSBWIEN_",",.01)]"" S RESULTS($$GET1^DIQ(42,PSBWIEN_",",.01)_"$")=PSBIEN
Q
PSBOST ;BIRMINGHAM/TEJ-UNABLE TO SCAN SUMMARY REPORT;Mar 2004 ; 29 Aug 2008 3:29 PM
+1 ;;3.0;BAR CODE MED ADMIN;**28**;Mar 2004;Build 9
+2 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
+3 ;
+4 ; Reference/IA
+5 ; ^NURSF(211.4/1409
+6 ;
+7 ; Entry Point - GUI Report used by PSB MAN SCAN FAILURE key holders to produce
+8 ; total per BCMA scanning and scanning failures from the BCMA SCANNING FAILURE LOG File (#53.77).
+9 ;
EN ;BCMA UNABLE TO SCAN (Summary) REPORT
+1 NEW PSBSEL,PSB05,PSBNU,PSBNULO
+2 KILL PSBOUTP
+3 SET PSBDTST=+$PIECE(PSBRPT(.1),U,6)_$PIECE(PSBRPT(.1),U,7)
+4 SET PSBDTSP=+$PIECE(PSBRPT(.1),U,8)_$PIECE(PSBRPT(.1),U,9)
+5 SET Y=PSBDTST
DO DD^%DT
SET Y1=Y
SET Y=PSBDTSP
DO DD^%DT
SET Y2=Y
+6 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSBDTTM=Y
+7 SET PSBLIST=""
+8 SET (NEWPAGE,PSBPGNUM,PSBLNTOT,PSBMORE,PSBTM,PSBTW,PSBTWKEY,PSBTMKEY,PSBTWUAS,PSBTMUAS,PSBTMMME,PSBTWSF,PSBTMSF,PSBTMEVT,PSBTWEVT)=0
+9 IF $PIECE(PSBRPT(3),",",1)=1
DO FACILITY
+10 IF $PIECE(PSBRPT(3),",",2)=1
DO NURSE
+11 IF $PIECE(PSBRPT(3),",",3)=1
DO WARD
+12 KILL %,NEWPAGE,PSBDTSP,PSBDTST,PSBDTTM,PSBLIST,PSBLNTOT,PSBMBYPS,PSBMORE,PSBPG,PSBPGNUM,PSBPGRM,PSBRPT,PSBSTWD,PSBTM
+13 KILL PSBTMEVT,PSBTMKEY,PSBTMMME,PSBOUTP,PSBTMSF,PSBTMUAS,PSBTSCAN,PSBTW,PSBTWEVT,PSBTWKEY,PSBTWSF,PSBTWUAS,PSBWBYPS
+14 KILL PSBWRD,PSBX1,PSBX2,Y,Y1,Y2
+15 QUIT
+16 ;
FACILITY ;Entire Facility Option
+1 DO WARDDIV(.PSBWARD,DUZ(2))
+2 SET PSBX1=$$FMADD^XLFDT(PSBDTST,,,,-.1)
FOR
SET PSBX1=$ORDER(^PSB(53.77,"ASFDT",PSBX1))
IF (PSBX1>PSBDTSP)!(+PSBX1=0)
QUIT
Begin DoDot:1
+3 SET PSBX2=""
FOR
SET PSBX2=$ORDER(^PSB(53.77,"ASFDT",PSBX1,PSBX2))
IF PSBX2=""
QUIT
Begin DoDot:2
+4 SET PSBWRD=$PIECE($PIECE($GET(^PSB(53.77,PSBX2,0)),U,3),"$",1)_"$"
+5 ;Filter to users institution
IF PSBWRD'["*UNIDENTIFIABLE PATIENT*"
IF '$DATA(PSBWARD(PSBWRD))
QUIT
+6 SET PSB05=$PIECE($GET(^PSB(53.77,PSBX2,0)),U,5)
+7 IF PSB05="MUAS"
SET PSBTMUAS=PSBTMUAS+1
+8 IF PSB05="MKEY"
SET PSBTMKEY=PSBTMKEY+1
+9 IF PSB05="MMME"
SET PSBTMMME=PSBTMMME+1
+10 IF PSB05="MSCN"
SET PSBTM=PSBTM+1
+11 IF PSB05="WUAS"
SET PSBTWUAS=PSBTWUAS+1
+12 IF PSB05="WKEY"
SET PSBTWKEY=PSBTWKEY+1
+13 IF PSB05="WSCN"
SET PSBTW=PSBTW+1
End DoDot:2
End DoDot:1
+14 SET PSBTMSF=PSBTMUAS+PSBTMKEY+PSBTMMME
+15 SET PSBTWSF=PSBTWUAS+PSBTWKEY
+16 SET PSBTMEVT=PSBTMSF+PSBTM
+17 SET PSBTWEVT=PSBTWSF+PSBTW
+18 SET PSBTSCAN=PSBTMEVT+PSBTWEVT
+19 SET PSBMBYPS=PSBTMKEY+PSBTMUAS+PSBTMMME
+20 SET PSBWBYPS=PSBTWKEY+PSBTWUAS
+21 DO BLDRPT
+22 DO WRTRPT
+23 QUIT
+24 ;
NURSE ;Nurse Unit Option
+1 KILL PSBWARD
DO WARDDIV(.PSBWARD,DUZ(2))
+2 SET PSBX1=$$FMADD^XLFDT(PSBDTST,,,,-.1)
FOR
SET PSBX1=$ORDER(^PSB(53.77,"ASFDT",PSBX1))
IF (PSBX1>PSBDTSP)!(+PSBX1=0)
QUIT
Begin DoDot:1
+3 SET PSBX2=""
FOR
SET PSBX2=$ORDER(^PSB(53.77,"ASFDT",PSBX1,PSBX2))
IF PSBX2=""
QUIT
Begin DoDot:2
+4 SET PSBWRD=$PIECE($PIECE($GET(^PSB(53.77,PSBX2,0)),U,3),"$",1)
IF PSBWRD=""
SET PSBWRD=" "
+5 ;Filter to users institution
IF PSBWRD'["*UNIDENTIFIABLE PATIENT*"
IF '$DATA(PSBWARD(PSBWRD_"$"))
QUIT
+6 SET PSB05=$PIECE($GET(^PSB(53.77,PSBX2,0)),U,5)
IF $GET(PSB05)=""
SET PSB05=" "
+7 ;Set Nurse Location
Begin DoDot:3
+8 IF PSBWRD["*UNIDENTIFIABLE PATIENT*"
SET PSBNULO=PSBWRD
QUIT
+9 SET PSBNULO=$GET(PSBWARD(PSBWRD_"$"))
IF PSBNULO=""
SET PSBNULO=" "
End DoDot:3
+10 IF PSB05="MUAS"
SET PSBNU(PSBNULO,PSB05)=$GET(PSBNU(PSBNULO,PSB05))+1
+11 IF PSB05="MKEY"
SET PSBNU(PSBNULO,PSB05)=$GET(PSBNU(PSBNULO,PSB05))+1
+12 IF PSB05="MMME"
SET PSBNU(PSBNULO,PSB05)=$GET(PSBNU(PSBNULO,PSB05))+1
+13 IF PSB05="MSCN"
SET PSBNU(PSBNULO,PSB05)=$GET(PSBNU(PSBNULO,PSB05))+1
+14 IF PSB05="WUAS"
SET PSBNU(PSBNULO,PSB05)=$GET(PSBNU(PSBNULO,PSB05))+1
+15 IF PSB05="WKEY"
SET PSBNU(PSBNULO,PSB05)=$GET(PSBNU(PSBNULO,PSB05))+1
+16 IF PSB05="WSCN"
SET PSBNU(PSBNULO,PSB05)=$GET(PSBNU(PSBNULO,PSB05))+1
End DoDot:2
End DoDot:1
+17 SET PSBNULO=""
FOR
SET PSBNULO=$ORDER(PSBNU(PSBNULO))
IF PSBNULO=""
QUIT
Begin DoDot:1
+18 SET PSBNU(PSBNULO,"WSF")=$GET(PSBNU(PSBNULO,"WUAS"))+$GET(PSBNU(PSBNULO,"WKEY"))
+19 SET PSBNU(PSBNULO,"MSF")=$GET(PSBNU(PSBNULO,"MUAS"))+$GET(PSBNU(PSBNULO,"MKEY"))+$GET(PSBNU(PSBNULO,"MMME"))
+20 SET PSBNU(PSBNULO,"MEVT")=$GET(PSBNU(PSBNULO,"MSF"))+$GET(PSBNU(PSBNULO,"MSCN"))
+21 SET PSBNU(PSBNULO,"WEVT")=$GET(PSBNU(PSBNULO,"WSF"))+$GET(PSBNU(PSBNULO,"WSCN"))
+22 SET PSBNU(PSBNULO,"SCAN")=$GET(PSBNU(PSBNULO,"MEVT"))+$GET(PSBNU(PSBNULO,"WEVT"))
+23 SET PSBNU(PSBNULO,"WBYPS")=$GET(PSBNU(PSBNULO,"WKEY"))+$GET(PSBNU(PSBNULO,"WUAS"))
+24 SET PSBNU(PSBNULO,"MBYPS")=$GET(PSBNU(PSBNULO,"MKEY"))+$GET(PSBNU(PSBNULO,"MUAS"))+$GET(PSBNU(PSBNULO,"MMME"))
+25 SET PSBTMUAS=$GET(PSBNU(PSBNULO,"MUAS"))
+26 SET PSBTMKEY=$GET(PSBNU(PSBNULO,"MKEY"))
+27 SET PSBTMMME=$GET(PSBNU(PSBNULO,"MMME"))
+28 SET PSBTM=$GET(PSBNU(PSBNULO,"MSCN"))
+29 SET PSBTWUAS=$GET(PSBNU(PSBNULO,"WUAS"))
+30 SET PSBTWKEY=$GET(PSBNU(PSBNULO,"WKEY"))
+31 SET PSBTW=$GET(PSBNU(PSBNULO,"WSCN"))
+32 SET PSBTWSF=$GET(PSBNU(PSBNULO,"WSF"))
+33 SET PSBTMSF=$GET(PSBNU(PSBNULO,"MSF"))
+34 SET PSBTMEVT=$GET(PSBNU(PSBNULO,"MEVT"))
+35 SET PSBTWEVT=$GET(PSBNU(PSBNULO,"WEVT"))
+36 SET PSBTSCAN=$GET(PSBNU(PSBNULO,"SCAN"))
+37 SET PSBWBYPS=$GET(PSBNU(PSBNULO,"WBYPS"))
+38 SET PSBMBYPS=$GET(PSBNU(PSBNULO,"MBYPS"))
+39 DO BLDRPT
End DoDot:1
+40 ;Call if data is not found so report will say 'not found'
IF +$GET(PSBTSCAN)=0
DO BLDRPT
+41 DO WRTRPT
+42 QUIT
+43 ;
WARD ;Ward Option
+1 SET PSBSTWD=$PIECE(PSBRPT(.1),U,3)
+2 IF $GET(PSBSTWD)'=""
DO LISTWD^PSBOSF
+3 SET PSBX1=$$FMADD^XLFDT(PSBDTST,,,,-.1)
FOR
SET PSBX1=$ORDER(^PSB(53.77,"ASFDT",PSBX1))
IF (PSBX1>PSBDTSP)!(+PSBX1=0)
QUIT
Begin DoDot:1
+4 SET PSBX2=""
FOR
SET PSBX2=$ORDER(^PSB(53.77,"ASFDT",PSBX1,PSBX2))
IF PSBX2=""
QUIT
Begin DoDot:2
+5 SET PSBWRD=$PIECE($PIECE($GET(^PSB(53.77,PSBX2,0)),U,3),"$",1)_"$"
+6 IF '$DATA(PSBWARD(PSBSTWD,PSBWRD))
QUIT
+7 SET PSB05=$PIECE($GET(^PSB(53.77,PSBX2,0)),U,5)
+8 IF PSB05="MUAS"
SET PSBTMUAS=PSBTMUAS+1
+9 IF PSB05="MKEY"
SET PSBTMKEY=PSBTMKEY+1
+10 IF PSB05="MMME"
SET PSBTMMME=PSBTMMME+1
+11 IF PSB05="MSCN"
SET PSBTM=PSBTM+1
+12 IF PSB05="WUAS"
SET PSBTWUAS=PSBTWUAS+1
+13 IF PSB05="WKEY"
SET PSBTWKEY=PSBTWKEY+1
+14 IF PSB05="WSCN"
SET PSBTW=PSBTW+1
End DoDot:2
End DoDot:1
+15 SET PSBTMSF=PSBTMUAS+PSBTMKEY+PSBTMMME
+16 SET PSBTWSF=PSBTWUAS+PSBTWKEY
+17 SET PSBTMEVT=PSBTMSF+PSBTM
+18 SET PSBTWEVT=PSBTWSF+PSBTW
+19 SET PSBTSCAN=PSBTMEVT+PSBTWEVT
+20 SET PSBMBYPS=PSBTMKEY+PSBTMUAS+PSBTMMME
+21 SET PSBWBYPS=PSBTWKEY+PSBTWUAS
+22 DO BLDRPT
+23 DO WRTRPT
+24 QUIT
+25 ;
BLDRPT ;Assemble report body from accumilated totals
+1 IF '$DATA(^XUSEC("PSB UNABLE TO SCAN",DUZ))
Begin DoDot:1
+2 SET PSBPGNUM=1
+3 SET PSBOUTP(0,14)="W !!,""<<<< BCMA UNABLE TO SCAN REPORTS HAVE RESTRICTED ACCESS >>>>"",!!"
End DoDot:1
QUIT
+4 IF +$GET(PSBTSCAN)'>0
Begin DoDot:1
+5 SET PSBPGNUM=1
+6 SET PSBOUTP(0,14)="W !!,""<<<< NO BCMA SCANNING ACTIVITY FOUND FOR THIS DATE RANGE >>>>"",!!"
End DoDot:1
QUIT
+7 SET NEWPAGE=1
+8 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Wristband Totals -"",?50,"" Count"",?82,""% total events"""
+9 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?50,"""_$TRANSLATE($JUSTIFY(" ",21)," ","-")_$TRANSLATE($JUSTIFY(" ",4)," "," ")_$TRANSLATE($JUSTIFY(" ",21)," ","-")_""""
+10 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?7,""Processed via SCANNER "",$TR($J("""",(49-$X)),"" "","".""),"":"",?50,"""_$JUSTIFY($FNUMBER(PSBTW,","),10)_$TRANSLATE($JUSTIFY(" ",25)," "," ")_$JUSTIFY($SELECT(PSBTW>0:((PSBTW/PSBTWEVT)*100),1:0),5,1)_"""
"
+11 SET PSBOUTP($$PGTOT(2),PSBLNTOT)="W !!,?7,""Processed via SCANNER BY-PASS"",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$JUSTIFY($FNUMBER(PSBWBYPS,","),10)_$TRANSLATE($JUSTIFY(" ",25)," "," ")_...
... $JUSTIFY($SELECT(PSBWBYPS>0:((PSBWBYPS/PSBTWEVT)*100),1:0),5,1)_""""
+12 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?15,""KEYED ENTRY"",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$TRANSLATE($JUSTIFY(" ",11)," "," ")_$JUSTIFY($FNUMBER(PSBTWKEY,","),10)_...
... $TRANSLATE($JUSTIFY(" ",20)," "," ")_$JUSTIFY($SELECT(PSBTWKEY>0:((PSBTWKEY/PSBTWEVT)*100),1:0),5,1)_""""
+13 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?15,""BCMA UNABLE TO SCAN Option "",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$TRANSLATE(...
... $JUSTIFY(" ",11)," "," ")_$JUSTIFY($FNUMBER(PSBTWUAS,","),10)_$TRANSLATE($JUSTIFY(" ",20)," "," ")_$JUSTIFY($SELECT(PSBTWUAS>0:((PSBTWUAS/PSBTWEVT)*100),1:0),5,1)_""""
+14 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?50,"""_$TRANSLATE($JUSTIFY(" ",21)," ","-")_$TRANSLATE($JUSTIFY(" ",4)," "," ")_$TRANSLATE($JUSTIFY(" ",21)," ","-")_""""
+15 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?7,""Total Wristband Scan Events "",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$JUSTIFY($FNUMBER(PSBTWEVT,","),10)_""""
+16 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,$TR($J("""",IOM),"" "",""-""),!"
+17 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Medication Label Totals -"",?50,"" Count"",?82,""% total events"""
+18 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?50,"""_$TRANSLATE($JUSTIFY(" ",21)," ","-")_$TRANSLATE($JUSTIFY(" ",4)," "," ")_$TRANSLATE($JUSTIFY(" ",21)," ","-")_""""
+19 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?7,""Processed via SCANNER "",$TR($J("""",(49-$X)),"" "","".""),"":"",?50,"""_$JUSTIFY($FNUMBER(PSBTM,","),10)_$TRANSLATE($JUSTIFY(" ",25)," "," ")_$JUSTIFY($SELECT(PSBTM>0:((PSBTM/PSBTMEVT)*100),1:0),5,1)_"""
"
+20 SET PSBOUTP($$PGTOT(2),PSBLNTOT)="W !!,?7,""Processed via SCANNER BY-PASS"",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$JUSTIFY($FNUMBER(PSBMBYPS,","),10)_$TRANSLATE($JUSTIFY(" ",25)," "," ")_...
... $JUSTIFY($SELECT(PSBMBYPS>0:((PSBMBYPS/PSBTMEVT)*100),1:0),5,1)_""""
+21 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?15,""KEYED ENTRY"",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$TRANSLATE($JUSTIFY(" ",11)," "," ")_$JUSTIFY($FNUMBER(PSBTMKEY,","),10)_...
... $TRANSLATE($JUSTIFY(" ",20)," "," ")_$JUSTIFY($SELECT(PSBTMKEY>0:((PSBTMKEY/PSBTMEVT)*100),1:0),5,1)_""""
+22 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?15,""BCMA UNABLE TO SCAN "",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$TRANSLATE($JUSTIFY(" ",11)," "," ")_...
... $JUSTIFY($FNUMBER(PSBTMUAS,","),10)_$TRANSLATE($JUSTIFY(" ",20)," "," ")_$JUSTIFY($SELECT(PSBTMUAS>0:((PSBTMUAS/PSBTMEVT)*100),1:0),5,1)_""""
+23 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?15,""VISTA MANUAL MED ENTRY "",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$TRANSLATE($JUSTIFY(" ",11)," "," ")_...
... $JUSTIFY($FNUMBER(PSBTMMME,","),10)_$TRANSLATE($JUSTIFY(" ",20)," "," ")_$JUSTIFY($SELECT(PSBTMMME>0:((PSBTMMME/PSBTMEVT)*100),1:0),5,1)_""""
+24 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?50,"""_$TRANSLATE($JUSTIFY(" ",21)," ","-")_$TRANSLATE($JUSTIFY(" ",4)," "," ")_$TRANSLATE($JUSTIFY(" ",21)," ","-")_""""
+25 SET PSBOUTP($$PGTOT,PSBLNTOT)="W !,?7,""Total Medication Label Scan Events "",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$JUSTIFY($FNUMBER(PSBTMEVT,","),10)_""""
+26 IF $PIECE(PSBRPT(3),",",2)=1
SET PSBOUTP(PSBPGNUM)=PSBNULO
+27 QUIT
+28 ;
WRTRPT ;Actually "WRITE" the report to output device
+1 IF $ORDER(PSBOUTP(""),-1)<1
Begin DoDot:1
+2 DO HDR
+3 XECUTE PSBOUTP($ORDER(PSBOUTP(""),-1),14)
+4 DO FTR
End DoDot:1
QUIT
+5 SET PSBPGNUM=1
+6 IF $PIECE(PSBRPT(3),",",2)=1
SET PSBNULO=PSBOUTP(PSBPGNUM)
+7 DO HDR
+8 SET PSBX1=""
FOR
SET PSBX1=$ORDER(PSBOUTP(PSBX1))
IF PSBX1=""
QUIT
Begin DoDot:1
+9 IF PSBPGNUM'=PSBX1
DO FTR
SET PSBPGNUM=PSBX1
SET PSBNULO=PSBOUTP(PSBPGNUM)
DO HDR
+10 SET PSBX2=""
FOR
SET PSBX2=$ORDER(PSBOUTP(PSBX1,PSBX2))
IF PSBX2=""
QUIT
Begin DoDot:2
+11 XECUTE PSBOUTP(PSBX1,PSBX2)
End DoDot:2
End DoDot:1
+12 DO FTR
+13 QUIT
+14 ;
HDR ;Create Report Header
+1 IF $Y>1
WRITE @IOF
+2 IF $X>1
WRITE !
+3 SET PSBPG="Page: "_PSBPGNUM_" of "_$SELECT(+$ORDER(PSBOUTP(""),-1)=0:1,1:+$ORDER(PSBOUTP(""),-1))
+4 SET PSBPGRM=IOM-($LENGTH(PSBPG)+12)
+5 IF $PIECE(PSBRPT(0),U,4)=""
SET $PIECE(PSBRPT(0),U,4)=DUZ(2)
+6 WRITE !!,"BCMA UNABLE TO SCAN (Summary)"
WRITE ?PSBPGRM,PSBPG
+7 WRITE !!,"Date/Time: "_PSBDTTM,!,"Report Date Range: Start Date: "_Y1_" Stop Date: "_Y2
+8 WRITE !,"Division: ",$PIECE($GET(^DIC(4,DUZ("2"),0)),U,1)
+9 WRITE " Nurse Location: "
Begin DoDot:1
+10 IF $GET(PSBNULO)]""
WRITE $$NURLOC(PSBNULO)
QUIT
+11 IF $GET(PSBSTWD)]""
WRITE $$NURLOC(PSBSTWD)
QUIT
+12 WRITE "All"
End DoDot:1
+13 WRITE !!,?5,"This is a summary report of BCMA Unable to Scan Events that have occurred within the given date range."
+14 WRITE !!,"Note: * Access to BCMA Unable to Scan Reports is RESTRICTED. *"
+15 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","="),!!
+16 QUIT
+17 ;
FTR ;Create Report Footer
+1 IF (IOSL<100)
FOR
IF $Y>(IOSL-12)
QUIT
WRITE !!
+2 WRITE !!,$TRANSLATE($JUSTIFY("",IOM)," ","="),!
+3 WRITE !,PSBDTTM,!,"BCMA UNABLE TO SCAN (Summary)"
+4 WRITE ?PSBPGRM,PSBPG,!
+5 QUIT
+6 ;
PGTOT(X) ;Keep track of lines and PAGE Number...
+1 IF '$DATA(X)
SET PSBLNTOT=PSBLNTOT+1
+2 IF $DATA(X)
SET PSBLNTOT=PSBLNTOT+X
+3 IF PSBPGNUM=1
IF PSBLNTOT=1
SET PSBLNTOT=14
SET PSBMORE=PSBLNTOT+23
QUIT PSBPGNUM
+4 IF PSBLNTOT=PSBMORE
SET PSBMORE=PSBLNTOT+23
+5 IF (PSBMORE>(IOSL-7))!(NEWPAGE)
SET PSBPGNUM=PSBPGNUM+1
SET PSBLNTOT=14
SET PSBMORE=PSBLNTOT+23
SET NEWPAGE=0
+6 QUIT PSBPGNUM
+7 ;
NURLOC(X) ;Nursing Location Name
+1 IF X["*UNIDENTIFIABLE PATIENT*"
QUIT X
+2 NEW PSBNURLC
+3 SET PSBNURLC=$GET(^NURSF(211.4,X,0))
+4 IF PSBNURLC=""
QUIT PSBNURLC
+5 SET PSBNURLC=$PIECE($GET(^SC(PSBNURLC,0)),"^",1)
+6 QUIT PSBNURLC
+7 ;
WARDDIV(RESULTS,PSBINST) ; wards filtered by institution
+1 NEW PSBIEN,PSBWIEN,PSBX
+2 SET PSBIEN=0
FOR
SET PSBIEN=$ORDER(^NURSF(211.4,PSBIEN))
IF PSBIEN'?.N
QUIT
Begin DoDot:1
+3 ;Screen out by INSTITUTION
IF $PIECE($GET(^SC($PIECE($GET(^NURSF(211.4,PSBIEN,0)),U,1),0)),U,4)'=PSBINST
QUIT
+4 SET PSBX=0
FOR
SET PSBX=$ORDER(^NURSF(211.4,PSBIEN,3,PSBX))
IF PSBX=""
QUIT
Begin DoDot:2
+5 SET PSBWIEN=$PIECE(^NURSF(211.4,PSBIEN,3,PSBX,0),"^")
+6 IF $$GET1^DIQ(42,PSBWIEN_",",.01)]""
SET RESULTS($$GET1^DIQ(42,PSBWIEN_",",.01)_"$")=PSBIEN
End DoDot:2
End DoDot:1
+7 QUIT
