PSBOMD ;BIRMINGHAM/EFC-MISSING DOSE REPORT ;8/30/21 07:48
;;3.0;BAR CODE MED ADMIN;**70,106,131**;Mar 2004;Build 11
;
; Reference/IA
; WARD^NURSUT5/3052
; IN5^VADPT/10061
; $$GET1^DIQ(52.6/436
; $$GET1^DIQ(52.7/437
;
;*70 - Allow a Clinc Order only version of this report.
;*106- add Hazardous Handle & Dispose flags
;*131- Renamed variables when looping through ^PSB(53.68 to remove potential looping error
;
EN ; Begin printing
N PSBSCHD,PSBWRD,PSBSTRT,PSBSTOP,PSBWARD,PSBDRUG,PSBDT,PSBIEN,PSBWRDA
N CLNMODE,PSBHZDG,PSBHAZ,ADDIEN,ASUB,SSUB ;*70,106,131
K ^TMP("PSB",$J)
S CLNMODE=$S($P(PSBRPT(.1),U)="C":1,1:0) ;clinic mode T/F *70
;Ward mode *70
D:'CLNMODE
.S PSBWRD=+$P(PSBRPT(.1),U,3)
.I PSBWRD D WARD^NURSUT5("L^"_PSBWRD,.PSBWRDA) S X="" F S X=$O(PSBWRDA(PSBWRD,2,X)) Q:X="" S Y=PSBWRDA(PSBWRD,2,X,.01),PSBWRD(+Y)=$P(Y,U,2),^TMP("PSB",$J,PSBWRD(+Y))=0
;Clinic mode *70
D:CLNMODE
.S PSBWRD=+$P(PSBRPT(4),U,3),PSBWRD(PSBWRD)=$P($G(^SC(PSBWRD,0)),U)
.Q:PSBWRD(PSBWRD)=""
.S ^TMP("PSB",$J,PSBWRD(PSBWRD))=0
;
S PSBSTRT=$P(PSBRPT(.1),U,6)+$P(PSBRPT(.1),U,7)
S PSBSTOP=$P(PSBRPT(.1),U,8)+$P(PSBRPT(.1),U,9)
S PSBDT=PSBSTRT-.0000001
F S PSBDT=$O(^PSB(53.68,"ADTE",PSBDT)) Q:'PSBDT!(PSBDT>PSBSTOP) D
.S PSBIEN=0
.F S PSBIEN=$O(^PSB(53.68,"ADTE",PSBDT,PSBIEN)) Q:'PSBIEN D
..;check ward or clinic for ALL or selection via by array *70
..I CLNMODE S PSBWARD=$$GET1^DIQ(53.68,PSBIEN_",",1) Q:PSBWARD=""
..I CLNMODE,PSBWRD,'$D(PSBWRD(+$P($G(^PSB(53.68,PSBIEN,1)),U))) Q
..I 'CLNMODE S PSBWARD=$$GET1^DIQ(53.68,PSBIEN_",",.12) Q:PSBWARD=""
..I 'CLNMODE,PSBWRD,'$D(PSBWRD(+$P($G(^PSB(53.68,PSBIEN,.1)),U,2))) Q
..;end check *70
..S PSBSCHD=$$GET1^DIQ(53.68,PSBIEN_",",.19) S:PSBSCHD="" PSBSCHD="NO DATA"
..S PSBDRUG=$$GET1^DIQ(53.68,PSBIEN_",",.13)
..I PSBDRUG'="" S PSBHZDG=$$GET1^DIQ(53.68,PSBIEN_",",.13,"I") D CHKHAZ
..I PSBDRUG="" D
...S PSBDRUG="NO DATA"
...I $D(^PSB(53.68,PSBIEN,.6)) S ASUB=0 F S ASUB=$O(^PSB(53.68,+PSBIEN,.6,ASUB)) Q:'ASUB D
....S PSBDRUG=$$GET1^DIQ(52.6,+^PSB(53.68,PSBIEN,.6,ASUB,0),.01)
....S ADDIEN=+^PSB(53.68,PSBIEN,.6,ASUB,0)
....S PSBHZDG=$P(^PS(52.6,ADDIEN,0),U,2)
....I $D(^PSB(53.68,PSBIEN,.7)) S SSUB=0 F S SSUB=$O(^PSB(53.68,+PSBIEN,.7,SSUB)) Q:'SSUB S PSBDRUG=PSBDRUG_" "_$$GET1^DIQ(52.7,+^PSB(53.68,+PSBIEN,.7,SSUB,0),.01)
....D CHKHAZ
..S ^TMP("PSB",$J,PSBWARD)=+$G(^TMP("PSB",$J,PSBWARD))+1
..S ^TMP("PSB",$J)=+$G(^TMP("PSB",$J))+1
W $$HDR()
I '$D(^TMP("PSB",$J)) W !!?5,"<<<NO MISSING DOSE REQUESTS FOR THIS TIME FRAME>>>" Q
;print ward report
S PSBWARD=""
F S PSBWARD=$O(^TMP("PSB",$J,PSBWARD)) Q:PSBWARD="" D
.W:$Y>(IOSL-10) $$HDR()
.W !,PSBWARD
.S (PSBDRUG,PSBSCHD,PSBHAZ)=""
.F S PSBDRUG=$O(^TMP("PSB",$J,PSBWARD,PSBDRUG)) Q:PSBDRUG="" D
..F S PSBSCHD=$O(^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD)) Q:PSBSCHD="" D
...F S PSBHAZ=$O(^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD,PSBHAZ)) Q:PSBHAZ="" D
....W:$Y>(IOSL-10) $$HDR()
....W ?32,PSBDRUG,?74,$J(+^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD,PSBHAZ),7)
....I ($P(PSBHAZ,"^")=1)!($P(PSBHAZ,"^",2)=1) W !
....I $P(PSBHAZ,"^")=1 W ?32,"<<HAZ Handle>> "
....I $P(PSBHAZ,"^",2)=1 W ?32,"<<HAZ Dispose>>"
....W !,?35,"Schedule: "_PSBSCHD,!
.W ?74,"--------"
.W !,?31,PSBWARD," Total: ",?74,$J(^TMP("PSB",$J,PSBWARD),7),!
W ?74,"========"
W !,?31,"Report Total: "
W ?73,$J(+$G(^TMP("PSB",$J)),8)
K ^TMP("PSB",$J)
Q
;
HDR() ;
I '$D(PSBRPT("DATE")) D NOW^%DTC S Y=+$E(%,1,12) D D^DIQ S PSBRPT("DATE")="Run Date: "_Y
S:'$D(PSBRPT("PAGE")) PSBRPT("PAGE")=1
W:$Y>1 @IOF
W !,$TR($J("",IOM)," ","="),!,"MISSING DOSE REPORT FROM "
S Y=PSBSTRT D D^DIQ W Y," thru "
S Y=PSBSTOP D D^DIQ W Y
W ?(IOM-$L(PSBRPT("DATE"))),PSBRPT("DATE"),!,$S(PSBWRD:"SELECTED",1:"ALL")
W:'CLNMODE " WARDS" ;*70
W:CLNMODE " CLINICS" ;*70
S X="Page: "_PSBRPT("PAGE")
W ?(IOM-$L(X)),X
S PSBRPT("PAGE")=PSBRPT("PAGE")+1
W !,$TR($J("",IOM)," ","="),!
W:CLNMODE "Clinic" W:'CLNMODE "Ward" ;*70
W ?32,"Medication",?77,"Total",!,$TR($J("",IOM)," ","-"),!
Q ""
;
POST ;
N DFN
S DFN=X D IN5^VADPT
S PSBDDSW=$P(VAIP(5),U,2)
S PSBDDSR=$P(VAIP(6),U,2)
Q
CHKHAZ ;
S PSBHAZ=$$HAZ^PSSUTIL(PSBHZDG)
S ^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD,PSBHAZ)=$G(^TMP("PSB",$J,PSBWARD,PSBDRUG,PSBSCHD,PSBHAZ))+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBOMD 4667 printed Oct 16, 2024@17:41:29 Page 2
PSBOMD ;BIRMINGHAM/EFC-MISSING DOSE REPORT ;8/30/21 07:48
+1 ;;3.0;BAR CODE MED ADMIN;**70,106,131**;Mar 2004;Build 11
+2 ;
+3 ; Reference/IA
+4 ; WARD^NURSUT5/3052
+5 ; IN5^VADPT/10061
+6 ; $$GET1^DIQ(52.6/436
+7 ; $$GET1^DIQ(52.7/437
+8 ;
+9 ;*70 - Allow a Clinc Order only version of this report.
+10 ;*106- add Hazardous Handle & Dispose flags
+11 ;*131- Renamed variables when looping through ^PSB(53.68 to remove potential looping error
+12 ;
EN ; Begin printing
+1 NEW PSBSCHD,PSBWRD,PSBSTRT,PSBSTOP,PSBWARD,PSBDRUG,PSBDT,PSBIEN,PSBWRDA
+2 ;*70,106,131
NEW CLNMODE,PSBHZDG,PSBHAZ,ADDIEN,ASUB,SSUB
+3 KILL ^TMP("PSB",$JOB)
+4 ;clinic mode T/F *70
SET CLNMODE=$SELECT($PIECE(PSBRPT(.1),U)="C":1,1:0)
+5 ;Ward mode *70
+6 if 'CLNMODE
Begin DoDot:1
+7 SET PSBWRD=+$PIECE(PSBRPT(.1),U,3)
+8 IF PSBWRD
DO WARD^NURSUT5("L^"_PSBWRD,.PSBWRDA)
SET X=""
FOR
SET X=$ORDER(PSBWRDA(PSBWRD,2,X))
if X=""
QUIT
SET Y=PSBWRDA(PSBWRD,2,X,.01)
SET PSBWRD(+Y)=$PIECE(Y,U,2)
SET ^TMP("PSB",$JOB,PSBWRD(+Y))=0
End DoDot:1
+9 ;Clinic mode *70
+10 if CLNMODE
Begin DoDot:1
+11 SET PSBWRD=+$PIECE(PSBRPT(4),U,3)
SET PSBWRD(PSBWRD)=$PIECE($GET(^SC(PSBWRD,0)),U)
+12 if PSBWRD(PSBWRD)=""
QUIT
+13 SET ^TMP("PSB",$JOB,PSBWRD(PSBWRD))=0
End DoDot:1
+14 ;
+15 SET PSBSTRT=$PIECE(PSBRPT(.1),U,6)+$PIECE(PSBRPT(.1),U,7)
+16 SET PSBSTOP=$PIECE(PSBRPT(.1),U,8)+$PIECE(PSBRPT(.1),U,9)
+17 SET PSBDT=PSBSTRT-.0000001
+18 FOR
SET PSBDT=$ORDER(^PSB(53.68,"ADTE",PSBDT))
if 'PSBDT!(PSBDT>PSBSTOP)
QUIT
Begin DoDot:1
+19 SET PSBIEN=0
+20 FOR
SET PSBIEN=$ORDER(^PSB(53.68,"ADTE",PSBDT,PSBIEN))
if 'PSBIEN
QUIT
Begin DoDot:2
+21 ;check ward or clinic for ALL or selection via by array *70
+22 IF CLNMODE
SET PSBWARD=$$GET1^DIQ(53.68,PSBIEN_",",1)
if PSBWARD=""
QUIT
+23 IF CLNMODE
IF PSBWRD
IF '$DATA(PSBWRD(+$PIECE($GET(^PSB(53.68,PSBIEN,1)),U)))
QUIT
+24 IF 'CLNMODE
SET PSBWARD=$$GET1^DIQ(53.68,PSBIEN_",",.12)
if PSBWARD=""
QUIT
+25 IF 'CLNMODE
IF PSBWRD
IF '$DATA(PSBWRD(+$PIECE($GET(^PSB(53.68,PSBIEN,.1)),U,2)))
QUIT
+26 ;end check *70
+27 SET PSBSCHD=$$GET1^DIQ(53.68,PSBIEN_",",.19)
if PSBSCHD=""
SET PSBSCHD="NO DATA"
+28 SET PSBDRUG=$$GET1^DIQ(53.68,PSBIEN_",",.13)
+29 IF PSBDRUG'=""
SET PSBHZDG=$$GET1^DIQ(53.68,PSBIEN_",",.13,"I")
DO CHKHAZ
+30 IF PSBDRUG=""
Begin DoDot:3
+31 SET PSBDRUG="NO DATA"
+32 IF $DATA(^PSB(53.68,PSBIEN,.6))
SET ASUB=0
FOR
SET ASUB=$ORDER(^PSB(53.68,+PSBIEN,.6,ASUB))
if 'ASUB
QUIT
Begin DoDot:4
+33 SET PSBDRUG=$$GET1^DIQ(52.6,+^PSB(53.68,PSBIEN,.6,ASUB,0),.01)
+34 SET ADDIEN=+^PSB(53.68,PSBIEN,.6,ASUB,0)
+35 SET PSBHZDG=$PIECE(^PS(52.6,ADDIEN,0),U,2)
+36 IF $DATA(^PSB(53.68,PSBIEN,.7))
SET SSUB=0
FOR
SET SSUB=$ORDER(^PSB(53.68,+PSBIEN,.7,SSUB))
if 'SSUB
QUIT
SET PSBDRUG=PSBDRUG_" "_$$GET1^DIQ(52.7,+^PSB(53.68,+PSBIEN,.7,SSUB,0),.01)
+37 DO CHKHAZ
End DoDot:4
End DoDot:3
+38 SET ^TMP("PSB",$JOB,PSBWARD)=+$GET(^TMP("PSB",$JOB,PSBWARD))+1
+39 SET ^TMP("PSB",$JOB)=+$GET(^TMP("PSB",$JOB))+1
End DoDot:2
End DoDot:1
+40 WRITE $$HDR()
+41 IF '$DATA(^TMP("PSB",$JOB))
WRITE !!?5,"<<<NO MISSING DOSE REQUESTS FOR THIS TIME FRAME>>>"
QUIT
+42 ;print ward report
+43 SET PSBWARD=""
+44 FOR
SET PSBWARD=$ORDER(^TMP("PSB",$JOB,PSBWARD))
if PSBWARD=""
QUIT
Begin DoDot:1
+45 if $Y>(IOSL-10)
WRITE $$HDR()
+46 WRITE !,PSBWARD
+47 SET (PSBDRUG,PSBSCHD,PSBHAZ)=""
+48 FOR
SET PSBDRUG=$ORDER(^TMP("PSB",$JOB,PSBWARD,PSBDRUG))
if PSBDRUG=""
QUIT
Begin DoDot:2
+49 FOR
SET PSBSCHD=$ORDER(^TMP("PSB",$JOB,PSBWARD,PSBDRUG,PSBSCHD))
if PSBSCHD=""
QUIT
Begin DoDot:3
+50 FOR
SET PSBHAZ=$ORDER(^TMP("PSB",$JOB,PSBWARD,PSBDRUG,PSBSCHD,PSBHAZ))
if PSBHAZ=""
QUIT
Begin DoDot:4
+51 if $Y>(IOSL-10)
WRITE $$HDR()
+52 WRITE ?32,PSBDRUG,?74,$JUSTIFY(+^TMP("PSB",$JOB,PSBWARD,PSBDRUG,PSBSCHD,PSBHAZ),7)
+53 IF ($PIECE(PSBHAZ,"^")=1)!($PIECE(PSBHAZ,"^",2)=1)
WRITE !
+54 IF $PIECE(PSBHAZ,"^")=1
WRITE ?32,"<<HAZ Handle>> "
+55 IF $PIECE(PSBHAZ,"^",2)=1
WRITE ?32,"<<HAZ Dispose>>"
+56 WRITE !,?35,"Schedule: "_PSBSCHD,!
End DoDot:4
End DoDot:3
End DoDot:2
+57 WRITE ?74,"--------"
+58 WRITE !,?31,PSBWARD," Total: ",?74,$JUSTIFY(^TMP("PSB",$JOB,PSBWARD),7),!
End DoDot:1
+59 WRITE ?74,"========"
+60 WRITE !,?31,"Report Total: "
+61 WRITE ?73,$JUSTIFY(+$GET(^TMP("PSB",$JOB)),8)
+62 KILL ^TMP("PSB",$JOB)
+63 QUIT
+64 ;
HDR() ;
+1 IF '$DATA(PSBRPT("DATE"))
DO NOW^%DTC
SET Y=+$EXTRACT(%,1,12)
DO D^DIQ
SET PSBRPT("DATE")="Run Date: "_Y
+2 if '$DATA(PSBRPT("PAGE"))
SET PSBRPT("PAGE")=1
+3 if $Y>1
WRITE @IOF
+4 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","="),!,"MISSING DOSE REPORT FROM "
+5 SET Y=PSBSTRT
DO D^DIQ
WRITE Y," thru "
+6 SET Y=PSBSTOP
DO D^DIQ
WRITE Y
+7 WRITE ?(IOM-$LENGTH(PSBRPT("DATE"))),PSBRPT("DATE"),!,$SELECT(PSBWRD:"SELECTED",1:"ALL")
+8 ;*70
if 'CLNMODE
WRITE " WARDS"
+9 ;*70
if CLNMODE
WRITE " CLINICS"
+10 SET X="Page: "_PSBRPT("PAGE")
+11 WRITE ?(IOM-$LENGTH(X)),X
+12 SET PSBRPT("PAGE")=PSBRPT("PAGE")+1
+13 WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","="),!
+14 ;*70
if CLNMODE
WRITE "Clinic"
if 'CLNMODE
WRITE "Ward"
+15 WRITE ?32,"Medication",?77,"Total",!,$TRANSLATE($JUSTIFY("",IOM)," ","-"),!
+16 QUIT ""
+17 ;
POST ;
+1 NEW DFN
+2 SET DFN=X
DO IN5^VADPT
+3 SET PSBDDSW=$PIECE(VAIP(5),U,2)
+4 SET PSBDDSR=$PIECE(VAIP(6),U,2)
+5 QUIT
CHKHAZ ;
+1 SET PSBHAZ=$$HAZ^PSSUTIL(PSBHZDG)
+2 SET ^TMP("PSB",$JOB,PSBWARD,PSBDRUG,PSBSCHD,PSBHAZ)=$GET(^TMP("PSB",$JOB,PSBWARD,PSBDRUG,PSBSCHD,PSBHAZ))+1
+3 QUIT
