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

PSBOST.m

Go to the documentation of this file. 
  1. 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
  1.  ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
  1.  ;
  1.  ; Reference/IA
  1.  ; ^NURSF(211.4/1409
  1.  ;
  1.  ; Entry Point -  GUI Report used by PSB MAN SCAN FAILURE key holders to produce
  1.  ;                total per BCMA scanning and scanning failures from the BCMA SCANNING FAILURE LOG File (#53.77).
  1.  ;
  1. EN ;BCMA UNABLE TO SCAN (Summary) REPORT
  1.  N PSBSEL,PSB05,PSBNU,PSBNULO
  1.  K PSBOUTP
  1.  S PSBDTST=+$P(PSBRPT(.1),U,6)_$P(PSBRPT(.1),U,7)
  1.  S PSBDTSP=+$P(PSBRPT(.1),U,8)_$P(PSBRPT(.1),U,9)
  1.  S Y=PSBDTST D DD^%DT S Y1=Y S Y=PSBDTSP D DD^%DT S Y2=Y
  1.  D NOW^%DTC S Y=% D DD^%DT S PSBDTTM=Y
  1.  S PSBLIST=""
  1.  S (NEWPAGE,PSBPGNUM,PSBLNTOT,PSBMORE,PSBTM,PSBTW,PSBTWKEY,PSBTMKEY,PSBTWUAS,PSBTMUAS,PSBTMMME,PSBTWSF,PSBTMSF,PSBTMEVT,PSBTWEVT)=0
  1.  I $P(PSBRPT(3),",",1)=1 D FACILITY
  1.  I $P(PSBRPT(3),",",2)=1 D NURSE
  1.  I $P(PSBRPT(3),",",3)=1 D WARD
  1.  K %,NEWPAGE,PSBDTSP,PSBDTST,PSBDTTM,PSBLIST,PSBLNTOT,PSBMBYPS,PSBMORE,PSBPG,PSBPGNUM,PSBPGRM,PSBRPT,PSBSTWD,PSBTM
  1.  K PSBTMEVT,PSBTMKEY,PSBTMMME,PSBOUTP,PSBTMSF,PSBTMUAS,PSBTSCAN,PSBTW,PSBTWEVT,PSBTWKEY,PSBTWSF,PSBTWUAS,PSBWBYPS
  1.  K PSBWRD,PSBX1,PSBX2,Y,Y1,Y2
  1.  Q
  1.  ;
  1. FACILITY ;Entire Facility Option
  1.  D WARDDIV(.PSBWARD,DUZ(2))
  1.  S PSBX1=$$FMADD^XLFDT(PSBDTST,,,,-.1) F  S PSBX1=$O(^PSB(53.77,"ASFDT",PSBX1)) Q:(PSBX1>PSBDTSP)!(+PSBX1=0)  D
  1.  .S PSBX2="" F  S PSBX2=$O(^PSB(53.77,"ASFDT",PSBX1,PSBX2)) Q:PSBX2=""  D
  1.  ..S PSBWRD=$P($P($G(^PSB(53.77,PSBX2,0)),U,3),"$",1)_"$"
  1.  ..I PSBWRD'["*UNIDENTIFIABLE PATIENT*",'$D(PSBWARD(PSBWRD)) Q  ;Filter to users institution
  1.  ..S PSB05=$P($G(^PSB(53.77,PSBX2,0)),U,5)
  1.  ..I PSB05="MUAS" S PSBTMUAS=PSBTMUAS+1
  1.  ..I PSB05="MKEY" S PSBTMKEY=PSBTMKEY+1
  1.  ..I PSB05="MMME" S PSBTMMME=PSBTMMME+1
  1.  ..I PSB05="MSCN" S PSBTM=PSBTM+1
  1.  ..I PSB05="WUAS" S PSBTWUAS=PSBTWUAS+1
  1.  ..I PSB05="WKEY" S PSBTWKEY=PSBTWKEY+1
  1.  ..I PSB05="WSCN" S PSBTW=PSBTW+1
  1.  S PSBTMSF=PSBTMUAS+PSBTMKEY+PSBTMMME
  1.  S PSBTWSF=PSBTWUAS+PSBTWKEY
  1.  S PSBTMEVT=PSBTMSF+PSBTM
  1.  S PSBTWEVT=PSBTWSF+PSBTW
  1.  S PSBTSCAN=PSBTMEVT+PSBTWEVT
  1.  S PSBMBYPS=PSBTMKEY+PSBTMUAS+PSBTMMME
  1.  S PSBWBYPS=PSBTWKEY+PSBTWUAS
  1.  D BLDRPT
  1.  D WRTRPT
  1.  Q
  1.  ;
  1. NURSE ;Nurse Unit Option
  1.  K PSBWARD D WARDDIV(.PSBWARD,DUZ(2))
  1.  S PSBX1=$$FMADD^XLFDT(PSBDTST,,,,-.1) F  S PSBX1=$O(^PSB(53.77,"ASFDT",PSBX1)) Q:(PSBX1>PSBDTSP)!(+PSBX1=0)  D
  1.  .S PSBX2="" F  S PSBX2=$O(^PSB(53.77,"ASFDT",PSBX1,PSBX2)) Q:PSBX2=""  D
  1.  ..S PSBWRD=$P($P($G(^PSB(53.77,PSBX2,0)),U,3),"$",1) I PSBWRD="" S PSBWRD=" "
  1.  ..I PSBWRD'["*UNIDENTIFIABLE PATIENT*",'$D(PSBWARD(PSBWRD_"$")) Q  ;Filter to users institution
  1.  ..S PSB05=$P($G(^PSB(53.77,PSBX2,0)),U,5) I $G(PSB05)="" S PSB05=" "
  1.  ..D  ;Set Nurse Location
  1.  ...I PSBWRD["*UNIDENTIFIABLE PATIENT*" S PSBNULO=PSBWRD Q
  1.  ...S PSBNULO=$G(PSBWARD(PSBWRD_"$")) I PSBNULO="" S PSBNULO=" "
  1.  ..I PSB05="MUAS" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
  1.  ..I PSB05="MKEY" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
  1.  ..I PSB05="MMME" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
  1.  ..I PSB05="MSCN" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
  1.  ..I PSB05="WUAS" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
  1.  ..I PSB05="WKEY" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
  1.  ..I PSB05="WSCN" S PSBNU(PSBNULO,PSB05)=$G(PSBNU(PSBNULO,PSB05))+1
  1.  S PSBNULO="" F  S PSBNULO=$O(PSBNU(PSBNULO)) Q:PSBNULO=""  D
  1.  .S PSBNU(PSBNULO,"WSF")=$G(PSBNU(PSBNULO,"WUAS"))+$G(PSBNU(PSBNULO,"WKEY"))
  1.  .S PSBNU(PSBNULO,"MSF")=$G(PSBNU(PSBNULO,"MUAS"))+$G(PSBNU(PSBNULO,"MKEY"))+$G(PSBNU(PSBNULO,"MMME"))
  1.  .S PSBNU(PSBNULO,"MEVT")=$G(PSBNU(PSBNULO,"MSF"))+$G(PSBNU(PSBNULO,"MSCN"))
  1.  .S PSBNU(PSBNULO,"WEVT")=$G(PSBNU(PSBNULO,"WSF"))+$G(PSBNU(PSBNULO,"WSCN"))
  1.  .S PSBNU(PSBNULO,"SCAN")=$G(PSBNU(PSBNULO,"MEVT"))+$G(PSBNU(PSBNULO,"WEVT"))
  1.  .S PSBNU(PSBNULO,"WBYPS")=$G(PSBNU(PSBNULO,"WKEY"))+$G(PSBNU(PSBNULO,"WUAS"))
  1.  .S PSBNU(PSBNULO,"MBYPS")=$G(PSBNU(PSBNULO,"MKEY"))+$G(PSBNU(PSBNULO,"MUAS"))+$G(PSBNU(PSBNULO,"MMME"))
  1.  .S PSBTMUAS=$G(PSBNU(PSBNULO,"MUAS"))
  1.  .S PSBTMKEY=$G(PSBNU(PSBNULO,"MKEY"))
  1.  .S PSBTMMME=$G(PSBNU(PSBNULO,"MMME"))
  1.  .S PSBTM=$G(PSBNU(PSBNULO,"MSCN"))
  1.  .S PSBTWUAS=$G(PSBNU(PSBNULO,"WUAS"))
  1.  .S PSBTWKEY=$G(PSBNU(PSBNULO,"WKEY"))
  1.  .S PSBTW=$G(PSBNU(PSBNULO,"WSCN"))
  1.  .S PSBTWSF=$G(PSBNU(PSBNULO,"WSF"))
  1.  .S PSBTMSF=$G(PSBNU(PSBNULO,"MSF"))
  1.  .S PSBTMEVT=$G(PSBNU(PSBNULO,"MEVT"))
  1.  .S PSBTWEVT=$G(PSBNU(PSBNULO,"WEVT"))
  1.  .S PSBTSCAN=$G(PSBNU(PSBNULO,"SCAN"))
  1.  .S PSBWBYPS=$G(PSBNU(PSBNULO,"WBYPS"))
  1.  .S PSBMBYPS=$G(PSBNU(PSBNULO,"MBYPS"))
  1.  .D BLDRPT
  1.  I +$G(PSBTSCAN)=0 D BLDRPT  ;Call if data is not found so report will say 'not found'
  1.  D WRTRPT
  1.  Q
  1.  ;
  1. WARD ;Ward Option
  1.  S PSBSTWD=$P(PSBRPT(.1),U,3)
  1.  I $G(PSBSTWD)'="" D LISTWD^PSBOSF
  1.  S PSBX1=$$FMADD^XLFDT(PSBDTST,,,,-.1) F  S PSBX1=$O(^PSB(53.77,"ASFDT",PSBX1)) Q:(PSBX1>PSBDTSP)!(+PSBX1=0)  D
  1.  .S PSBX2="" F  S PSBX2=$O(^PSB(53.77,"ASFDT",PSBX1,PSBX2)) Q:PSBX2=""  D
  1.  ..S PSBWRD=$P($P($G(^PSB(53.77,PSBX2,0)),U,3),"$",1)_"$"
  1.  ..I '$D(PSBWARD(PSBSTWD,PSBWRD)) Q
  1.  ..S PSB05=$P($G(^PSB(53.77,PSBX2,0)),U,5)
  1.  ..I PSB05="MUAS" S PSBTMUAS=PSBTMUAS+1
  1.  ..I PSB05="MKEY" S PSBTMKEY=PSBTMKEY+1
  1.  ..I PSB05="MMME" S PSBTMMME=PSBTMMME+1
  1.  ..I PSB05="MSCN" S PSBTM=PSBTM+1
  1.  ..I PSB05="WUAS" S PSBTWUAS=PSBTWUAS+1
  1.  ..I PSB05="WKEY" S PSBTWKEY=PSBTWKEY+1
  1.  ..I PSB05="WSCN" S PSBTW=PSBTW+1
  1.  S PSBTMSF=PSBTMUAS+PSBTMKEY+PSBTMMME
  1.  S PSBTWSF=PSBTWUAS+PSBTWKEY
  1.  S PSBTMEVT=PSBTMSF+PSBTM
  1.  S PSBTWEVT=PSBTWSF+PSBTW
  1.  S PSBTSCAN=PSBTMEVT+PSBTWEVT
  1.  S PSBMBYPS=PSBTMKEY+PSBTMUAS+PSBTMMME
  1.  S PSBWBYPS=PSBTWKEY+PSBTWUAS
  1.  D BLDRPT
  1.  D WRTRPT
  1.  Q
  1.  ;
  1. BLDRPT ;Assemble report body from accumilated totals
  1.  I '$D(^XUSEC("PSB UNABLE TO SCAN",DUZ)) D  Q
  1.  .S PSBPGNUM=1
  1.  .S PSBOUTP(0,14)="W !!,""<<<< BCMA UNABLE TO SCAN REPORTS HAVE RESTRICTED ACCESS >>>>"",!!"
  1.  I +$G(PSBTSCAN)'>0 D  Q
  1.  .S PSBPGNUM=1
  1.  .S PSBOUTP(0,14)="W !!,""<<<< NO BCMA SCANNING ACTIVITY FOUND FOR THIS DATE RANGE >>>>"",!!"
  1.  S NEWPAGE=1
  1.  S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Wristband Totals -"",?50,""     Count"",?82,""% total events"""
  1.  S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?50,"""_$TR($J(" ",21)," ","-")_$TR($J(" ",4)," "," ")_$TR($J(" ",21)," ","-")_""""
  1.  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)_""""
  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)_""""
  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)_""""
  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)_""""
  1.  S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?50,"""_$TR($J(" ",21)," ","-")_$TR($J(" ",4)," "," ")_$TR($J(" ",21)," ","-")_""""
  1.  S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?7,""Total Wristband Scan Events "",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$J($FN(PSBTWEVT,","),10)_""""
  1.  S PSBOUTP($$PGTOT,PSBLNTOT)="W !,$TR($J("""",IOM),"" "",""-""),!"
  1.  S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?5,""Medication Label Totals -"",?50,""     Count"",?82,""% total events"""
  1.  S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?50,"""_$TR($J(" ",21)," ","-")_$TR($J(" ",4)," "," ")_$TR($J(" ",21)," ","-")_""""
  1.  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)_""""
  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)_""""
  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)_""""
  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)_""""
  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)_""""
  1.  S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?50,"""_$TR($J(" ",21)," ","-")_$TR($J(" ",4)," "," ")_$TR($J(" ",21)," ","-")_""""
  1.  S PSBOUTP($$PGTOT,PSBLNTOT)="W !,?7,""Total Medication Label Scan Events "",$TR($J("""",(49-$X)),"" "","".""),"":"","""_$J($FN(PSBTMEVT,","),10)_""""
  1.  I $P(PSBRPT(3),",",2)=1 S PSBOUTP(PSBPGNUM)=PSBNULO
  1.  Q
  1.  ;
  1. WRTRPT ;Actually "WRITE" the report to output device
  1.  I $O(PSBOUTP(""),-1)<1 D  Q
  1.  .D HDR
  1.  .X PSBOUTP($O(PSBOUTP(""),-1),14)
  1.  .D FTR
  1.  S PSBPGNUM=1
  1.  I $P(PSBRPT(3),",",2)=1 S PSBNULO=PSBOUTP(PSBPGNUM)
  1.  D HDR
  1.  S PSBX1="" F  S PSBX1=$O(PSBOUTP(PSBX1)) Q:PSBX1=""  D
  1.  .I PSBPGNUM'=PSBX1 D FTR S PSBPGNUM=PSBX1,PSBNULO=PSBOUTP(PSBPGNUM) D HDR
  1.  .S PSBX2="" F  S PSBX2=$O(PSBOUTP(PSBX1,PSBX2)) Q:PSBX2=""  D
  1.  ..X PSBOUTP(PSBX1,PSBX2)
  1.  D FTR
  1.  Q
  1.  ;
  1. HDR ;Create Report Header
  1.  W:$Y>1 @IOF
  1.  W:$X>1 !
  1.  S PSBPG="Page: "_PSBPGNUM_" of "_$S(+$O(PSBOUTP(""),-1)=0:1,1:+$O(PSBOUTP(""),-1))
  1.  S PSBPGRM=IOM-($L(PSBPG)+12)
  1.  I $P(PSBRPT(0),U,4)="" S $P(PSBRPT(0),U,4)=DUZ(2)
  1.  W !!,"BCMA UNABLE TO SCAN (Summary)" W ?PSBPGRM,PSBPG
  1.  W !!,"Date/Time: "_PSBDTTM,!,"Report Date Range:  Start Date: "_Y1_"   Stop Date: "_Y2
  1.  W !,"Division: ",$P($G(^DIC(4,DUZ("2"),0)),U,1)
  1.  W "   Nurse Location: " D
  1.  .I $G(PSBNULO)]"" W $$NURLOC(PSBNULO) Q
  1.  .I $G(PSBSTWD)]"" W $$NURLOC(PSBSTWD) Q
  1.  .W "All"
  1.  W !!,?5,"This is a summary report of BCMA Unable to Scan Events that have occurred within the given date range."
  1.  W !!,"Note: * Access to BCMA Unable to Scan Reports is RESTRICTED. *"
  1.  W !,$TR($J("",IOM)," ","="),!!
  1.  Q
  1.  ;
  1. FTR ;Create Report Footer
  1.  I (IOSL<100) F  Q:$Y>(IOSL-12)  W !!
  1.  W !!,$TR($J("",IOM)," ","="),!
  1.  W !,PSBDTTM,!,"BCMA UNABLE TO SCAN (Summary)"
  1.  W ?PSBPGRM,PSBPG,!
  1.  Q
  1.  ;
  1. PGTOT(X) ;Keep track of lines and PAGE Number...
  1.  S:'$D(X) PSBLNTOT=PSBLNTOT+1
  1.  S:$D(X) PSBLNTOT=PSBLNTOT+X
  1.  I PSBPGNUM=1,PSBLNTOT=1 S PSBLNTOT=14 S PSBMORE=PSBLNTOT+23 Q PSBPGNUM
  1.  I PSBLNTOT=PSBMORE S PSBMORE=PSBLNTOT+23
  1.  I (PSBMORE>(IOSL-7))!(NEWPAGE) S PSBPGNUM=PSBPGNUM+1,PSBLNTOT=14,PSBMORE=PSBLNTOT+23,NEWPAGE=0
  1.  Q PSBPGNUM
  1.  ;
  1. NURLOC(X) ;Nursing Location Name
  1.  I X["*UNIDENTIFIABLE PATIENT*" Q X
  1.  N PSBNURLC
  1.  S PSBNURLC=$G(^NURSF(211.4,X,0))
  1.  I PSBNURLC="" Q PSBNURLC
  1.  S PSBNURLC=$P($G(^SC(PSBNURLC,0)),"^",1)
  1.  Q PSBNURLC
  1.  ;
  1. WARDDIV(RESULTS,PSBINST) ; wards filtered by institution
  1.  N PSBIEN,PSBWIEN,PSBX
  1.  S PSBIEN=0 F  S PSBIEN=$O(^NURSF(211.4,PSBIEN)) Q:PSBIEN'?.N  D
  1.  .I $P($G(^SC($P($G(^NURSF(211.4,PSBIEN,0)),U,1),0)),U,4)'=PSBINST Q  ;Screen out by INSTITUTION
  1.  .S PSBX=0 F  S PSBX=$O(^NURSF(211.4,PSBIEN,3,PSBX)) Q:PSBX=""  D
  1.  ..S PSBWIEN=$P(^NURSF(211.4,PSBIEN,3,PSBX,0),"^")
  1.  ..I $$GET1^DIQ(42,PSBWIEN_",",.01)]"" S RESULTS($$GET1^DIQ(42,PSBWIEN_",",.01)_"$")=PSBIEN
  1.  Q