PSIVLBDL ;BIR/PR,CML-DELETE LBLS FROM SUSPENSE ;02 FEB 94 / 1:54 PM
;;5.0;INPATIENT MEDICATIONS;**407**;16 DEC 97;Build 26
;
D ^PSIVXU I $D(XQUIT) K XQUIT Q
Q:$G(DONE) ;P407
S PSIVAC="PRO" D ENGETP^PSIV G:DFN<0 DONE W !?3,"...one moment, please..." D EXPCHK
START ;
D HDR I '$D(^PS(55,"PSIVSUS",PSIVSN,DFN)) W !!,"There are no labels on suspense for this patient." G PSIVLBDL
D SUSLP1 G:X?1."?" START
DONE ;
K %,A,B1,B2,BB,DFN,DIC,FL,HELP,J,K,KK,ON,P,PSGDT,PSIV,PSIVAC,PSIVCT,PSIVDT,PSIVRD,TN,VAERR,X,X1,X2,Y,Z D ENIVKV^PSGSETU Q
;
SUSLP1 ;
S X="" F ON=0:0 S ON=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,ON)) Q:'ON D:$Y+7>IOSL DELINE Q:X="^" Q:X?1."?" D LP S X=""
Q:$E(X)="^" Q:X?1."?"
DELINE ;
W !,"Select Order Number: " I ON W !,"or press return to view more "
R X:DTIME W:'$T $C(7) S:'$T X="^" I "^"[X D:X=""&ON HDR Q
I X?1."?" S HELP="LBSUSD" D ^PSIVHLP1 R !,"Press return to continue ",Y:DTIME W:'$T $C(7) S:Y="^"!'$T X="^" Q
D:X'="ALL" ONC W:'$D(X) $C(7)," ??" G:'$D(X) DELINE D KILL W !,"Deleted." Q
HDR ;
W:$Y @IOF W !!,"Patient Name ",VADM(1)," (",$S(VAIN(4):$P(VAIN(4),U,2),1:"Outpatient IV"),")",!,"Order Number",?30,"Order",?IOM-11,"Suspended",! F X=1:1:IOM-1 W "-"
Q
LP S Y=^PS(55,DFN,"IV",ON,0) F X=1:1:23 S P(X)=$P(Y,"^",X)
F PSIVDT=0:0 S PSIVDT=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,ON,PSIVDT)) Q:'PSIVDT D PRNT
Q
PRNT S Y=PSIVDT X ^DD("DD") S Y=+^PS(55,"PSIVSUS",PSIVSN,DFN,ON,PSIVDT)_"^"_$P(Y,"@")_" "_$P(Y,"@",2)
W !,ON,$J(+Y_" label"_$S(+Y>1:"s",1:"")_" "_$P(Y,"^",2),IOM-1-$X),!
S PSIV=0,SSNF=1 D ENP3^PSIVRNL K SSNF Q
KILL ;
I X'="ALL" F B1=1:1:Y F B2=1:1:$L(Y(B1),",")-1 S ON=$P(Y(B1),",",B2) K ^PS(55,"PSIVSUS",PSIVSN,DFN,ON)
I X="ALL" F ON=0:0 S ON=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,ON)) Q:'ON K ^PS(55,"PSIVSUS",PSIVSN,DFN,ON)
I '$D(^PS(55,"PSIVSUS",PSIVSN,DFN)) S PSIVD="" F KK=0:0 S PSIVD=$O(^PS(55,"PSIVSUS",PSIVSN,PSIVD)) Q:PSIVD="" K ^PS(55,"PSIVSUS",PSIVSN,PSIVD,DFN)
S X="^" Q
;
ONC ;
K Y S Y=1,Y(1)=""
F Q=1:1:$L(X,",") S X1=$P(X,",",Q) D SET Q:'$D(X)
Q
;
SET ;
I $S('X1:1,1:'$D(^PS(55,"PSIVSUS",PSIVSN,DFN,X1))) K X Q
I $L(Y(Y))+$L(X1)>244 S Y=Y+1,Y(Y)=""
S Y(Y)=Y(Y)_X1_"," Q
;
EXPCHK ;
D NOW^%DTC
F ON=0:0 S ON=$O(^PS(55,"PSIVSUS",PSIVSN,DFN,ON)) Q:'ON S X=$S($D(^PS(55,DFN,"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,DFN,ON)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVLBDL 2402 printed Nov 22, 2024@17:14:25 Page 2
PSIVLBDL ;BIR/PR,CML-DELETE LBLS FROM SUSPENSE ;02 FEB 94 / 1:54 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**407**;16 DEC 97;Build 26
+2 ;
+3 DO ^PSIVXU
IF $DATA(XQUIT)
KILL XQUIT
QUIT
+4 ;P407
if $GET(DONE)
QUIT
+5 SET PSIVAC="PRO"
DO ENGETP^PSIV
if DFN<0
GOTO DONE
WRITE !?3,"...one moment, please..."
DO EXPCHK
START ;
+1 DO HDR
IF '$DATA(^PS(55,"PSIVSUS",PSIVSN,DFN))
WRITE !!,"There are no labels on suspense for this patient."
GOTO PSIVLBDL
+2 DO SUSLP1
if X?1."?"
GOTO START
DONE ;
+1 KILL %,A,B1,B2,BB,DFN,DIC,FL,HELP,J,K,KK,ON,P,PSGDT,PSIV,PSIVAC,PSIVCT,PSIVDT,PSIVRD,TN,VAERR,X,X1,X2,Y,Z
DO ENIVKV^PSGSETU
QUIT
+2 ;
SUSLP1 ;
+1 SET X=""
FOR ON=0:0
SET ON=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN,ON))
if 'ON
QUIT
if $Y+7>IOSL
DO DELINE
if X="^"
QUIT
if X?1."?"
QUIT
DO LP
SET X=""
+2 if $EXTRACT(X)="^"
QUIT
if X?1."?"
QUIT
DELINE ;
+1 WRITE !,"Select Order Number: "
IF ON
WRITE !,"or press return to view more "
+2 READ X:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET X="^"
IF "^"[X
if X=""&ON
DO HDR
QUIT
+3 IF X?1."?"
SET HELP="LBSUSD"
DO ^PSIVHLP1
READ !,"Press return to continue ",Y:DTIME
if '$TEST
WRITE $CHAR(7)
if Y="^"!'$TEST
SET X="^"
QUIT
+4 if X'="ALL"
DO ONC
if '$DATA(X)
WRITE $CHAR(7)," ??"
if '$DATA(X)
GOTO DELINE
DO KILL
WRITE !,"Deleted."
QUIT
HDR ;
+1 if $Y
WRITE @IOF
WRITE !!,"Patient Name ",VADM(1)," (",$SELECT(VAIN(4):$PIECE(VAIN(4),U,2),1:"Outpatient IV"),")",!,"Order Number",?30,"Order",?IOM-11,"Suspended",!
FOR X=1:1:IOM-1
WRITE "-"
+2 QUIT
LP SET Y=^PS(55,DFN,"IV",ON,0)
FOR X=1:1:23
SET P(X)=$PIECE(Y,"^",X)
+1 FOR PSIVDT=0:0
SET PSIVDT=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN,ON,PSIVDT))
if 'PSIVDT
QUIT
DO PRNT
+2 QUIT
PRNT SET Y=PSIVDT
XECUTE ^DD("DD")
SET Y=+^PS(55,"PSIVSUS",PSIVSN,DFN,ON,PSIVDT)_"^"_$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
+1 WRITE !,ON,$JUSTIFY(+Y_" label"_$SELECT(+Y>1:"s",1:"")_" "_$PIECE(Y,"^",2),IOM-1-$X),!
+2 SET PSIV=0
SET SSNF=1
DO ENP3^PSIVRNL
KILL SSNF
QUIT
KILL ;
+1 IF X'="ALL"
FOR B1=1:1:Y
FOR B2=1:1:$LENGTH(Y(B1),",")-1
SET ON=$PIECE(Y(B1),",",B2)
KILL ^PS(55,"PSIVSUS",PSIVSN,DFN,ON)
+2 IF X="ALL"
FOR ON=0:0
SET ON=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN,ON))
if 'ON
QUIT
KILL ^PS(55,"PSIVSUS",PSIVSN,DFN,ON)
+3 IF '$DATA(^PS(55,"PSIVSUS",PSIVSN,DFN))
SET PSIVD=""
FOR KK=0:0
SET PSIVD=$ORDER(^PS(55,"PSIVSUS",PSIVSN,PSIVD))
if PSIVD=""
QUIT
KILL ^PS(55,"PSIVSUS",PSIVSN,PSIVD,DFN)
+4 SET X="^"
QUIT
+5 ;
ONC ;
+1 KILL Y
SET Y=1
SET Y(1)=""
+2 FOR Q=1:1:$LENGTH(X,",")
SET X1=$PIECE(X,",",Q)
DO SET
if '$DATA(X)
QUIT
+3 QUIT
+4 ;
SET ;
+1 IF $SELECT('X1:1,1:'$DATA(^PS(55,"PSIVSUS",PSIVSN,DFN,X1)))
KILL X
QUIT
+2 IF $LENGTH(Y(Y))+$LENGTH(X1)>244
SET Y=Y+1
SET Y(Y)=""
+3 SET Y(Y)=Y(Y)_X1_","
QUIT
+4 ;
EXPCHK ;
+1 DO NOW^%DTC
+2 FOR ON=0:0
SET ON=$ORDER(^PS(55,"PSIVSUS",PSIVSN,DFN,ON))
if 'ON
QUIT
SET X=$SELECT($DATA(^PS(55,DFN,"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,DFN,ON)
+3 QUIT
