PSBIHS4 ;KF/VAOIT BCMA Meds Admin date range ;MAR 2014
;;1.0;PSB BCMA CPS FOXK;**1018**;;Build 27
;Per VHA Directive 2004-038, this routine should not be modified.
; Reference/I
S DIC="^DPT(",DIC(0)="AEMQMZ" D ^DIC Q:Y'>0
Q:'+Y
S PSBDFN=$P(Y,"^",1)
K DIC,DIC(0),X,Y
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 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 I X=""!(X="^") D STOP Q
S PSBEDATE=Y K %DT,Y
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 !,"Include Order Details" S %=2 D YN^DICN S PSBORDET=% I %=-1 G STOP
W !,"NDC Daily Summary" S %=1 D YN^DICN S PSBRTNDC=% I %=-1 G STOP
I PSBORDET=2&(PSBRTNDC=2) W !,"Eixting now nothing selected to print" G STOP
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
.S ZTRTN="NEW^PSBIHS4"
.S ZTDESC="PSB Meds Admin by Date Range"
.S ZTSAVE("PSBBDATE")="",ZTSAVE("PSBEDATE")="",ZTSAVE("PSBDFN")="",ZTSAVE("PSBORDET")="",ZTSAVE("PSBRTNDC")=""
.S ZTIO=ION
.D ^%ZTLOAD,HOME^%ZIS
.W !,$S($G(ZTSK):"Task number "_ZTSK_" queued.",1:"ERROR -- NOT QUEUED!")
.K IO("Q"),ZTSK,ZTIO,ZTSAVE,ZTRTN,ZTDESC
Q
NEW ;Collect data
N PG,PSBNAME,PSBDOB,PSBIEN,PSBSTATUS,PSBLASTACT,PSBOITEM,PSBDSIEN,PSBDATE,PSBNDC,PSBOIEN,PSBDRUG,DFN,PSBDATEE,PSBPID,PSBDU,PSBDIEN ;HEAD,HEAD1
;GET PT DEM
S DFN=PSBDFN
D DEM^VADPT,PID^VADPT
S PSBPID=$S(DUZ("AG")="I":(VA("PID")),1:$E(VA("PID"),$L(VA("PID"))-3,999)),PSBNAME=VADM(1),PSBDOB=$P(VADM(3),U,2)
K VA,VADM
D NOW^%DTC S Y=% D DD^%DT S PSBNOW=Y
S HEAD="W @IOF S:'$D(PG) PG=0 S PG=PG+1 W !,""Medications Administrated in BCMA "" S Y=PSBBDATE D DD^%DT W Y_"" Through "" S Y=PSBEDATE D DD^%DT W Y,"" Run Date: ""_PSBNOW,?100,"" Page "",PG"
S HEAD1="W !,PSBNAME,"" HRN: "",PSBPID,"" DOB: "",PSBDOB"
;X HEAD,HEAD1
K ^TMP($J,"BCMA")
S PSBDATE=PSBBDATE F S PSBDATE=$O(^PSB(53.79,"AADT",PSBDFN,PSBDATE)) Q:PSBDATE'>0 I PSBDATE>PSBBDATE&(PSBDATE<PSBEDATE) D
.S PSBIEN="" F S PSBIEN=$O(^PSB(53.79,"AADT",PSBDFN,PSBDATE,PSBIEN)) Q:PSBIEN'>0 D
..S PSBSTATUS=$P($G(^PSB(53.79,PSBIEN,0)),U,9)
..S PSBLASTACT=$P($G(^PSB(53.79,PSBIEN,0)),U,6) ;GET LAST ACTION DT, THE XFER HAS MULTPE ACTION DT FOR SAME IEN, BY DESIGN FOR SOME REASON.
..; NO HELD, REFUSED, NOT GIVEN, MISSING ON THE REPORT
..Q:PSBSTATUS="H"!(PSBSTATUS="N")!(PSBSTATUS="R")!(PSBSTATUS="M")
..S PSBOITEM=$P($G(^PSB(53.79,PSBIEN,0)),U,8)
..S ^TMP($J,"BCMA",PSBLASTACT,PSBIEN)=PSBOITEM
..F J=1:1:$P($G(^PSB(53.79,PSBIEN,.5,0)),U,4) D
...S PSBDSIEN=$P($G(^PSB(53.79,PSBIEN,.5,J,0)),U,1),^TMP($J,"BCMA","OI",PSBLASTACT,PSBIEN,PSBDSIEN)=$P($G(^PSB(53.79,PSBIEN,.5,J,0)),U,3)_U_$P($G(^PSB(53.79,PSBIEN,.5,J,0)),U,4)
...;COUNT DAILY PER NDC UD
...S PSBDNDC=$P($G(^PSDRUG(PSBDSIEN,2)),U,4) I PSBDNDC="" S PSBDNDC="NO NDC"
...I '$D(^TMP($J,"BCMA1",$P(PSBDATE,".",1),"NDC1",$P($G(^PSDRUG(PSBDSIEN,0)),U,1),PSBDSIEN,PSBDNDC)) S ^TMP($J,"BCMA1",$P(PSBDATE,".",1),"NDC1",$P($G(^PSDRUG(PSBDSIEN,0)),U,1),PSBDSIEN,PSBDNDC)=0
...S ^TMP($J,"BCMA1",$P(PSBDATE,".",1),"NDC1",$P($G(^PSDRUG(PSBDSIEN,0)),U,1),PSBDSIEN,PSBDNDC)=^TMP($J,"BCMA1",$P(PSBDATE,".",1),"NDC1",$P($G(^PSDRUG(PSBDSIEN,0)),U,1),PSBDSIEN,PSBDNDC)+1
..;COUNT NDC PER DAY IV ADD
..I $D(^PSB(53.79,PSBIEN,.6,0)) F J=1:1:$P(^PSB(53.79,PSBIEN,.6,0),"^",4) D
...S ^TMP($J,"BCMA","ADD",PSBIEN,PSBLASTACT,$P(^PSB(53.79,PSBIEN,.6,J,0),U,1))=$P(^PSB(53.79,PSBIEN,.6,J,0),"^",3)
...;COUNT NDC PER DAY UD
...S PSBOIEN=$P(^PSB(53.79,PSBIEN,.6,J,0),U,1),PSBDIEN=$P($G(^PS(52.6,PSBOIEN,0)),U,2),PSBDNDC=$P($G(^PSDRUG(PSBDIEN,2)),U,4) I PSBDNDC="" S PSBDNDC="NO NDC"
...I '$D(^TMP($J,"BCMA1",$P(PSBDATE,".",1),"NDCA",$P($G(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)) S ^TMP($J,"BCMA1",$P(PSBDATE,".",1),"NDCA",$P($G(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)=0
...S ^TMP($J,"BCMA1",$P(PSBDATE,".",1),"NDCA",$P($G(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)=^TMP($J,"BCMA1",$P(PSBDATE,".",1),"NDCA",$P($G(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)+1
..;COUNT NDC PER DAY IV SOL
..I $D(^PSB(53.79,PSBIEN,.7,0)) F J=1:1:$P(^PSB(53.79,PSBIEN,.7,0),"^",4) D
...S ^TMP($J,"BCMA","SOL",PSBIEN,PSBLASTACT,$P(^PSB(53.79,PSBIEN,.7,J,0),U,1))=$P(^PSB(53.79,PSBIEN,.7,J,0),"^",3)
...S PSBOIEN=$P(^PSB(53.79,PSBIEN,.7,J,0),U,1),PSBDIEN=$P($G(^PS(52.7,PSBOIEN,0)),U,2),PSBDNDC=$P($G(^PSDRUG(PSBDIEN,2)),U,4) I PSBDNDC="" S PSBDNDC="NO NDC"
...I '$D(^TMP($J,"BCMA1",$P(PSBDATE,".",1),"NDCS",$P($G(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)) S ^TMP($J,"BCMA1",$P(PSBDATE,".",1),"NDCS",$P($G(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)=0
...S ^TMP($J,"BCMA1",$P(PSBDATE,".",1),"NDCS",$P($G(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)=^TMP($J,"BCMA1",$P(PSBDATE,".",1),"NDCS",$P($G(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)+1
I '$D(^TMP($J,"BCMA")) D
.X HEAD,HEAD1 W ! F J=1:1:IOM W "-"
.W !,"Nothing to Report"
I $D(^TMP($J,"BCMA")) D
.D:PSBRTNDC=1 SUMNDC
.D:PSBORDET=1 DETPRT
D STOP
Q
;LOOP DATA and Print
DETPRT ; PRINT ORDER DETAILS
X HEAD,HEAD1 W !,"Action Date/Time",?30,"Medication Given",! F J=1:1:IOM W "-"
S PSBDATE="" F S PSBDATE=$O(^TMP($J,"BCMA",PSBDATE)) Q:'+PSBDATE D
.S PSBIEN="" F S PSBIEN=$O(^TMP($J,"BCMA",PSBDATE,PSBIEN)) Q:'+PSBIEN D
..S Y=PSBDATE D DD^%DT S PSBDATEE=Y
..S PSBOIEN=$G(^TMP($J,"BCMA",PSBDATE,PSBIEN)),PSBDIEN=$O(^PSDRUG("ASP",PSBOIEN,"")),PSBNDC=$P($G(^PSDRUG(PSBDIEN,2)),U,4)
..I $Y>(IOSL-2) X HEAD,HEAD1 W !,"Action Date/Time",?30,"Medication Given",! F J=1:1:IOM W "-"
..W !,Y,?23,"Pharmacy Orderable Item: ",$E($P($G(^PS(50.7,PSBOIEN,0)),"^",1),1,35)_$S($P($G(^PSB(53.79,PSBIEN,.1)),"^",5)'="":" Dose Ordered:"_$P($G(^PSB(53.79,PSBIEN,.1)),"^",5),1:"")
..S PSBDSIEN="" F S PSBDSIEN=$O(^TMP($J,"BCMA","OI",PSBDATE,PSBIEN,PSBDSIEN)) Q:$G(PSBDSIEN)="" D
...S PSBDU=$P($G(^TMP($J,"BCMA","OI",PSBDATE,PSBIEN,PSBDSIEN)),U,2)
...W !,?5,$P($G(^PSDRUG(PSBDSIEN,0)),U,1)_" Dose Given: "_$P($G(^TMP($J,"BCMA","OI",PSBDATE,PSBIEN,PSBDSIEN)),U,1)_$S(PSBDU'["TAB"&(PSBDU'["CAP")&(PSBDU'["PATCH"):" Unit of Administration: "_PSBDU,1:"")_" NDC: "_$P($G(^PSDRUG(PSBDSIEN,2)),U,4)
..I $D(^TMP($J,"BCMA","ADD",PSBIEN,PSBDATE)) D
...W !,?5,"Additives: " S PSBOIEN="" S PSBOIEN=$O(^TMP($J,"BCMA","ADD",PSBIEN,PSBDATE,PSBOIEN)) Q:'+PSBOIEN D
....S PSBDIEN=$P($G(^PS(52.6,PSBOIEN,0)),U,2),PSBNDC=$P($G(^PSDRUG(PSBDIEN,2)),U,4) I PSBNDC="" S PSBNDC="NO NDC"
....W !,?10,$P($G(^PS(52.6,PSBOIEN,0)),U,1)," Dose: ",$G(^TMP($J,"BCMA","ADD",PSBIEN,PSBDATE,PSBOIEN))," NDC: ",PSBNDC
..I $D(^TMP($J,"BCMA","SOL",PSBIEN,PSBDATE)) D
...W !,?5,"Solutions: " S PSBOIEN="" S PSBOIEN=$O(^TMP($J,"BCMA","SOL",PSBIEN,PSBDATE,PSBOIEN)) Q:'+PSBOIEN D
....S PSBDIEN=$P($G(^PS(52.7,PSBOIEN,0)),U,2),PSBNDC=$P($G(^PSDRUG(PSBDIEN,2)),U,4) I PSBNDC="" S PSBNDC="NO NDC"
....W !,?10,$P($G(^PS(52.7,PSBOIEN,0)),U,1)," Dose: ",$G(^TMP($J,"BCMA","SOL",PSBIEN,PSBDATE,PSBOIEN))," NDC: ",PSBNDC
..W !,"Location: "_$$GET1^DIQ(53.79,PSBIEN,.02),! ;SPACE BETWEEN MED LOGS
Q
SUMNDC ; DAILY SUMMARY
K PSBCNT S PSBCNT=0
N PSBLDT,PSBTYP,PSBDNAME,PSBDIEN,PSBNDC,PSBIEN,HEAD2
S HEAD2="W !,""Medication "",?55,""NDC"",?80,""Number Medications Given"",! F J=1:1:IOM W ""-"""
X HEAD,HEAD1,HEAD2
S PSBDT=0 F S PSBDT=$O(^TMP($J,"BCMA1",PSBDT)) Q:PSBDT'>0 D
.I $G(PSBLDT)=""!(PSBDT'=$G(PSBLDT)) S Y=PSBDT D DD^%DT W !,Y
.S PSBTYP="" F S PSBTYP=$O(^TMP($J,"BCMA1",PSBDT,PSBTYP)) Q:PSBTYP="" D
..W !,$S(PSBTYP="NDC1":"Unit Dose:",PSBTYP="NDCA":"Additives:",PSBTYP="NDCS":"Solutions:",1:"")
..S PSBDNAME="" F S PSBDNAME=$O(^TMP($J,"BCMA1",PSBDT,PSBTYP,PSBDNAME)) Q:PSBDNAME="" D
...S PSBDIEN=0 F S PSBDIEN=$O(^TMP($J,"BCMA1",PSBDT,PSBTYP,PSBDNAME,PSBDIEN)) Q:PSBDIEN'>0 D
....S PSBNDC="" F S PSBNDC=$O(^TMP($J,"BCMA1",PSBDT,PSBTYP,PSBDNAME,PSBDIEN,PSBNDC)) Q:PSBNDC="" D
.....I $Y>(IOSL-2) X HEAD,HEAD1,HEAD2 S Y=PSBDT D DD^%DT W !,Y,!,$S(PSBTYP="NDC1":"Unit Dose:",PSBTYP="NDCA":"Additives:",PSBTYP="NDCS":"Solutions:",1:"")
.....S PSBLDT=PSBDT W !,PSBDNAME,?55,PSBNDC,?80,$G(^TMP($J,"BCMA1",PSBDT,PSBTYP,PSBDNAME,PSBDIEN,PSBNDC))
.....;DAILY CNT
.....I '$D(PSBCNT(PSBDT)) S PSBCNT(PSBDT)=0
.....S PSBCNT(PSBDT)=PSBCNT(PSBDT)+$G(^TMP($J,"BCMA1",PSBDT,PSBTYP,PSBDNAME,PSBDIEN,PSBNDC))
.....S PSBCNT=PSBCNT+$G(^TMP($J,"BCMA1",PSBDT,PSBTYP,PSBDNAME,PSBDIEN,PSBNDC))
.W ! F J=1:1:IOM W "-"
.W !,?55,"Daily Totals: ",?80,$G(PSBCNT(PSBDT))
W !,?55,"Report Totals: ",?80,PSBCNT
Q
STOP ;FINAL CLEAN UP
K ^TMP($J,"BCMA"),^TMP($J,"BCMA1"),PSBDFN,PSBEDATE,PSBBDATE,J,JJ,POP,HEAD,HEAD1,PSBNOW,PSBCNT,PSBORDET,PSBRTNDC,PSBDT,PSBDNDC
Q
PSBIHS4 ;KF/VAOIT BCMA Meds Admin date range ;MAR 2014
+1 ;;1.0;PSB BCMA CPS FOXK;**1018**;;Build 27
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ; Reference/I
+4 SET DIC="^DPT("
SET DIC(0)="AEMQMZ"
DO ^DIC
IF Y'>0
QUIT
+5 IF '+Y
QUIT
+6 SET PSBDFN=$PIECE(Y,"^",1)
+7 KILL DIC,DIC(0),X,Y
ST2 ;START AND END DATES
+1 SET %DT("A")="Enter a Start Date: "
+2 SET %DT="AE"
DO ^%DT
IF X="^"!(X="")
DO STOP
QUIT
+3 SET PSBBDATE=Y
KILL %DT,Y
+4 IF PSBBDATE<3030801
SET Y=PSBBDATE
DO DD^%DT
WRITE !,"You entered "_Y_" Start Date must be After 'August 1, 2003"
DO ST2
QUIT
+5 KILL %DT,Y
END KILL X
+1 SET %DT("A")="Enter a End Date: "
SET PSBEDATE=""
+2 SET %DT="AE"
DO ^%DT
IF X=""!(X="^")
DO STOP
QUIT
+3 SET PSBEDATE=Y
KILL %DT,Y
+4 SET X1=PSBEDATE
SET X2=1
DO C^%DTC
SET PSBEDATE=X
KILL X1,X2
+5 IF PSBEDATE<PSBBDATE
WRITE !,"End Date must be after the start !"
DO END
QUIT
+6 WRITE !,"Include Order Details"
SET %=2
DO YN^DICN
SET PSBORDET=%
IF %=-1
GOTO STOP
+7 WRITE !,"NDC Daily Summary"
SET %=1
DO YN^DICN
SET PSBRTNDC=%
IF %=-1
GOTO STOP
+8 IF PSBORDET=2&(PSBRTNDC=2)
WRITE !,"Eixting now nothing selected to print"
GOTO STOP
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 SET ZTRTN="NEW^PSBIHS4"
+13 SET ZTDESC="PSB Meds Admin by Date Range"
+14 SET ZTSAVE("PSBBDATE")=""
SET ZTSAVE("PSBEDATE")=""
SET ZTSAVE("PSBDFN")=""
SET ZTSAVE("PSBORDET")=""
SET ZTSAVE("PSBRTNDC")=""
+15 SET ZTIO=ION
+16 DO ^%ZTLOAD
DO HOME^%ZIS
+17 WRITE !,$SELECT($GET(ZTSK):"Task number "_ZTSK_" queued.",1:"ERROR -- NOT QUEUED!")
+18 KILL IO("Q"),ZTSK,ZTIO,ZTSAVE,ZTRTN,ZTDESC
End DoDot:1
+19 QUIT
NEW ;Collect data
+1 ;HEAD,HEAD1
NEW PG,PSBNAME,PSBDOB,PSBIEN,PSBSTATUS,PSBLASTACT,PSBOITEM,PSBDSIEN,PSBDATE,PSBNDC,PSBOIEN,PSBDRUG,DFN,PSBDATEE,PSBPID,PSBDU,PSBDIEN
+2 ;GET PT DEM
+3 SET DFN=PSBDFN
+4 DO DEM^VADPT
DO PID^VADPT
+5 SET PSBPID=$SELECT(DUZ("AG")="I":(VA("PID")),1:$EXTRACT(VA("PID"),$LENGTH(VA("PID"))-3,999))
SET PSBNAME=VADM(1)
SET PSBDOB=$PIECE(VADM(3),U,2)
+6 KILL VA,VADM
+7 DO NOW^%DTC
SET Y=%
DO DD^%DT
SET PSBNOW=Y
+8 SET HEAD="W @IOF S:'$D(PG) PG=0 S PG=PG+1 W !,""Medications Administrated in BCMA "" S Y=PSBBDATE D DD^%DT W Y_"" Through "" S Y=PSBEDATE D DD^%DT W Y,"" Run Date: ""_PSBNOW,?100,"" Page "",PG"
+9 SET HEAD1="W !,PSBNAME,"" HRN: "",PSBPID,"" DOB: "",PSBDOB"
+10 ;X HEAD,HEAD1
+11 KILL ^TMP($JOB,"BCMA")
+12 SET PSBDATE=PSBBDATE
FOR
SET PSBDATE=$ORDER(^PSB(53.79,"AADT",PSBDFN,PSBDATE))
IF PSBDATE'>0
QUIT
IF PSBDATE>PSBBDATE&(PSBDATE<PSBEDATE)
Begin DoDot:1
+13 SET PSBIEN=""
FOR
SET PSBIEN=$ORDER(^PSB(53.79,"AADT",PSBDFN,PSBDATE,PSBIEN))
IF PSBIEN'>0
QUIT
Begin DoDot:2
+14 SET PSBSTATUS=$PIECE($GET(^PSB(53.79,PSBIEN,0)),U,9)
+15 ;GET LAST ACTION DT, THE XFER HAS MULTPE ACTION DT FOR SAME IEN, BY DESIGN FOR SOME REASON.
SET PSBLASTACT=$PIECE($GET(^PSB(53.79,PSBIEN,0)),U,6)
+16 ; NO HELD, REFUSED, NOT GIVEN, MISSING ON THE REPORT
+17 IF PSBSTATUS="H"!(PSBSTATUS="N")!(PSBSTATUS="R")!(PSBSTATUS="M")
QUIT
+18 SET PSBOITEM=$PIECE($GET(^PSB(53.79,PSBIEN,0)),U,8)
+19 SET ^TMP($JOB,"BCMA",PSBLASTACT,PSBIEN)=PSBOITEM
+20 FOR J=1:1:$PIECE($GET(^PSB(53.79,PSBIEN,.5,0)),U,4)
Begin DoDot:3
+21 SET PSBDSIEN=$PIECE($GET(^PSB(53.79,PSBIEN,.5,J,0)),U,1)
SET ^TMP($JOB,"BCMA","OI",PSBLASTACT,PSBIEN,PSBDSIEN)=$PIECE($GET(^PSB(53.79,PSBIEN,.5,J,0)),U,3)_U_$PIECE($GET(^PSB(53.79,PSBIEN,.5,J,0)),U,4)
+22 ;COUNT DAILY PER NDC UD
+23 SET PSBDNDC=$PIECE($GET(^PSDRUG(PSBDSIEN,2)),U,4)
IF PSBDNDC=""
SET PSBDNDC="NO NDC"
+24 IF '$DATA(^TMP($JOB,"BCMA1",$PIECE(PSBDATE,".",1),"NDC1",$PIECE($GET(^PSDRUG(PSBDSIEN,0)),U,1),PSBDSIEN,PSBDNDC))
SET ^TMP($JOB,"BCMA1",$PIECE(PSBDATE,".",1),"NDC1",$PIECE($GET(^PSDRUG(PSBDSIEN,0)),U,1),PSBDSIEN,PSBDNDC)=0
+25 SET ^TMP($JOB,"BCMA1",$PIECE(PSBDATE,".",1),"NDC1",$PIECE($GET(^PSDRUG(PSBDSIEN,0)),U,1),PSBDSIEN,PSBDNDC)=^TMP($JOB,"BCMA1",$PIECE(PSBDATE,".",1),"NDC1",$PIECE($GET(^PSDRUG(PSBDSIEN,0)),U,1),PSBDSIEN,PSBDNDC)+1
End DoDot:3
+26 ;COUNT NDC PER DAY IV ADD
+27 IF $DATA(^PSB(53.79,PSBIEN,.6,0))
FOR J=1:1:$PIECE(^PSB(53.79,PSBIEN,.6,0),"^",4)
Begin DoDot:3
+28 SET ^TMP($JOB,"BCMA","ADD",PSBIEN,PSBLASTACT,$PIECE(^PSB(53.79,PSBIEN,.6,J,0),U,1))=$PIECE(^PSB(53.79,PSBIEN,.6,J,0),"^",3)
+29 ;COUNT NDC PER DAY UD
+30 SET PSBOIEN=$PIECE(^PSB(53.79,PSBIEN,.6,J,0),U,1)
SET PSBDIEN=$PIECE($GET(^PS(52.6,PSBOIEN,0)),U,2)
SET PSBDNDC=$PIECE($GET(^PSDRUG(PSBDIEN,2)),U,4)
IF PSBDNDC=""
SET PSBDNDC="NO NDC"
+31 IF '$DATA(^TMP($JOB,"BCMA1",$PIECE(PSBDATE,".",1),"NDCA",$PIECE($GET(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC))
SET ^TMP($JOB,"BCMA1",$PIECE(PSBDATE,".",1),"NDCA",$PIECE($GET(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)=0
+32 SET ^TMP($JOB,"BCMA1",$PIECE(PSBDATE,".",1),"NDCA",$PIECE($GET(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)=^TMP($JOB,"BCMA1",$PIECE(PSBDATE,".",1),"NDCA",$PIECE($GET(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)+1
End DoDot:3
+33 ;COUNT NDC PER DAY IV SOL
+34 IF $DATA(^PSB(53.79,PSBIEN,.7,0))
FOR J=1:1:$PIECE(^PSB(53.79,PSBIEN,.7,0),"^",4)
Begin DoDot:3
+35 SET ^TMP($JOB,"BCMA","SOL",PSBIEN,PSBLASTACT,$PIECE(^PSB(53.79,PSBIEN,.7,J,0),U,1))=$PIECE(^PSB(53.79,PSBIEN,.7,J,0),"^",3)
+36 SET PSBOIEN=$PIECE(^PSB(53.79,PSBIEN,.7,J,0),U,1)
SET PSBDIEN=$PIECE($GET(^PS(52.7,PSBOIEN,0)),U,2)
SET PSBDNDC=$PIECE($GET(^PSDRUG(PSBDIEN,2)),U,4)
IF PSBDNDC=""
SET PSBDNDC="NO NDC"
+37 IF '$DATA(^TMP($JOB,"BCMA1",$PIECE(PSBDATE,".",1),"NDCS",$PIECE($GET(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC))
SET ^TMP($JOB,"BCMA1",$PIECE(PSBDATE,".",1),"NDCS",$PIECE($GET(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)=0
+38 SET ^TMP($JOB,"BCMA1",$PIECE(PSBDATE,".",1),"NDCS",$PIECE($GET(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)=^TMP($JOB,"BCMA1",$PIECE(PSBDATE,".",1),"NDCS",$PIECE($GET(^PSDRUG(PSBDIEN,0)),U,1),PSBDIEN,PSBDNDC)+1
End DoDot:3
End DoDot:2
End DoDot:1
+39 IF '$DATA(^TMP($JOB,"BCMA"))
Begin DoDot:1
+40 XECUTE HEAD
XECUTE HEAD1
WRITE !
FOR J=1:1:IOM
WRITE "-"
+41 WRITE !,"Nothing to Report"
End DoDot:1
+42 IF $DATA(^TMP($JOB,"BCMA"))
Begin DoDot:1
+43 IF PSBRTNDC=1
DO SUMNDC
+44 IF PSBORDET=1
DO DETPRT
End DoDot:1
+45 DO STOP
+46 QUIT
+47 ;LOOP DATA and Print
DETPRT ; PRINT ORDER DETAILS
+1 XECUTE HEAD
XECUTE HEAD1
WRITE !,"Action Date/Time",?30,"Medication Given",!
FOR J=1:1:IOM
WRITE "-"
+2 SET PSBDATE=""
FOR
SET PSBDATE=$ORDER(^TMP($JOB,"BCMA",PSBDATE))
IF '+PSBDATE
QUIT
Begin DoDot:1
+3 SET PSBIEN=""
FOR
SET PSBIEN=$ORDER(^TMP($JOB,"BCMA",PSBDATE,PSBIEN))
IF '+PSBIEN
QUIT
Begin DoDot:2
+4 SET Y=PSBDATE
DO DD^%DT
SET PSBDATEE=Y
+5 SET PSBOIEN=$GET(^TMP($JOB,"BCMA",PSBDATE,PSBIEN))
SET PSBDIEN=$ORDER(^PSDRUG("ASP",PSBOIEN,""))
SET PSBNDC=$PIECE($GET(^PSDRUG(PSBDIEN,2)),U,4)
+6 IF $Y>(IOSL-2)
XECUTE HEAD
XECUTE HEAD1
WRITE !,"Action Date/Time",?30,"Medication Given",!
FOR J=1:1:IOM
WRITE "-"
+7 WRITE !,Y,?23,"Pharmacy Orderable Item: ",$EXTRACT($PIECE($GET(^PS(50.7,PSBOIEN,0)),"^",1),1,35)_$SELECT($PIECE($GET(^PSB(53.79,PSBIEN,.1)),"^",5)'="":" Dose Ordered:"_$PIECE($GET(^PSB(53.79,PSBIEN,.1)),"^",5),1:"")
+8 SET PSBDSIEN=""
FOR
SET PSBDSIEN=$ORDER(^TMP($JOB,"BCMA","OI",PSBDATE,PSBIEN,PSBDSIEN))
IF $GET(PSBDSIEN)=""
QUIT
Begin DoDot:3
+9 SET PSBDU=$PIECE($GET(^TMP($JOB,"BCMA","OI",PSBDATE,PSBIEN,PSBDSIEN)),U,2)
+10 WRITE !,?5,$PIECE($GET(^PSDRUG(PSBDSIEN,0)),U,1)_" Dose Given: "_$PIECE(...
... $GET(^TMP($JOB,"BCMA","OI",PSBDATE,PSBIEN,PSBDSIEN)),U,1)_$SELECT(PSBDU'["TAB"&(PSBDU'["CAP")&(PSBDU'["PATCH"):" Unit of Administration: "_PSBDU,1:"")_" NDC: "_$PIECE($GET(^PSDRUG(PSBDSIEN,2)),U,4)
End DoDot:3
+11 IF $DATA(^TMP($JOB,"BCMA","ADD",PSBIEN,PSBDATE))
Begin DoDot:3
+12 WRITE !,?5,"Additives: "
SET PSBOIEN=""
SET PSBOIEN=$ORDER(^TMP($JOB,"BCMA","ADD",PSBIEN,PSBDATE,PSBOIEN))
IF '+PSBOIEN
QUIT
Begin DoDot:4
+13 SET PSBDIEN=$PIECE($GET(^PS(52.6,PSBOIEN,0)),U,2)
SET PSBNDC=$PIECE($GET(^PSDRUG(PSBDIEN,2)),U,4)
IF PSBNDC=""
SET PSBNDC="NO NDC"
+14 WRITE !,?10,$PIECE($GET(^PS(52.6,PSBOIEN,0)),U,1)," Dose: ",$GET(^TMP($JOB,"BCMA","ADD",PSBIEN,PSBDATE,PSBOIEN))," NDC: ",PSBNDC
End DoDot:4
End DoDot:3
+15 IF $DATA(^TMP($JOB,"BCMA","SOL",PSBIEN,PSBDATE))
Begin DoDot:3
+16 WRITE !,?5,"Solutions: "
SET PSBOIEN=""
SET PSBOIEN=$ORDER(^TMP($JOB,"BCMA","SOL",PSBIEN,PSBDATE,PSBOIEN))
IF '+PSBOIEN
QUIT
Begin DoDot:4
+17 SET PSBDIEN=$PIECE($GET(^PS(52.7,PSBOIEN,0)),U,2)
SET PSBNDC=$PIECE($GET(^PSDRUG(PSBDIEN,2)),U,4)
IF PSBNDC=""
SET PSBNDC="NO NDC"
+18 WRITE !,?10,$PIECE($GET(^PS(52.7,PSBOIEN,0)),U,1)," Dose: ",$GET(^TMP($JOB,"BCMA","SOL",PSBIEN,PSBDATE,PSBOIEN))," NDC: ",PSBNDC
End DoDot:4
End DoDot:3
+19 ;SPACE BETWEEN MED LOGS
WRITE !,"Location: "_$$GET1^DIQ(53.79,PSBIEN,.02),!
End DoDot:2
End DoDot:1
+20 QUIT
SUMNDC ; DAILY SUMMARY
+1 KILL PSBCNT
SET PSBCNT=0
+2 NEW PSBLDT,PSBTYP,PSBDNAME,PSBDIEN,PSBNDC,PSBIEN,HEAD2
+3 SET HEAD2="W !,""Medication "",?55,""NDC"",?80,""Number Medications Given"",! F J=1:1:IOM W ""-"""
+4 XECUTE HEAD
XECUTE HEAD1
XECUTE HEAD2
+5 SET PSBDT=0
FOR
SET PSBDT=$ORDER(^TMP($JOB,"BCMA1",PSBDT))
IF PSBDT'>0
QUIT
Begin DoDot:1
+6 IF $GET(PSBLDT)=""!(PSBDT'=$GET(PSBLDT))
SET Y=PSBDT
DO DD^%DT
WRITE !,Y
+7 SET PSBTYP=""
FOR
SET PSBTYP=$ORDER(^TMP($JOB,"BCMA1",PSBDT,PSBTYP))
IF PSBTYP=""
QUIT
Begin DoDot:2
+8 WRITE !,$SELECT(PSBTYP="NDC1":"Unit Dose:",PSBTYP="NDCA":"Additives:",PSBTYP="NDCS":"Solutions:",1:"")
+9 SET PSBDNAME=""
FOR
SET PSBDNAME=$ORDER(^TMP($JOB,"BCMA1",PSBDT,PSBTYP,PSBDNAME))
IF PSBDNAME=""
QUIT
Begin DoDot:3
+10 SET PSBDIEN=0
FOR
SET PSBDIEN=$ORDER(^TMP($JOB,"BCMA1",PSBDT,PSBTYP,PSBDNAME,PSBDIEN))
IF PSBDIEN'>0
QUIT
Begin DoDot:4
+11 SET PSBNDC=""
FOR
SET PSBNDC=$ORDER(^TMP($JOB,"BCMA1",PSBDT,PSBTYP,PSBDNAME,PSBDIEN,PSBNDC))
IF PSBNDC=""
QUIT
Begin DoDot:5
+12 IF $Y>(IOSL-2)
XECUTE HEAD
XECUTE HEAD1
XECUTE HEAD2
SET Y=PSBDT
DO DD^%DT
WRITE !,Y,!,$SELECT(PSBTYP="NDC1":"Unit Dose:",PSBTYP="NDCA":"Additives:",PSBTYP="NDCS":"Solutions:",1:"")
+13 SET PSBLDT=PSBDT
WRITE !,PSBDNAME,?55,PSBNDC,?80,$GET(^TMP($JOB,"BCMA1",PSBDT,PSBTYP,PSBDNAME,PSBDIEN,PSBNDC))
+14 ;DAILY CNT
+15 IF '$DATA(PSBCNT(PSBDT))
SET PSBCNT(PSBDT)=0
+16 SET PSBCNT(PSBDT)=PSBCNT(PSBDT)+$GET(^TMP($JOB,"BCMA1",PSBDT,PSBTYP,PSBDNAME,PSBDIEN,PSBNDC))
+17 SET PSBCNT=PSBCNT+$GET(^TMP($JOB,"BCMA1",PSBDT,PSBTYP,PSBDNAME,PSBDIEN,PSBNDC))
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+18 WRITE !
FOR J=1:1:IOM
WRITE "-"
+19 WRITE !,?55,"Daily Totals: ",?80,$GET(PSBCNT(PSBDT))
End DoDot:1
+20 WRITE !,?55,"Report Totals: ",?80,PSBCNT
+21 QUIT
STOP ;FINAL CLEAN UP
+1 KILL ^TMP($JOB,"BCMA"),^TMP($JOB,"BCMA1"),PSBDFN,PSBEDATE,PSBBDATE,J,JJ,POP,HEAD,HEAD1,PSBNOW,PSBCNT,PSBORDET,PSBRTNDC,PSBDT,PSBDNDC
+2 QUIT
