- PSIVSUS ;BIR/PR-SUSPENSE LIST OPTIONS ;16 DEC 97 / 1:40 PM
- ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
- ;
- ; Reference to ^PS(55 is supported by DBIA 2191.
- ;
- CHK ;Entry for individual label suspense, check if labels may be suspended.
- K JJ D NOW^%DTC S PSIVNOW=% I "EDPHN"[$P(^PS(55,DFN,"IV",+ON,0),U,17) F JJ="DISCONTINUED,","EXPIRED,","NON-VERIFIED,","or ON HOLD" W:JJ["DISC" $C(7),$C(7),!!,"YOU MAY NOT SUSPEND LABELS FOR ORDERS:" W:JJ["DISC" ?$X+1,JJ W:JJ'["DISC" !?39,JJ
- ;
- ALSUS ;See if labels are already suspended.
- Q:$D(JJ) I $D(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON)) D C^PSIVORE2 W !!,"There are already ",SNM," ",$S(SNM>1:"LABELS",1:"LABEL")," suspended for this order." K SNM,DAT
- ;
- S1 ;Suspend labels.
- R !!,"Number of labels to suspend: ",X:DTIME Q:'$T!("^"[X) S:X["?" HELP="SUSL" D:X["?" ^PSIVHLP G:X["?" S1 K:+X'=X!(X>10)!(X<1)!(X?.E1"."1N.N) X W:'$D(X) $C(7),$C(7),"??" G:'$D(X) S1
- I $D(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVNOW)) W $C(7),!," ... NO labels suspended! Wait 15 seconds and try again." D NOW^%DTC S PSIVNOW=% G S1
- S ^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVNOW)=+X_"^^"_$P(^PS(55,DFN,"IV",+ON,0),U,16),$P(^(0),U,16)=$P(^PS(55,DFN,"IV",+ON,0),U,16)+X W " ..... ",+X," Label"_$S(+X>1:"s",1:"")_" suspended !" S ACTION=5,PSIVNOL=+X,TRACK=1 D ^PSIVLTR
- K PSIVNOW Q
- ;
- ENT ;Print labels from suspense
- D ^PSIVXU I $D(XQUIT) K XQUIT Q
- D EXPIR S X="T-1",%DT="T" D ^%DT S PSIVDEL=Y
- I PSIVPL'=ION S ZTDESC="PRINT LABELS FROM SUSPENSE (IV)",ZTRTN="DEQSUS^PSIVSUS" S (ZTSAVE("PSIVSN"),ZTSAVE("PSIVSITE"),ZTSAVE("PSIVDEL"),ZTSAVE("PSJSYSW0"),ZTSAVE("PSJSYSU"),ZTSAVE("PSJSYSP0"))="",ZTIO=PSIVPL D ^%ZTLOAD W:$D(ZTSK) !,"Queued." Q
- DEQSUS L +^PS(55,"PSIVSUS",PSIVSN):1 G:'$T Q D NOW^%DTC S Y=%,PSIVNW=Y,X="A" F I=0:0 S X=$O(^PS(55,"PSIVSUS",PSIVSN,X)) Q:X="" I $E(X,2,999)<PSIVDEL K ^PS(55,"PSIVSUS",PSIVSN,X)
- F DFN=0:0 S DFN=$O(^PS(55,"PSIVSUS",PSIVSN,DFN)) Q:'DFN D ENIV^PSJAC F ON=0:0 S ON=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON)) Q:'ON F SDT=0:0 S SDT=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT)) Q:'SDT D E2
- Q L -^PS(55,"PSIVSUS",PSIVSN) K JJ,PSCT,PSIVDT,PSIVTTM,TOTAL,I,ON,PSIVDOSE,P16,PSIVDEL,PSIVNW,NODE
- Q1 D ENIVKV^PSGSETU S:$D(ZTQUEUED) ZTREQ="@"
- Q
- E2 G:"PDH"[$P($G(^PS(55,DFN,"IV",+ON,0)),U,17) E3
- S PSIVWMFL=1 ;Var is use to store in PSIVID() ea ID prt on the label
- S PSIVNOL=+^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT),P16=$P(^(SDT),U,3),PSIVDOSE=$P(^(SDT),U,2),P(4)=$P(^PS(55,DFN,"IV",+ON,0),U,4),ACTION=1,TRACK=3 D ^PSIVLTR D ^PSIVHYPL:P(4)="H",^PSIVLABL:"APSC"[P(4)
- E3 S ^PS(55,"PSIVSUS",PSIVSN,"A"_+PSIVNW,DFN,+ON,SDT)=^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT) K ^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT)
- I $D(PSIVID) NEW X F X=0:0 S X=$O(PSIVID(X)) Q:'X D
- . S ^PS(55,"PSIVSUS",PSIVSN,"A"_+PSIVNW,DFN,+ON,SDT,X)=""
- K PSIVWMFL,PSIVID
- Q
- ;
- EN3 ;Will print a report of those labels on suspense
- D ^PSIVXU I $D(XQUIT) K XQUIT Q
- D EXPIR I PSIVPR'=ION R !!,"Send report to a printer" S %=2 D YN^DICN Q:%=-1 I %=0 S HELP="SUSRPT" D ^PSIVHLP1 G EN3
- I PSIVPR=ION!(%=2) D DEQEN3
- E S ZTIO=PSIVPR,(ZTSAVE("PSIVSN"),ZTSAVE("PSIVSITE"),ZTSAVE("PSJSYSW0"),ZTSAVE("PSJSYSU"),ZTSAVE("PSJSYSP0"))="",ZTDESC="SUSPENSE LIST (IV)",ZTRTN="DEQEN3^PSIVSUS" D ^%ZTLOAD
- K ON D ENIVKV^PSGSETU
- Q
- DEQEN3 K DONE,PSIVFND D HDR1
- F DFN=0:0 S DFN=$O(^PS(55,"PSIVSUS",PSIVSN,DFN)) Q:'DFN!$G(DONE) D ENIV^PSJAC F ON=0:0 S ON=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON)) Q:'ON!$G(DONE) D
- .D SETP F PSIVDT=0:0 S PSIVDT=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVDT)) Q:'PSIVDT!$G(DONE) D PRNT:"DPN"'[P(17)
- QEN3 W:'$D(PSIVFND) !,"No Data Found" W:'$D(PSIVPR)&($Y) @IOF K D,DFN,DONE,I,NODE,ON,P,PSIV,PSIVDT,PSIVFND,SDT,VAERR,Z D Q1
- Q
- PRNT D:$Y+8>IOSL HDR Q:$G(DONE) S Y=PSIVDT X ^DD("DD") S PSIVFND=1,NODE=+^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVDT)_"^"_$P(Y,"@")_" "_$P(Y,"@",2)
- D ENIV^PSJAC W !,VADM(1)," (",$S(VAIN(4):$P(VAIN(4),U,2),1:"Outpatient IV"),")",$J(+NODE_" label"_$S(+NODE>1:"s",1:"")_" "_$P(NODE,U,2),IOM-1-$X)
- W !,VA("BID")," [",ON,"]" S SSNF=1,PSIV=0 D ENP3^PSIVRNL Q
- HDR ;
- I $E(IOST,1,2)="C-" K DIR S DIR(0)="E" D ^DIR I $D(DUOUT)!$D(DTOUT) S DONE=1 Q
- HDR1 W:$Y @IOF W !!,"Suspense list for: " D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),!,"Patient name",?30,"Order",?IOM-11,"Suspended",! F X=1:1:IOM-1 W "-"
- Q
- SETP S Y=$S($D(^PS(55,DFN,"IV",+ON,0)):^(0),1:"") F X=1:1:23 S P(X)=$P(Y,U,X)
- Q
- EXPIR ;
- D NOW^%DTC
- F Y=0:0 S Y=$O(^PS(55,"PSIVSUS",PSIVSN,Y)) Q:'Y F ON=0:0 S ON=$O(^PS(55,"PSIVSUS",PSIVSN,Y,+ON)) Q:'ON S X=$S($D(^PS(55,Y,"IV",+ON,0)):^(0),1:"") I $P(X,U,2)'=$P(X,U,3),$P(X,U,3)'>%!("D"[$P(X,U,17)) K ^PS(55,"PSIVSUS",PSIVSN,Y,+ON)
- PSIVSUS ;BIR/PR-SUSPENSE LIST OPTIONS ;16 DEC 97 / 1:40 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**58**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA 2191.
- +4 ;
- CHK ;Entry for individual label suspense, check if labels may be suspended.
- +1 KILL JJ
- DO NOW^%DTC
- SET PSIVNOW=%
- IF "EDPHN"[$PIECE(^PS(55,DFN,"IV",+ON,0),U,17)
- FOR JJ="DISCONTINUED,","EXPIRED,","NON-VERIFIED,","or ON HOLD"
- IF JJ["DISC"
- WRITE $CHAR(7),$CHAR(7),!!,"YOU MAY NOT SUSPEND LABELS FOR ORDERS:"
- IF JJ["DISC"
- WRITE ?$X+1,JJ
- IF JJ'["DISC"
- WRITE !?39,JJ
- +2 ;
- ALSUS ;See if labels are already suspended.
- +1 IF $DATA(JJ)
- QUIT
- IF $DATA(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON))
- DO C^PSIVORE2
- WRITE !!,"There are already ",SNM," ",$SELECT(SNM>1:"LABELS",1:"LABEL")," suspended for this order."
- KILL SNM,DAT
- +2 ;
- S1 ;Suspend labels.
- +1 READ !!,"Number of labels to suspend: ",X:DTIME
- IF '$TEST!("^"[X)
- QUIT
- IF X["?"
- SET HELP="SUSL"
- IF X["?"
- DO ^PSIVHLP
- IF X["?"
- GOTO S1
- IF +X'=X!(X>10)!(X<1)!(X?.E1"."1N.N)
- KILL X
- IF '$DATA(X)
- WRITE $CHAR(7),$CHAR(7),"??"
- IF '$DATA(X)
- GOTO S1
- +2 IF $DATA(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVNOW))
- WRITE $CHAR(7),!," ... NO labels suspended! Wait 15 seconds and try again."
- DO NOW^%DTC
- SET PSIVNOW=%
- GOTO S1
- +3 SET ^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVNOW)=+X_"^^"_$PIECE(^PS(55,DFN,"IV",+ON,0),U,16)
- SET $PIECE(^(0),U,16)=$PIECE(^PS(55,DFN,"IV",+ON,0),U,16)+X
- WRITE " ..... ",+X," Label"_$SELECT(+X>1:"s",1:"")_" suspended !"
- SET ACTION=5
- SET PSIVNOL=+X
- SET TRACK=1
- DO ^PSIVLTR
- +4 KILL PSIVNOW
- QUIT
- +5 ;
- ENT ;Print labels from suspense
- +1 DO ^PSIVXU
- IF $DATA(XQUIT)
- KILL XQUIT
- QUIT
- +2 DO EXPIR
- SET X="T-1"
- SET %DT="T"
- DO ^%DT
- SET PSIVDEL=Y
- +3 IF PSIVPL'=ION
- SET ZTDESC="PRINT LABELS FROM SUSPENSE (IV)"
- SET ZTRTN="DEQSUS^PSIVSUS"
- SET (ZTSAVE("PSIVSN"),ZTSAVE("PSIVSITE"),ZTSAVE("PSIVDEL"),ZTSAVE("PSJSYSW0"),ZTSAVE("PSJSYSU"),ZTSAVE("PSJSYSP0"))=""
- SET ZTIO=PSIVPL
- DO ^%ZTLOAD
- IF $DATA(ZTSK)
- WRITE !,"Queued."
- QUIT
- DEQSUS LOCK +^PS(55,"PSIVSUS",PSIVSN):1
- IF '$TEST
- GOTO Q
- DO NOW^%DTC
- SET Y=%
- SET PSIVNW=Y
- SET X="A"
- FOR I=0:0
- SET X=$ORDER(^PS(55,"PSIVSUS",PSIVSN,X))
- IF X=""
- QUIT
- IF $EXTRACT(X,2,999)<PSIVDEL
- KILL ^PS(55,"PSIVSUS",PSIVSN,X)
- +1 FOR DFN=0:0
- SET DFN=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN))
- IF 'DFN
- QUIT
- DO ENIV^PSJAC
- FOR ON=0:0
- SET ON=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON))
- IF 'ON
- QUIT
- FOR SDT=0:0
- SET SDT=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT))
- IF 'SDT
- QUIT
- DO E2
- Q LOCK -^PS(55,"PSIVSUS",PSIVSN)
- KILL JJ,PSCT,PSIVDT,PSIVTTM,TOTAL,I,ON,PSIVDOSE,P16,PSIVDEL,PSIVNW,NODE
- Q1 DO ENIVKV^PSGSETU
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +1 QUIT
- E2 IF "PDH"[$PIECE($GET(^PS(55,DFN,"IV",+ON,0)),U,17)
- GOTO E3
- +1 ;Var is use to store in PSIVID() ea ID prt on the label
- SET PSIVWMFL=1
- +2 SET PSIVNOL=+^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT)
- SET P16=$PIECE(^(SDT),U,3)
- SET PSIVDOSE=$PIECE(^(SDT),U,2)
- SET P(4)=$PIECE(^PS(55,DFN,"IV",+ON,0),U,4)
- SET ACTION=1
- SET TRACK=3
- DO ^PSIVLTR
- IF P(4)="H"
- DO ^PSIVHYPL
- IF "APSC"[P(4)
- DO ^PSIVLABL
- E3 SET ^PS(55,"PSIVSUS",PSIVSN,"A"_+PSIVNW,DFN,+ON,SDT)=^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT)
- KILL ^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,SDT)
- +1 IF $DATA(PSIVID)
- NEW X
- FOR X=0:0
- SET X=$ORDER(PSIVID(X))
- IF 'X
- QUIT
- Begin DoDot:1
- +2 SET ^PS(55,"PSIVSUS",PSIVSN,"A"_+PSIVNW,DFN,+ON,SDT,X)=""
- End DoDot:1
- +3 KILL PSIVWMFL,PSIVID
- +4 QUIT
- +5 ;
- EN3 ;Will print a report of those labels on suspense
- +1 DO ^PSIVXU
- IF $DATA(XQUIT)
- KILL XQUIT
- QUIT
- +2 DO EXPIR
- IF PSIVPR'=ION
- READ !!,"Send report to a printer"
- SET %=2
- DO YN^DICN
- IF %=-1
- QUIT
- IF %=0
- SET HELP="SUSRPT"
- DO ^PSIVHLP1
- GOTO EN3
- +3 IF PSIVPR=ION!(%=2)
- DO DEQEN3
- +4 IF '$TEST
- SET ZTIO=PSIVPR
- SET (ZTSAVE("PSIVSN"),ZTSAVE("PSIVSITE"),ZTSAVE("PSJSYSW0"),ZTSAVE("PSJSYSU"),ZTSAVE("PSJSYSP0"))=""
- SET ZTDESC="SUSPENSE LIST (IV)"
- SET ZTRTN="DEQEN3^PSIVSUS"
- DO ^%ZTLOAD
- +5 KILL ON
- DO ENIVKV^PSGSETU
- +6 QUIT
- DEQEN3 KILL DONE,PSIVFND
- DO HDR1
- +1 FOR DFN=0:0
- SET DFN=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN))
- IF 'DFN!$GET(DONE)
- QUIT
- DO ENIV^PSJAC
- FOR ON=0:0
- SET ON=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON))
- IF 'ON!$GET(DONE)
- QUIT
- Begin DoDot:1
- +2 DO SETP
- FOR PSIVDT=0:0
- SET PSIVDT=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVDT))
- IF 'PSIVDT!$GET(DONE)
- QUIT
- IF "DPN"'[P(17)
- DO PRNT
- End DoDot:1
- QEN3 IF '$DATA(PSIVFND)
- WRITE !,"No Data Found"
- IF '$DATA(PSIVPR)&($Y)
- WRITE @IOF
- KILL D,DFN,DONE,I,NODE,ON,P,PSIV,PSIVDT,PSIVFND,SDT,VAERR,Z
- DO Q1
- +1 QUIT
- PRNT IF $Y+8>IOSL
- DO HDR
- IF $GET(DONE)
- QUIT
- SET Y=PSIVDT
- XECUTE ^DD("DD")
- SET PSIVFND=1
- SET NODE=+^PS(55,"PSIVSUS",PSIVSN,DFN,+ON,PSIVDT)_"^"_$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
- +1 DO ENIV^PSJAC
- WRITE !,VADM(1)," (",$SELECT(VAIN(4):$PIECE(VAIN(4),U,2),1:"Outpatient IV"),")",$JUSTIFY(+NODE_" label"_$SELECT(+NODE>1:"s",1:"")_" "_$PIECE(NODE,U,2),IOM-1-$X)
- +2 WRITE !,VA("BID")," [",ON,"]"
- SET SSNF=1
- SET PSIV=0
- DO ENP3^PSIVRNL
- QUIT
- HDR ;
- +1 IF $EXTRACT(IOST,1,2)="C-"
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- IF $DATA(DUOUT)!$DATA(DTOUT)
- SET DONE=1
- QUIT
- HDR1 IF $Y
- WRITE @IOF
- WRITE !!,"Suspense list for: "
- DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- XECUTE ^DD("DD")
- WRITE $PIECE(Y,"@")," ",$PIECE(Y,"@",2),!,"Patient name",?30,"Order",?IOM-11,"Suspended",!
- FOR X=1:1:IOM-1
- WRITE "-"
- +1 QUIT
- SETP SET Y=$SELECT($DATA(^PS(55,DFN,"IV",+ON,0)):^(0),1:"")
- FOR X=1:1:23
- SET P(X)=$PIECE(Y,U,X)
- +1 QUIT
- EXPIR ;
- +1 DO NOW^%DTC
- +2 FOR Y=0:0
- SET Y=$ORDER(^PS(55,"PSIVSUS",PSIVSN,Y))
- IF 'Y
- QUIT
- FOR ON=0:0
- SET ON=$ORDER(^PS(55,"PSIVSUS",PSIVSN,Y,+ON))
- IF 'ON
- QUIT
- SET X=$SELECT($DATA(^PS(55,Y,"IV",+ON,0)):^(0),1:"")
- IF $PIECE(X,U,2)'=$PIECE(X,U,3)
- IF $PIECE(X,U,3)'>%!("D"[$PIECE(X,U,17))
- KILL ^PS(55,"PSIVSUS",PSIVSN,Y,+ON)
