PSIVLTR1 ;BIR/PR-PRINT LABEL TRACKER BY PATIENT ;2 NOV 92 / 9:34 AM
;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA 2191.
;
;The following parameters are needed
;DFN - Patient
;ON -Order number
;
DATA(DFN,ON) ;Get the information
N PSJBLN,PSJD1,X,DA,DR,DIQ,DIC,PSJD2
K PSJDNE S PSIVSCR=$E(IOST)="C",COU=0 D H I '$D(^PS(55,DFN,"IV",ON,"LAB")) W !,"No label log to report.",!
F L=0:0 S L=$O(^PS(55,DFN,"IV",ON,"LAB",L)) Q:'L!$D(PSJDNE) S COU=COU+1 I $D(^(L,0)) D 1
Q:'$D(^PS(55,DFN,"IV",ON,"LAB"))
D PAUSE,H2 S PSJBLN=0
F S PSJBLN=$O(^PS(55,DFN,"IVBCMA",PSJBLN)) Q:PSJBLN="" D
. K DA,DR,DIQ,DIC,PSJD2
. S DIC="^PS(55,"_DFN_",""IVBCMA"",",DA=PSJBLN,DR=".01;.02;1;2;3;4;5",DIQ="PSJD2",DIQ(0)="IE" D EN^DIQ1
. Q:$G(PSJD2(55.0105,PSJBLN,.02,"I"))'=ON
. I PSIVSCR,($Y#IOSL)>23 D PAUSE,H2
. W $$ENDTC1^PSGMI($G(PSJD2(55.0105,PSJBLN,4,"I"))),?18,$G(PSJD2(55.0105,PSJBLN,.01,"I")) I $X>39 W !
. W ?40,$G(PSJD2(55.0105,PSJBLN,5,"E"))
. S X=$G(PSJD2(55.0105,PSJBLN,3,"I")) W ?50,$S(X:"YES",1:"NO"),?56,$G(PSJD2(55.0105,PSJBLN,2,"E"))
. I $G(PSJD2(55.0105,PSJBLN,1,"I"))]"" W ?66,$$ENDTC1^PSGMI($G(PSJD2(55.0105,PSJBLN,1,"I")))
. W !
;
K ;
K NUMLAB,TRA,CD,DATE
Q
;
1 ;Get num labels, track, daily usage
;naked reference refers to ^PS(55,DFN,"IV",ON,"LAB",L,0)
S N=^(0),Y=$P(N,U,2) X ^DD("DD") S DATE=Y,USER=$P(N,U,4),OG=$P(N,U,3),OG=$S(OG=1:"DISPENSED",OG=2:"RECYCLED",OG=3:"DESTROYED",OG=4:"CANCELLED",1:"SUSPENDED")
S NUMLAB=$P(N,U,5) S:$P(N,U,3)=1!($P(N,U,3)=5) TRA=$P(N,U,6),TRA=$S(TRA=1:"INDIVIDUAL",TRA=2:"SCHEDULED",TRA=3:"SUSPENSE",1:"ORDER ACTION") S CD=$S($P(N,U,7):"YES",1:"NO") D P
Q
P ;Print out info
W !,COU,?3,DATE,!,?18,OG,?32,$E($P(^VA(200,USER,0),U),1,15),?50,NUMLAB W:$P(N,U,3)=1!($P(N,U,3)=5) ?60,TRA W:$P(N,U,3)=1 ?77,CD D:$P(N,U,3)'=1&($P(N,U,8)'="") ERROR W ! I ($Y#IOSL)>23,PSIVSCR D PAUSE
K NUMLAB,TRA,CD,DATE,USEROG
Q
;
PAUSE ;
N DIR S DIR(0)="E" D ^DIR S:$D(DTOUT)!($D(DUOUT)) PSJDNE=1
Q
H ;Header
W !!,"LABEL LOG:",!!,"#",?3,"DATE/TIME",?18,"ACTION",?32,"USER",?47,"#LABELS",?60,"TRACK",?75,"COUNT",! F I=1:1:80 W "=" W:I=80 !
Q
H2 ;Header for Unique ID #s
W !!,"Unique IDs for this order:",!!
W "Label Date/Time",?18,"Unique ID",?40,"Status",?50,"Count",?56,"BCMA Action - Date/Time",!!
Q
ERROR ;
W !!?40,"Bag(s) DISPENSED in IV Room: ",$P(^PS(59.5,$P($P(N,U,8)," "),0),U)
W !?40,"Bag(s) ",OG_" in IV Room: ",$P(^PS(59.5,$P($P(N,U,8)," ",2),0),U)
Q
PSIVLTR1 ;BIR/PR-PRINT LABEL TRACKER BY PATIENT ;2 NOV 92 / 9:34 AM
+1 ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191.
+4 ;
+5 ;The following parameters are needed
+6 ;DFN - Patient
+7 ;ON -Order number
+8 ;
DATA(DFN,ON) ;Get the information
+1 NEW PSJBLN,PSJD1,X,DA,DR,DIQ,DIC,PSJD2
+2 KILL PSJDNE
SET PSIVSCR=$EXTRACT(IOST)="C"
SET COU=0
DO H
IF '$DATA(^PS(55,DFN,"IV",ON,"LAB"))
WRITE !,"No label log to report.",!
+3 FOR L=0:0
SET L=$ORDER(^PS(55,DFN,"IV",ON,"LAB",L))
IF 'L!$DATA(PSJDNE)
QUIT
SET COU=COU+1
IF $DATA(^(L,0))
DO 1
+4 IF '$DATA(^PS(55,DFN,"IV",ON,"LAB"))
QUIT
+5 DO PAUSE
DO H2
SET PSJBLN=0
+6 FOR
SET PSJBLN=$ORDER(^PS(55,DFN,"IVBCMA",PSJBLN))
IF PSJBLN=""
QUIT
Begin DoDot:1
+7 KILL DA,DR,DIQ,DIC,PSJD2
+8 SET DIC="^PS(55,"_DFN_",""IVBCMA"","
SET DA=PSJBLN
SET DR=".01;.02;1;2;3;4;5"
SET DIQ="PSJD2"
SET DIQ(0)="IE"
DO EN^DIQ1
+9 IF $GET(PSJD2(55.0105,PSJBLN,.02,"I"))'=ON
QUIT
+10 IF PSIVSCR
IF ($Y#IOSL)>23
DO PAUSE
DO H2
+11 WRITE $$ENDTC1^PSGMI($GET(PSJD2(55.0105,PSJBLN,4,"I"))),?18,$GET(PSJD2(55.0105,PSJBLN,.01,"I"))
IF $X>39
WRITE !
+12 WRITE ?40,$GET(PSJD2(55.0105,PSJBLN,5,"E"))
+13 SET X=$GET(PSJD2(55.0105,PSJBLN,3,"I"))
WRITE ?50,$SELECT(X:"YES",1:"NO"),?56,$GET(PSJD2(55.0105,PSJBLN,2,"E"))
+14 IF $GET(PSJD2(55.0105,PSJBLN,1,"I"))]""
WRITE ?66,$$ENDTC1^PSGMI($GET(PSJD2(55.0105,PSJBLN,1,"I")))
+15 WRITE !
End DoDot:1
+16 ;
K ;
+1 KILL NUMLAB,TRA,CD,DATE
+2 QUIT
+3 ;
1 ;Get num labels, track, daily usage
+1 ;naked reference refers to ^PS(55,DFN,"IV",ON,"LAB",L,0)
+2 SET N=^(0)
SET Y=$PIECE(N,U,2)
XECUTE ^DD("DD")
SET DATE=Y
SET USER=$PIECE(N,U,4)
SET OG=$PIECE(N,U,3)
SET OG=$SELECT(OG=1:"DISPENSED",OG=2:"RECYCLED",OG=3:"DESTROYED",OG=4:"CANCELLED",1:"SUSPENDED")
+3 SET NUMLAB=$PIECE(N,U,5)
IF $PIECE(N,U,3)=1!($PIECE(N,U,3)=5)
SET TRA=$PIECE(N,U,6)
SET TRA=$SELECT(TRA=1:"INDIVIDUAL",TRA=2:"SCHEDULED",TRA=3:"SUSPENSE",1:"ORDER ACTION")
SET CD=$SELECT($PIECE(N,U,7):"YES",1:"NO")
DO P
+4 QUIT
P ;Print out info
+1 WRITE !,COU,?3,DATE,!,?18,OG,?32,$EXTRACT($PIECE(^VA(200,USER,0),U),1,15),?50,NUMLAB
IF $PIECE(N,U,3)=1!($PIECE(N,U,3)=5)
WRITE ?60,TRA
IF $PIECE(N,U,3)=1
WRITE ?77,CD
IF $PIECE(N,U,3)'=1&($PIECE(N,U,8)'="")
DO ERROR
WRITE !
IF ($Y#IOSL)>23
IF PSIVSCR
DO PAUSE
+2 KILL NUMLAB,TRA,CD,DATE,USEROG
+3 QUIT
+4 ;
PAUSE ;
+1 NEW DIR
SET DIR(0)="E"
DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET PSJDNE=1
+2 QUIT
H ;Header
+1 WRITE !!,"LABEL LOG:",!!,"#",?3,"DATE/TIME",?18,"ACTION",?32,"USER",?47,"#LABELS",?60,"TRACK",?75,"COUNT",!
FOR I=1:1:80
WRITE "="
IF I=80
WRITE !
+2 QUIT
H2 ;Header for Unique ID #s
+1 WRITE !!,"Unique IDs for this order:",!!
+2 WRITE "Label Date/Time",?18,"Unique ID",?40,"Status",?50,"Count",?56,"BCMA Action - Date/Time",!!
+3 QUIT
ERROR ;
+1 WRITE !!?40,"Bag(s) DISPENSED in IV Room: ",$PIECE(^PS(59.5,$PIECE($PIECE(N,U,8)," "),0),U)
+2 WRITE !?40,"Bag(s) ",OG_" in IV Room: ",$PIECE(^PS(59.5,$PIECE($PIECE(N,U,8)," ",2),0),U)
+3 QUIT
