PSBIHS1 ;KF/VAOIT PSB BCMA MOB ENTRY REPORT
;;1.0;PSB BCMA CPS FOXK;**1018**;;Build 27
ASKDN ;ASK NURSE OR DIVISION
S DIR(0)="SA^D:DIVISION;N:NURSING UNIT"
S DIR("A")="Run this report by (D):Division or (N):Nursing Unit: "
D ^DIR I X="^"!(X="") D STOP Q
S PSBN=Y
K DIR,Y,DIR("A"),DIR(0)
I PSBN="N" D ASKNUR Q
I PSBN="D" D ASK1 Q
Q
ASKNUR ;NURSE LOCATION
S DIC(0)="AEMQMZ",DIC="^NURSF(211.4," D ^DIC I X="^"!(X="") D STOP Q Q:Y'>0
S PSBNL=$P(Y,"^",1)
I $P($G(^NURSF(211.4,PSBNL,1)),"^",1)'="A" W !,"You selePSBCTed a 'INAPSBCTIVE' Nurse Unit Please try again! " H 2 D ASKNUR Q
D ST2
Q
ASK1 ;GET DIVS.
S Y=$$SITE^VASITE
S PSBDV=$P(Y,"^",1),PSBDVV(PSBDV)=""
ST2 ;START AND END DATES
S %DT("A")="Enter a Start Date: "
S %DT="AE"
D ^%DT I X="^"!(X="") D STOP Q
S PSBBDATE=Y K %DT,Y
I PSBBDATE<3030801 D Q
.S Y=PSBBDATE D DD^%DT W !,"You entered "_Y_" Start Date must be After 'August 1, 2003" D ST2 Q
K %DT,Y
END K X
S %DT("A")="Enter a End Date: ",PSBEDATE=""
S %DT="AE"
D ^%DT S PSBEDATE=Y K %DT,Y
I X=""!(X="^") D STOP Q
S X1=PSBEDATE,X2=1 D C^%DTC S PSBEDATE=X K X1,X2
I PSBEDATE<PSBBDATE W !,"End Date must be after the start !" D END Q
W !,"Print order details CPRS Med Order Button Yes/No?: "
S %=1 D YN^DICN I X=""!(X="^") D STOP Q
S PSBREP=0 ;DEFAULT NO
I %=1 D
.S PSBREP1=1
.W !,"Would you like to include comments Yes/No?: "
.S %=1 D YN^DICN I X=""!(X="^") D STOP Q
.I %=1 S PSBCOM1=1
.I %=2 S PSBCOM1=0
;.S %=1
S PSBLN=1
I %=2 S PSBREP1=0,PSBLN=0
I '$D(PSBN) S PSBN=""
I '$D(PSBNL) S PSBNL=""
I '$D(PSBDV) S PSBDV=""
I '$D(PSBVISN) S PSBVISN=""
D TAS
Q
NTASK ;NIGHT TASK
S X1=DT,X2=-1 D C^%DTC S PSBBDATE=X K X1,X2
S PSBREP1=1,X1=DT,X2=1 D C^%DTC S PSBEDATE=X K X1,X2
S PSBLN=1,PSBN="D"
S Y=$$SITE^VASITE
S PSBCOM1=0
S PSBDV=$P(Y,"^",1),PSBDVV(PSBDV)=""
I '$D(PSBN) S PSBN=""
I '$D(PSBNL) S PSBNL=""
I '$D(PSBDV) S PSBDV=""
I '$D(PSBVISN) S PSBVISN=""
U IO
D NEW
Q
TAS ;TASK IT OR NOT
S %ZIS="Q"
W ! D ^%ZIS K %ZIS
I POP D Q
.W $C(7)
.K VISN,PSBEDATE,PSBBDATE,PSBDV
; output not queued...
I '$D(IO("Q")) D
.D WAIT^DICD U IO D NEW
.I IO'=IO(0) D ^%ZISC
; set up the Task...
I $D(IO("Q")) D
.N ZTDESC,ZTSAVE,ZTIO,ZTRTN
.S ZTRTN="NEW^PSBIHS1"
.S ZTDESC="PSB MOB ENTRY REPORT "
.S ZTSAVE("PSBBDATE")=""
.S ZTSAVE("PSBEDATE")=""
.S ZTSAVE("PSBVISN")=""
.S ZTSAVE("PSBDV")=""
.S ZTSAVE("PSBREP1")=""
.S ZTSAVE("PSBLN")=""
.S ZTSAVE("PSBN")=""
.S ZTSAVE("PSBNL")=""
.S ZTSAVE("PSBDV*")=""
.S ZTSAVE("PSBCOM1")=""
.S ZTIO=ION
.D ^%ZTLOAD
.D HOME^%ZIS
.W !,$S($G(ZTSK):"Task number "_ZTSK_" queued.",1:"ERROR -- NOT QUEUED!")
.K IO("Q"),ZTSK
Q
NEW ;ALL PRNS
K ^TMP($J),PSBNONEP
S PSBCNT=0,PSBNONE=0,PSBCNTP=0,PSBNONEP=0
NUR ;BLUID ARRAY BY NURS LOCATION
I PSBN="N" D
.S PSBNWARD=0 F S PSBNWARD=$O(^NURSF(211.4,PSBNL,3,PSBNWARD)) Q:PSBNWARD="" D
..S PSBNWD=$P($G(^NURSF(211.4,PSBNL,3,PSBNWARD,0)),"^",1)
..S PSBNWD($P($G(^DIC(42,PSBNWD,0)),"^",1))=""
DIV1 ;BLGD ARRAY FOR WARDS IN THE DIV SELEPSBCTED
I PSBN="D" D
.K ^TMP($J,"DIV")
.S PSBIEN=0 F S PSBIEN=$O(^DIC(42,PSBIEN)) Q:PSBIEN'>0 S PSBDIV=$P($G(^DIC(42,PSBIEN,0)),U,11) S:+PSBDIV ^TMP($J,"DIV",PSBDIV,PSBIEN)=""
.S PSBNUM="" F S PSBNUM=$O(PSBDVV(PSBNUM)) Q:PSBNUM="" D
..K %,DIC,D,X,Y
..S DIC="^DG(40.8,",D="AD",X=PSBNUM,DIC(0)="XN"
..D IX^DIC Q:+Y'>0
..S PSBDIV1=+Y
..K DIC,D,X,Y
..;GET WARDS IN MED CENTER DIVION
..S PSBWIEN="" F S PSBWIEN=$O(^TMP($J,"DIV",PSBDIV1,PSBWIEN)) Q:PSBWIEN="" S PSBNWD($P($G(^DIC(42,PSBWIEN,0)),"^",1))=""
K ^TMP($J) ;DONE WITH DIV USE TMP AGAIN
STS ;LOOK IN MED FILE FOR DATA...
N PSBPSBCTWD,PSBPSBCTWDN,PSBCT,PSBCTN,PSBCTNNLOC,PSBCTNLOC,PSBBC2,PSBLEN,PSBLEN1
S PSBDFN="" F S PSBDFN=$O(^PSB(53.79,"AEDT",PSBDFN)) Q:PSBDFN'>0 D
.S PSBDATE=PSBBDATE F S PSBDATE=$O(^PSB(53.79,"AEDT",PSBDFN,PSBDATE)) Q:PSBDATE'>0!(PSBDATE>PSBEDATE) D
..S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"AEDT",PSBDFN,PSBDATE,PSBIEN)) Q:PSBIEN'>0 D
...;CHECK PSBDIV FIRST
...S PSBDIV=$P($G(^PSB(53.79,PSBIEN,0)),"^",3)
...I PSBDIV="" Q
...S PSBLOC1=$P($G(^PSB(53.79,PSBIEN,0)),"^",2)
...S PSBSTOP=0
...S PSBLOC3="" F S PSBLOC3=$O(PSBNWD(PSBLOC3)) Q:PSBLOC3=""!(PSBSTOP=1) D
....I PSBLOC1[PSBLOC3 S PSBLEN=$L(PSBLOC3) S PSBLEN1=$E(PSBLOC1,1,PSBLEN) I PSBLOC3=PSBLEN1 S PSBSTOP=1,PSBLOC=PSBLOC3
...I PSBSTOP=0 Q
...I '$D(PSBPSBCTWD(PSBLOC)) S PSBPSBCTWD(PSBLOC)=0
...I '$D(PSBPSBCTWDN(PSBLOC)) S PSBPSBCTWDN(PSBLOC)=0
...I '$D(PSBCT(PSBDIV)) S PSBCT(PSBDIV)=0
...I '$D(PSBCTN(PSBDIV)) S PSBCTN(PSBDIV)=0
...S PSBWIEN=$O(^DIC(42,"B",PSBLOC,"")),PSBWDNU=""
...S PSBNLOCC="" F S PSBNLOCC=$O(^NURSF(211.4,"C",PSBWIEN,PSBNLOCC)) Q:PSBNLOCC="" D
....I $P($G(^NURSF(211.4,PSBNLOCC,1)),"^",1)="A" S PSBWDNU=$P($G(^SC($P($G(^NURSF(211.4,PSBNLOCC,0)),"^",1),0)),"^",1),PSBNLOC=PSBNLOCC
...I '$D(PSBCTNLOC(PSBNLOC)) S PSBCTNLOC(PSBNLOC)=0
...I '$D(PSBCTNNLOC(PSBNLOC)) S PSBCTNNLOC(PSBNLOC)=0
...I '$D(PSBCTNLOCP(PSBNLOC)) S PSBCTNLOCP(PSBNLOC)=0
...I '$D(PSBCTNNLOCP(PSBNLOC)) S PSBCTNNLOCP(PSBNLOC)=0
...S PSBBC2=0
...S PSBCNT=PSBCNT+1,PSBCT(PSBDIV)=PSBCT(PSBDIV)+1,PSBPSBCTWD(PSBLOC)=PSBPSBCTWD(PSBLOC)+1,PSBCTNLOC(PSBNLOC)=PSBCTNLOC(PSBNLOC)+1
...F PSBH=1:1:$P($G(^PSB(53.79,PSBIEN,.3,0)),"^",4) D
....I $G(^PSB(53.79,PSBIEN,.3,PSBH,0))["BCMA/CPRS Interface Entry" S PSBBC2=1,PSBNONE=PSBNONE+1,PSBCTN(PSBDIV)=PSBCTN(PSBDIV)+1,PSBCTNNLOC(PSBNLOC)=PSBCTNNLOC(PSBNLOC)+1,PSBPSBCTWDN(PSBLOC)=PSBPSBCTWDN(PSBLOC)+1
....I PSBBC2=1 D
.....S PSBNAME=$P($G(^DPT($P($G(^PSB(53.79,PSBIEN,0)),"^",1),0)),"^",1)
.....I PSBWDNU="" S PSBWDNU="NO 'N.U.' FOR WARD"
.....S ^TMP($J,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME,PSBIEN)=$G(^PSB(53.79,PSBIEN,0))
REP ;DISPLAY DATA
W @IOF
W !,?15,"BCMA/EHR Med Order Button From " S Y=PSBBDATE D DD^%DT W Y_" TO " S X1=PSBEDATE,X2=-1 D C^%DTC S Y=X D DD^%DT S PSBREPT=Y W PSBREPT
D NOW^%DTC S Y=% D DD^%DT S PSBRT=Y W !,?65,"Run Date/Time:"_PSBRT
I PSBN="D" D
.W !,?5,"SITE",?25,"TOTAL Med Logs",?45,"BCMA/CPRS Med Order Button Entry" ;?65,"% GUI Entered"
.W ! F J=1:1:IOM W "-"
.I PSBCNT=0 W !,"NONE FOUND" Q
.S PSBDIV="" F J=0:0 S PSBDIV=$O(PSBCT(PSBDIV)) Q:PSBDIV="" D
..W !,$P($G(^DIC(4,PSBDIV,0)),"^",1)
..S PSBDT=$G(PSBCT(PSBDIV)),PSBDTN=$G(PSBCTN(PSBDIV)),PSBDD=PSBDT-PSBDTN
..I PSBDT>0 S PSBDPER=(PSBDD/PSBDT)*100
..I PSBDT=0 S PSBDPER=0
..W ?30,PSBDT,?50,PSBDTN ;?76,$E(PSBDPER,1,6)_"%"
.W ! F J=1:1:IOM W "-"
.S PSBDD=PSBCNT-PSBNONE,PSBTPER=(PSBDD/PSBCNT)*100
.W !,"TOTALS",?30,PSBCNT,?50,PSBNONE ;,?76,$E(PSBTPER,1,6)_"%"
.;WARD TOTALS
.W !!!,?5,"WARD",?25,"TOTAL Med Logs",?45,"BCMA/CPRS Med Order Button Entry" ;,?70,"% GUI Entered"
.W ! F J=1:1:IOM W "-"
.I PSBCNT=0 W !,"NONE FOUND" Q
.S PSBWARD="" F J=0:0 S PSBWARD=$O(PSBPSBCTWD(PSBWARD)) Q:PSBWARD="" D
..W !,PSBWARD
..S PSBDT=$G(PSBPSBCTWD(PSBWARD)),PSBDTN=$G(PSBPSBCTWDN(PSBWARD)),PSBDD=PSBDT-PSBDTN
..I PSBDT>0 S PSBDPER=(PSBDD/PSBDT)*100
..I PSBDT=0 S PSBDPER=0
..W ?30,PSBDT,?50,PSBDTN ;?76,$E(PSBDPER,1,6)_"%"
.W ! F J=1:1:IOM W "-"
;Nursing Unit
I PSBN="N" D
.W !!,"By Nursing Unit"
.W !!!,?5,"Nurse Unit",?25,"TOTAL Med Logs",?45,"BCMA/CPRS Med Order Button Entry" ;,?70,"% GUI Entered"
.W ! F J=1:1:IOM W "-"
.I PSBCNT=0 W !,"NONE FOUND" Q
.S PSBNUT="" F S PSBNUT=$O(PSBCTNLOC(PSBNUT)) Q:PSBNUT="" D
..S PSBNUT1=PSBNUT
..S PSBNUTN=$P($G(^NURSF(211.4,PSBNUT,0)),"^",1),PSBNUTN=$P($G(^SC(PSBNUTN,0)),"^",1) W !,PSBNUTN
..S PSBDT=$G(PSBCTNLOC(PSBNUT)),PSBDTN=$G(PSBCTNNLOC(PSBNUT)),PSBDD=PSBDT-PSBDTN
..I PSBDT>0 S PSBDPER=(PSBDD/PSBDT)*100
..I PSBDT=0 S PSBDPER=0
..W ?30,PSBDT,?50,PSBDTN ;,?76,$E(PSBDPER,1,6)_"%"
.S PSBNUTN=$P($G(^NURSF(211.4,PSBNUT1,0)),"^",1),PSBNUTN=$P($G(^SC(PSBNUTN,0)),"^",1) W !,PSBNUTN
.S PSBDT=$G(PSBCTNLOCP(PSBNUT1)),PSBDTN=$G(PSBCTNNLOCP(PSBNUT1)),PSBDD=PSBDT-PSBDTN
.I PSBDT>0 S PSBDPER=(PSBDD/PSBDT)*100
.I PSBDT=0 S PSBDPER=0
.W ?30,PSBDT,?50,PSBDTN ;,?76,$E(PSBDPER,1,6)_"%"
.W ! F J=1:1:IOM W "-"
.I PSBCNT=0 W !,"NONE FOUND" Q
.S PSBDD=PSBCNT-PSBNONE,PSBTPER=(PSBDD/PSBCNT)*100
.W !,"Report Totals",?30,PSBCNT,?50,PSBNONE ;,?76,$E(PSBTPER,1,6)_"%",!
.I PSBDT=0 S PSBDPER=0
I PSBREP1=1 D REP1
D STOP
Q
HEAD W @IOF
W !,?15,"BCMA/CPRS Interface Entry in BCMA From " S Y=PSBBDATE D DD^%DT W Y_" TO " W PSBREPT
W !,"Nurse Unit: "_PSBWDNU,?65,"Run Date/Time: "_PSBRT
I PSBLN=0 W !,"NAME",?30,"HRN",?45,"DATE/TIME"
I PSBLN=1 W !,"NAME",?30,"HRN",?45,"DATE/TIME",?65,"ADMIN BY"
W ! F J=1:1:IOM W "-"
K %
Q
REP1 S PSBWDNU=0
S PSBDIV="" F J=0:0 S PSBDIV=$O(^TMP($J,"PRN",PSBDIV)) Q:PSBDIV="" D
.S PSBWDNU="" F J=0:0 S PSBWDNU=$O(^TMP($J,"PRN",PSBDIV,PSBWDNU)) Q:PSBWDNU="" D
..I '$D(PSBONU) S PSBONU=PSBWDNU D HEAD
..I PSBWDNU'=PSBONU D HEAD
..S PSBLOC="" F J=0:0 S PSBLOC=$O(^TMP($J,"PRN",PSBDIV,PSBWDNU,PSBLOC)) Q:PSBLOC="" D
...F PSBNAME="" F J=0:0 S PSBNAME=$O(^TMP($J,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME)) Q:PSBNAME="" D
....S PSBIEN="" F J=1:1 S PSBIEN=$O(^TMP($J,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME,PSBIEN)) Q:PSBIEN="" D
.....I $Y>(IOSL-4) D HEAD
.....S DFN=$P($G(^TMP($J,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME,PSBIEN)),"^",1)
.....D DEM^VADPT,PID^VADPT
.....S PSBPID=$S(DUZ("AG")="I":(VA("PID")),1:$E(VA("PID"),$L(VA("PID"))-3,999))
.....S Y=$P($G(^TMP($J,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME,PSBIEN)),"^",6) D DD^%DT S PSBMT=Y
.....S PSBDRUG=$P($G(^PS(50.7,$P($G(^TMP($J,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME,PSBIEN)),"^",8),0)),"^",1) S PSBDRUG=$E(PSBDRUG,1,35)
.....S PSBNUR=$P($G(^TMP($J,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME,PSBIEN)),"^",7) S PSBNUR=$P($G(^VA(200,PSBNUR,0)),"^",1) S PSBNUR=$E(PSBNUR,1,32)
.....I PSBLN=0 W !,PSBNAME,?30,PSBPID,?40,PSBMT
.....I PSBLN=1 W !,PSBNAME,?30,PSBPID,?40,PSBMT,?63,PSBNUR,!,?15,"Medication: ",PSBDRUG,?50,"Dosage: ",$P($G(^PSB(53.79,PSBIEN,.1)),"^",5)
.....D ORNUM ;PRINT IEN FROM 100
.....I $D(^PSB(53.79,PSBIEN,.6,0)) D
......W !,?15,"Additives:"
......F J=1:1:$P(^PSB(53.79,PSBIEN,.6,0),"^",4) W !,?27,$P(^PSB(53.79,PSBIEN,.6,J,0),"^",2)," ",$P(^PSB(53.79,PSBIEN,.6,J,0),"^",3)
.....I $D(^PSB(53.79,PSBIEN,.7,0)) D
......W !,?15,"Solutions:"
......F J=1:1:$P(^PSB(53.79,PSBIEN,.7,0),"^",4) W !,?27,$P(^PSB(53.79,PSBIEN,.7,J,0),"^",2)," ",$P(^PSB(53.79,PSBIEN,.7,J,0),"^",3)
.....I PSBCOM1=1 D COM
.....W !
..S PSBONU=PSBWDNU
D STOP Q
COM ;LOOPS FOR COMMENTS HELD
N PSBNUM,PSBCOMB,PSBCOMT,PSBCOM
W !,?15,"Comments:---------------------------------------------------------"
S PSBNUM=0 F S PSBNUM=$O(^PSB(53.79,PSBIEN,.3,PSBNUM)) Q:PSBNUM'>0 D
.S PSBCOM=$P($G(^PSB(53.79,PSBIEN,.3,PSBNUM,0)),"^",1)
.S PSBCOMB=$P($G(^PSB(53.79,PSBIEN,.3,PSBNUM,0)),"^",2) S PSBCOMB=$P($G(^VA(200,PSBCOMB,0)),"^",2)
.S Y=$P($G(^PSB(53.79,PSBIEN,.3,PSBNUM,0)),"^",3) D DD^%DT S PSBCOMT=Y
.W !,?25,PSBCOMT_" "_PSBCOMB
.W !,?25,PSBCOM
W !,?25,"---------------------------------------------------------"
Q
ORNUM ;GET CPRS ORDER NUMBER
S PSBORN=$P($G(^PSB(53.79,PSBIEN,.1)),"^",1)
I PSBORN["U" S PSBORN=$P($G(^PS(55,DFN,5,+PSBORN,0)),"^",21)
I PSBORN["V" S PSBORN=$P($G(^PS(55,DFN,"IV",+PSBORN,0)),"^",21)
W !,?15,"EHR Order Number: ",PSBORN
Q
STOP ;
K PSBDATE,PSBDFN,PSBDPER,PSBDT,PSBDTN,PSBEDATE,PSBBDATE,PSBLOC,PSBNAME,PSBSSN,PSBMT,PSBLOC3,PSBNUT1
K PSBDRUG,PSBNONE,PSBVISN,PSBTPER,J,PSBIEN,PSBDIV,PSBOWD,PSBWD,PSBRT,PSBREP1,PSBREPT,PSBWARD,PSBPSBCTWD,PSBPSBCTWDN,PSBDD,PSBNUR,PSBLN,PSBNL,PSBN,PSBNWD,PSBNWARD,PSBDV,DIC,DIR,PSBSTOP
K PSBLOC1,PSBLOC2,PSBNLOC,PSBNLOCC,PSBNUT,PSBNUTN,PSBWIEN,POP,PSBCTNLOC,PSBCTNNLOC,PSBF,PSBWD,PSBWDIEN,PSBWDNU,PSBONU,PSBNS,PSBDIV1,PSBDVV,PSBNUM,PSBPID,PSBREP
K PSBCNT,PSBCNTP,PSBCTNLOCP,PSBCTNNLOCP,DFN,PSBH,PSBORN,PSBCOM1,PSBNONEP
Q Q
PSBIHS1 ;KF/VAOIT PSB BCMA MOB ENTRY REPORT
+1 ;;1.0;PSB BCMA CPS FOXK;**1018**;;Build 27
ASKDN ;ASK NURSE OR DIVISION
+1 SET DIR(0)="SA^D:DIVISION;N:NURSING UNIT"
+2 SET DIR("A")="Run this report by (D):Division or (N):Nursing Unit: "
+3 DO ^DIR
IF X="^"!(X="")
DO STOP
QUIT
+4 SET PSBN=Y
+5 KILL DIR,Y,DIR("A"),DIR(0)
+6 IF PSBN="N"
DO ASKNUR
QUIT
+7 IF PSBN="D"
DO ASK1
QUIT
+8 QUIT
ASKNUR ;NURSE LOCATION
+1 SET DIC(0)="AEMQMZ"
SET DIC="^NURSF(211.4,"
DO ^DIC
IF X="^"!(X="")
DO STOP
QUIT
IF Y'>0
QUIT
+2 SET PSBNL=$PIECE(Y,"^",1)
+3 IF $PIECE($GET(^NURSF(211.4,PSBNL,1)),"^",1)'="A"
WRITE !,"You selePSBCTed a 'INAPSBCTIVE' Nurse Unit Please try again! "
HANG 2
DO ASKNUR
QUIT
+4 DO ST2
+5 QUIT
ASK1 ;GET DIVS.
+1 SET Y=$$SITE^VASITE
+2 SET PSBDV=$PIECE(Y,"^",1)
SET PSBDVV(PSBDV)=""
ST2 ;START AND END DATES
+1 SET %DT("A")="Enter a Start Date: "
+2 SET %DT="AE"
+3 DO ^%DT
IF X="^"!(X="")
DO STOP
QUIT
+4 SET PSBBDATE=Y
KILL %DT,Y
+5 IF PSBBDATE<3030801
Begin DoDot:1
+6 SET Y=PSBBDATE
DO DD^%DT
WRITE !,"You entered "_Y_" Start Date must be After 'August 1, 2003"
DO ST2
QUIT
End DoDot:1
QUIT
+7 KILL %DT,Y
END KILL X
+1 SET %DT("A")="Enter a End Date: "
SET PSBEDATE=""
+2 SET %DT="AE"
+3 DO ^%DT
SET PSBEDATE=Y
KILL %DT,Y
+4 IF X=""!(X="^")
DO STOP
QUIT
+5 SET X1=PSBEDATE
SET X2=1
DO C^%DTC
SET PSBEDATE=X
KILL X1,X2
+6 IF PSBEDATE<PSBBDATE
WRITE !,"End Date must be after the start !"
DO END
QUIT
+7 WRITE !,"Print order details CPRS Med Order Button Yes/No?: "
+8 SET %=1
DO YN^DICN
IF X=""!(X="^")
DO STOP
QUIT
+9 ;DEFAULT NO
SET PSBREP=0
+10 IF %=1
Begin DoDot:1
+11 SET PSBREP1=1
+12 WRITE !,"Would you like to include comments Yes/No?: "
+13 SET %=1
DO YN^DICN
IF X=""!(X="^")
DO STOP
QUIT
+14 IF %=1
SET PSBCOM1=1
+15 IF %=2
SET PSBCOM1=0
End DoDot:1
+16 ;.S %=1
+17 SET PSBLN=1
+18 IF %=2
SET PSBREP1=0
SET PSBLN=0
+19 IF '$DATA(PSBN)
SET PSBN=""
+20 IF '$DATA(PSBNL)
SET PSBNL=""
+21 IF '$DATA(PSBDV)
SET PSBDV=""
+22 IF '$DATA(PSBVISN)
SET PSBVISN=""
+23 DO TAS
+24 QUIT
NTASK ;NIGHT TASK
+1 SET X1=DT
SET X2=-1
DO C^%DTC
SET PSBBDATE=X
KILL X1,X2
+2 SET PSBREP1=1
SET X1=DT
SET X2=1
DO C^%DTC
SET PSBEDATE=X
KILL X1,X2
+3 SET PSBLN=1
SET PSBN="D"
+4 SET Y=$$SITE^VASITE
+5 SET PSBCOM1=0
+6 SET PSBDV=$PIECE(Y,"^",1)
SET PSBDVV(PSBDV)=""
+7 IF '$DATA(PSBN)
SET PSBN=""
+8 IF '$DATA(PSBNL)
SET PSBNL=""
+9 IF '$DATA(PSBDV)
SET PSBDV=""
+10 IF '$DATA(PSBVISN)
SET PSBVISN=""
+11 USE IO
+12 DO NEW
+13 QUIT
TAS ;TASK IT OR NOT
+1 SET %ZIS="Q"
+2 WRITE !
DO ^%ZIS
KILL %ZIS
+3 IF POP
Begin DoDot:1
+4 WRITE $CHAR(7)
+5 KILL VISN,PSBEDATE,PSBBDATE,PSBDV
End DoDot:1
QUIT
+6 ; output not queued...
+7 IF '$DATA(IO("Q"))
Begin DoDot:1
+8 DO WAIT^DICD
USE IO
DO NEW
+9 IF IO'=IO(0)
DO ^%ZISC
End DoDot:1
+10 ; set up the Task...
+11 IF $DATA(IO("Q"))
Begin DoDot:1
+12 NEW ZTDESC,ZTSAVE,ZTIO,ZTRTN
+13 SET ZTRTN="NEW^PSBIHS1"
+14 SET ZTDESC="PSB MOB ENTRY REPORT "
+15 SET ZTSAVE("PSBBDATE")=""
+16 SET ZTSAVE("PSBEDATE")=""
+17 SET ZTSAVE("PSBVISN")=""
+18 SET ZTSAVE("PSBDV")=""
+19 SET ZTSAVE("PSBREP1")=""
+20 SET ZTSAVE("PSBLN")=""
+21 SET ZTSAVE("PSBN")=""
+22 SET ZTSAVE("PSBNL")=""
+23 SET ZTSAVE("PSBDV*")=""
+24 SET ZTSAVE("PSBCOM1")=""
+25 SET ZTIO=ION
+26 DO ^%ZTLOAD
+27 DO HOME^%ZIS
+28 WRITE !,$SELECT($GET(ZTSK):"Task number "_ZTSK_" queued.",1:"ERROR -- NOT QUEUED!")
+29 KILL IO("Q"),ZTSK
End DoDot:1
+30 QUIT
NEW ;ALL PRNS
+1 KILL ^TMP($JOB),PSBNONEP
+2 SET PSBCNT=0
SET PSBNONE=0
SET PSBCNTP=0
SET PSBNONEP=0
NUR ;BLUID ARRAY BY NURS LOCATION
+1 IF PSBN="N"
Begin DoDot:1
+2 SET PSBNWARD=0
FOR
SET PSBNWARD=$ORDER(^NURSF(211.4,PSBNL,3,PSBNWARD))
IF PSBNWARD=""
QUIT
Begin DoDot:2
+3 SET PSBNWD=$PIECE($GET(^NURSF(211.4,PSBNL,3,PSBNWARD,0)),"^",1)
+4 SET PSBNWD($PIECE($GET(^DIC(42,PSBNWD,0)),"^",1))=""
End DoDot:2
End DoDot:1
DIV1 ;BLGD ARRAY FOR WARDS IN THE DIV SELEPSBCTED
+1 IF PSBN="D"
Begin DoDot:1
+2 KILL ^TMP($JOB,"DIV")
+3 SET PSBIEN=0
FOR
SET PSBIEN=$ORDER(^DIC(42,PSBIEN))
IF PSBIEN'>0
QUIT
SET PSBDIV=$PIECE($GET(^DIC(42,PSBIEN,0)),U,11)
IF +PSBDIV
SET ^TMP($JOB,"DIV",PSBDIV,PSBIEN)=""
+4 SET PSBNUM=""
FOR
SET PSBNUM=$ORDER(PSBDVV(PSBNUM))
IF PSBNUM=""
QUIT
Begin DoDot:2
+5 KILL %,DIC,D,X,Y
+6 SET DIC="^DG(40.8,"
SET D="AD"
SET X=PSBNUM
SET DIC(0)="XN"
+7 DO IX^DIC
IF +Y'>0
QUIT
+8 SET PSBDIV1=+Y
+9 KILL DIC,D,X,Y
+10 ;GET WARDS IN MED CENTER DIVION
+11 SET PSBWIEN=""
FOR
SET PSBWIEN=$ORDER(^TMP($JOB,"DIV",PSBDIV1,PSBWIEN))
IF PSBWIEN=""
QUIT
SET PSBNWD($PIECE($GET(^DIC(42,PSBWIEN,0)),"^",1))=""
End DoDot:2
End DoDot:1
+12 ;DONE WITH DIV USE TMP AGAIN
KILL ^TMP($JOB)
STS ;LOOK IN MED FILE FOR DATA...
+1 NEW PSBPSBCTWD,PSBPSBCTWDN,PSBCT,PSBCTN,PSBCTNNLOC,PSBCTNLOC,PSBBC2,PSBLEN,PSBLEN1
+2 SET PSBDFN=""
FOR
SET PSBDFN=$ORDER(^PSB(53.79,"AEDT",PSBDFN))
IF PSBDFN'>0
QUIT
Begin DoDot:1
+3 SET PSBDATE=PSBBDATE
FOR
SET PSBDATE=$ORDER(^PSB(53.79,"AEDT",PSBDFN,PSBDATE))
IF PSBDATE'>0!(PSBDATE>PSBEDATE)
QUIT
Begin DoDot:2
+4 SET PSBIEN=""
FOR
SET PSBIEN=$ORDER(^PSB(53.79,"AEDT",PSBDFN,PSBDATE,PSBIEN))
IF PSBIEN'>0
QUIT
Begin DoDot:3
+5 ;CHECK PSBDIV FIRST
+6 SET PSBDIV=$PIECE($GET(^PSB(53.79,PSBIEN,0)),"^",3)
+7 IF PSBDIV=""
QUIT
+8 SET PSBLOC1=$PIECE($GET(^PSB(53.79,PSBIEN,0)),"^",2)
+9 SET PSBSTOP=0
+10 SET PSBLOC3=""
FOR
SET PSBLOC3=$ORDER(PSBNWD(PSBLOC3))
IF PSBLOC3=""!(PSBSTOP=1)
QUIT
Begin DoDot:4
+11 IF PSBLOC1[PSBLOC3
SET PSBLEN=$LENGTH(PSBLOC3)
SET PSBLEN1=$EXTRACT(PSBLOC1,1,PSBLEN)
IF PSBLOC3=PSBLEN1
SET PSBSTOP=1
SET PSBLOC=PSBLOC3
End DoDot:4
+12 IF PSBSTOP=0
QUIT
+13 IF '$DATA(PSBPSBCTWD(PSBLOC))
SET PSBPSBCTWD(PSBLOC)=0
+14 IF '$DATA(PSBPSBCTWDN(PSBLOC))
SET PSBPSBCTWDN(PSBLOC)=0
+15 IF '$DATA(PSBCT(PSBDIV))
SET PSBCT(PSBDIV)=0
+16 IF '$DATA(PSBCTN(PSBDIV))
SET PSBCTN(PSBDIV)=0
+17 SET PSBWIEN=$ORDER(^DIC(42,"B",PSBLOC,""))
SET PSBWDNU=""
+18 SET PSBNLOCC=""
FOR
SET PSBNLOCC=$ORDER(^NURSF(211.4,"C",PSBWIEN,PSBNLOCC))
IF PSBNLOCC=""
QUIT
Begin DoDot:4
+19 IF $PIECE($GET(^NURSF(211.4,PSBNLOCC,1)),"^",1)="A"
SET PSBWDNU=$PIECE($GET(^SC($PIECE($GET(^NURSF(211.4,PSBNLOCC,0)),"^",1),0)),"^",1)
SET PSBNLOC=PSBNLOCC
End DoDot:4
+20 IF '$DATA(PSBCTNLOC(PSBNLOC))
SET PSBCTNLOC(PSBNLOC)=0
+21 IF '$DATA(PSBCTNNLOC(PSBNLOC))
SET PSBCTNNLOC(PSBNLOC)=0
+22 IF '$DATA(PSBCTNLOCP(PSBNLOC))
SET PSBCTNLOCP(PSBNLOC)=0
+23 IF '$DATA(PSBCTNNLOCP(PSBNLOC))
SET PSBCTNNLOCP(PSBNLOC)=0
+24 SET PSBBC2=0
+25 SET PSBCNT=PSBCNT+1
SET PSBCT(PSBDIV)=PSBCT(PSBDIV)+1
SET PSBPSBCTWD(PSBLOC)=PSBPSBCTWD(PSBLOC)+1
SET PSBCTNLOC(PSBNLOC)=PSBCTNLOC(PSBNLOC)+1
+26 FOR PSBH=1:1:$PIECE($GET(^PSB(53.79,PSBIEN,.3,0)),"^",4)
Begin DoDot:4
+27 IF $GET(^PSB(53.79,PSBIEN,.3,PSBH,0))["BCMA/CPRS Interface Entry"
SET PSBBC2=1
SET PSBNONE=PSBNONE+1
SET PSBCTN(PSBDIV)=PSBCTN(PSBDIV)+1
SET PSBCTNNLOC(PSBNLOC)=PSBCTNNLOC(PSBNLOC)+1
SET PSBPSBCTWDN(PSBLOC)=PSBPSBCTWDN(PSBLOC)+1
+28 IF PSBBC2=1
Begin DoDot:5
+29 SET PSBNAME=$PIECE($GET(^DPT($PIECE($GET(^PSB(53.79,PSBIEN,0)),"^",1),0)),"^",1)
+30 IF PSBWDNU=""
SET PSBWDNU="NO 'N.U.' FOR WARD"
+31 SET ^TMP($JOB,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME,PSBIEN)=$GET(^PSB(53.79,PSBIEN,0))
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
REP ;DISPLAY DATA
+1 WRITE @IOF
+2 WRITE !,?15,"BCMA/EHR Med Order Button From "
SET Y=PSBBDATE
DO DD^%DT
WRITE Y_" TO "
SET X1=PSBEDATE
SET X2=-1
DO C^%DTC
SET Y=X
DO DD^%DT
SET PSBREPT=Y
WRITE PSBREPT
+3 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSBRT=Y
WRITE !,?65,"Run Date/Time:"_PSBRT
+4 IF PSBN="D"
Begin DoDot:1
+5 ;?65,"% GUI Entered"
WRITE !,?5,"SITE",?25,"TOTAL Med Logs",?45,"BCMA/CPRS Med Order Button Entry"
+6 WRITE !
FOR J=1:1:IOM
WRITE "-"
+7 IF PSBCNT=0
WRITE !,"NONE FOUND"
QUIT
+8 SET PSBDIV=""
FOR J=0:0
SET PSBDIV=$ORDER(PSBCT(PSBDIV))
IF PSBDIV=""
QUIT
Begin DoDot:2
+9 WRITE !,$PIECE($GET(^DIC(4,PSBDIV,0)),"^",1)
+10 SET PSBDT=$GET(PSBCT(PSBDIV))
SET PSBDTN=$GET(PSBCTN(PSBDIV))
SET PSBDD=PSBDT-PSBDTN
+11 IF PSBDT>0
SET PSBDPER=(PSBDD/PSBDT)*100
+12 IF PSBDT=0
SET PSBDPER=0
+13 ;?76,$E(PSBDPER,1,6)_"%"
WRITE ?30,PSBDT,?50,PSBDTN
End DoDot:2
+14 WRITE !
FOR J=1:1:IOM
WRITE "-"
+15 SET PSBDD=PSBCNT-PSBNONE
SET PSBTPER=(PSBDD/PSBCNT)*100
+16 ;,?76,$E(PSBTPER,1,6)_"%"
WRITE !,"TOTALS",?30,PSBCNT,?50,PSBNONE
+17 ;WARD TOTALS
+18 ;,?70,"% GUI Entered"
WRITE !!!,?5,"WARD",?25,"TOTAL Med Logs",?45,"BCMA/CPRS Med Order Button Entry"
+19 WRITE !
FOR J=1:1:IOM
WRITE "-"
+20 IF PSBCNT=0
WRITE !,"NONE FOUND"
QUIT
+21 SET PSBWARD=""
FOR J=0:0
SET PSBWARD=$ORDER(PSBPSBCTWD(PSBWARD))
IF PSBWARD=""
QUIT
Begin DoDot:2
+22 WRITE !,PSBWARD
+23 SET PSBDT=$GET(PSBPSBCTWD(PSBWARD))
SET PSBDTN=$GET(PSBPSBCTWDN(PSBWARD))
SET PSBDD=PSBDT-PSBDTN
+24 IF PSBDT>0
SET PSBDPER=(PSBDD/PSBDT)*100
+25 IF PSBDT=0
SET PSBDPER=0
+26 ;?76,$E(PSBDPER,1,6)_"%"
WRITE ?30,PSBDT,?50,PSBDTN
End DoDot:2
+27 WRITE !
FOR J=1:1:IOM
WRITE "-"
End DoDot:1
+28 ;Nursing Unit
+29 IF PSBN="N"
Begin DoDot:1
+30 WRITE !!,"By Nursing Unit"
+31 ;,?70,"% GUI Entered"
WRITE !!!,?5,"Nurse Unit",?25,"TOTAL Med Logs",?45,"BCMA/CPRS Med Order Button Entry"
+32 WRITE !
FOR J=1:1:IOM
WRITE "-"
+33 IF PSBCNT=0
WRITE !,"NONE FOUND"
QUIT
+34 SET PSBNUT=""
FOR
SET PSBNUT=$ORDER(PSBCTNLOC(PSBNUT))
IF PSBNUT=""
QUIT
Begin DoDot:2
+35 SET PSBNUT1=PSBNUT
+36 SET PSBNUTN=$PIECE($GET(^NURSF(211.4,PSBNUT,0)),"^",1)
SET PSBNUTN=$PIECE($GET(^SC(PSBNUTN,0)),"^",1)
WRITE !,PSBNUTN
+37 SET PSBDT=$GET(PSBCTNLOC(PSBNUT))
SET PSBDTN=$GET(PSBCTNNLOC(PSBNUT))
SET PSBDD=PSBDT-PSBDTN
+38 IF PSBDT>0
SET PSBDPER=(PSBDD/PSBDT)*100
+39 IF PSBDT=0
SET PSBDPER=0
+40 ;,?76,$E(PSBDPER,1,6)_"%"
WRITE ?30,PSBDT,?50,PSBDTN
End DoDot:2
+41 SET PSBNUTN=$PIECE($GET(^NURSF(211.4,PSBNUT1,0)),"^",1)
SET PSBNUTN=$PIECE($GET(^SC(PSBNUTN,0)),"^",1)
WRITE !,PSBNUTN
+42 SET PSBDT=$GET(PSBCTNLOCP(PSBNUT1))
SET PSBDTN=$GET(PSBCTNNLOCP(PSBNUT1))
SET PSBDD=PSBDT-PSBDTN
+43 IF PSBDT>0
SET PSBDPER=(PSBDD/PSBDT)*100
+44 IF PSBDT=0
SET PSBDPER=0
+45 ;,?76,$E(PSBDPER,1,6)_"%"
WRITE ?30,PSBDT,?50,PSBDTN
+46 WRITE !
FOR J=1:1:IOM
WRITE "-"
+47 IF PSBCNT=0
WRITE !,"NONE FOUND"
QUIT
+48 SET PSBDD=PSBCNT-PSBNONE
SET PSBTPER=(PSBDD/PSBCNT)*100
+49 ;,?76,$E(PSBTPER,1,6)_"%",!
WRITE !,"Report Totals",?30,PSBCNT,?50,PSBNONE
+50 IF PSBDT=0
SET PSBDPER=0
End DoDot:1
+51 IF PSBREP1=1
DO REP1
+52 DO STOP
+53 QUIT
HEAD WRITE @IOF
+1 WRITE !,?15,"BCMA/CPRS Interface Entry in BCMA From "
SET Y=PSBBDATE
DO DD^%DT
WRITE Y_" TO "
WRITE PSBREPT
+2 WRITE !,"Nurse Unit: "_PSBWDNU,?65,"Run Date/Time: "_PSBRT
+3 IF PSBLN=0
WRITE !,"NAME",?30,"HRN",?45,"DATE/TIME"
+4 IF PSBLN=1
WRITE !,"NAME",?30,"HRN",?45,"DATE/TIME",?65,"ADMIN BY"
+5 WRITE !
FOR J=1:1:IOM
WRITE "-"
+6 KILL %
+7 QUIT
REP1 SET PSBWDNU=0
+1 SET PSBDIV=""
FOR J=0:0
SET PSBDIV=$ORDER(^TMP($JOB,"PRN",PSBDIV))
IF PSBDIV=""
QUIT
Begin DoDot:1
+2 SET PSBWDNU=""
FOR J=0:0
SET PSBWDNU=$ORDER(^TMP($JOB,"PRN",PSBDIV,PSBWDNU))
IF PSBWDNU=""
QUIT
Begin DoDot:2
+3 IF '$DATA(PSBONU)
SET PSBONU=PSBWDNU
DO HEAD
+4 IF PSBWDNU'=PSBONU
DO HEAD
+5 SET PSBLOC=""
FOR J=0:0
SET PSBLOC=$ORDER(^TMP($JOB,"PRN",PSBDIV,PSBWDNU,PSBLOC))
IF PSBLOC=""
QUIT
Begin DoDot:3
+6 FOR PSBNAME=""
FOR J=0:0
SET PSBNAME=$ORDER(^TMP($JOB,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME))
IF PSBNAME=""
QUIT
Begin DoDot:4
+7 SET PSBIEN=""
FOR J=1:1
SET PSBIEN=$ORDER(^TMP($JOB,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME,PSBIEN))
IF PSBIEN=""
QUIT
Begin DoDot:5
+8 IF $Y>(IOSL-4)
DO HEAD
+9 SET DFN=$PIECE($GET(^TMP($JOB,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME,PSBIEN)),"^",1)
+10 DO DEM^VADPT
DO PID^VADPT
+11 SET PSBPID=$SELECT(DUZ("AG")="I":(VA("PID")),1:$EXTRACT(VA("PID"),$LENGTH(VA("PID"))-3,999))
+12 SET Y=$PIECE($GET(^TMP($JOB,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME,PSBIEN)),"^",6)
DO DD^%DT
SET PSBMT=Y
+13 SET PSBDRUG=$PIECE($GET(^PS(50.7,$PIECE($GET(^TMP($JOB,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME,PSBIEN)),"^",8),0)),"^",1)
SET PSBDRUG=$EXTRACT(PSBDRUG,1,35)
+14 SET PSBNUR=$PIECE($GET(^TMP($JOB,"PRN",PSBDIV,PSBWDNU,PSBLOC,PSBNAME,PSBIEN)),"^",7)
SET PSBNUR=$PIECE($GET(^VA(200,PSBNUR,0)),"^",1)
SET PSBNUR=$EXTRACT(PSBNUR,1,32)
+15 IF PSBLN=0
WRITE !,PSBNAME,?30,PSBPID,?40,PSBMT
+16 IF PSBLN=1
WRITE !,PSBNAME,?30,PSBPID,?40,PSBMT,?63,PSBNUR,!,?15,"Medication: ",PSBDRUG,?50,"Dosage: ",$PIECE($GET(^PSB(53.79,PSBIEN,.1)),"^",5)
+17 ;PRINT IEN FROM 100
DO ORNUM
+18 IF $DATA(^PSB(53.79,PSBIEN,.6,0))
Begin DoDot:6
+19 WRITE !,?15,"Additives:"
+20 FOR J=1:1:$PIECE(^PSB(53.79,PSBIEN,.6,0),"^",4)
WRITE !,?27,$PIECE(^PSB(53.79,PSBIEN,.6,J,0),"^",2)," ",$PIECE(^PSB(53.79,PSBIEN,.6,J,0),"^",3)
End DoDot:6
+21 IF $DATA(^PSB(53.79,PSBIEN,.7,0))
Begin DoDot:6
+22 WRITE !,?15,"Solutions:"
+23 FOR J=1:1:$PIECE(^PSB(53.79,PSBIEN,.7,0),"^",4)
WRITE !,?27,$PIECE(^PSB(53.79,PSBIEN,.7,J,0),"^",2)," ",$PIECE(^PSB(53.79,PSBIEN,.7,J,0),"^",3)
End DoDot:6
+24 IF PSBCOM1=1
DO COM
+25 WRITE !
End DoDot:5
End DoDot:4
End DoDot:3
+26 SET PSBONU=PSBWDNU
End DoDot:2
End DoDot:1
+27 DO STOP
QUIT
COM ;LOOPS FOR COMMENTS HELD
+1 NEW PSBNUM,PSBCOMB,PSBCOMT,PSBCOM
+2 WRITE !,?15,"Comments:---------------------------------------------------------"
+3 SET PSBNUM=0
FOR
SET PSBNUM=$ORDER(^PSB(53.79,PSBIEN,.3,PSBNUM))
IF PSBNUM'>0
QUIT
Begin DoDot:1
+4 SET PSBCOM=$PIECE($GET(^PSB(53.79,PSBIEN,.3,PSBNUM,0)),"^",1)
+5 SET PSBCOMB=$PIECE($GET(^PSB(53.79,PSBIEN,.3,PSBNUM,0)),"^",2)
SET PSBCOMB=$PIECE($GET(^VA(200,PSBCOMB,0)),"^",2)
+6 SET Y=$PIECE($GET(^PSB(53.79,PSBIEN,.3,PSBNUM,0)),"^",3)
DO DD^%DT
SET PSBCOMT=Y
+7 WRITE !,?25,PSBCOMT_" "_PSBCOMB
+8 WRITE !,?25,PSBCOM
End DoDot:1
+9 WRITE !,?25,"---------------------------------------------------------"
+10 QUIT
ORNUM ;GET CPRS ORDER NUMBER
+1 SET PSBORN=$PIECE($GET(^PSB(53.79,PSBIEN,.1)),"^",1)
+2 IF PSBORN["U"
SET PSBORN=$PIECE($GET(^PS(55,DFN,5,+PSBORN,0)),"^",21)
+3 IF PSBORN["V"
SET PSBORN=$PIECE($GET(^PS(55,DFN,"IV",+PSBORN,0)),"^",21)
+4 WRITE !,?15,"EHR Order Number: ",PSBORN
+5 QUIT
STOP ;
+1 KILL PSBDATE,PSBDFN,PSBDPER,PSBDT,PSBDTN,PSBEDATE,PSBBDATE,PSBLOC,PSBNAME,PSBSSN,PSBMT,PSBLOC3,PSBNUT1
+2 KILL PSBDRUG,PSBNONE,PSBVISN,PSBTPER,J,PSBIEN,PSBDIV,PSBOWD,PSBWD,PSBRT,PSBREP1,PSBREPT,PSBWARD,PSBPSBCTWD,PSBPSBCTWDN,PSBDD,PSBNUR,PSBLN,PSBNL,PSBN,PSBNWD,PSBNWARD,PSBDV,DIC,DIR,PSBSTOP
+3 KILL PSBLOC1,PSBLOC2,PSBNLOC,PSBNLOCC,PSBNUT,PSBNUTN,PSBWIEN,POP,PSBCTNLOC,PSBCTNNLOC,PSBF,PSBWD,PSBWDIEN,PSBWDNU,PSBONU,PSBNS,PSBDIV1,PSBDVV,PSBNUM,PSBPID,PSBREP
+4 KILL PSBCNT,PSBCNTP,PSBCTNLOCP,PSBCTNNLOCP,DFN,PSBH,PSBORN,PSBCOM1,PSBNONEP
Q QUIT
