- PSIVRD ;BIR/PR,MLM-HANDLE QUICK RET/DES ENTRY ;29 SEP 97 / 11:17 AM
- ;;5.0;INPATIENT MEDICATIONS;**38,58,88,279,407**;16 DEC 97;Build 26
- ; ;
- ; Reference to ^PS(55 is supported by DBIA 2191
- ;
- EN ; Entry point to enter returns/destroyed items.
- D ^PSIVXU Q:$D(XQUIT)!($G(DONE)) F D ENGETP^PSIV Q:DFN<0 D EN1 ;P407 Added DONE
- Q K ACTION,D,DFN,DIC,DIR,DRG,DRGI,DRGN,E,E1,HELP,I,I1,JJ,LABELS,MXMN,ON,ON55,ONCNT,P,PS,PSGDT,PSGID,PSGP,PSGLMT,PSGODDD,PSIVAC,PSIVC,PSIVNOL,PSIVNOW,PSIVON
- K PSIVPL,PSIVPR,PSIVSITE,PSIVUP,PSIVX,PSJORIFN,PSJORL,PSJHT,PSJPWT,PSJSYSL,PSJSYSU,PSJSYSW,PSJSYSW0,Q,UL80,VA,VADM,VAIN,VAERR,PSIVNU,PSIVOV1,PSIVOV2,PSIVSN,RDFLAG,RDWARD,X,XQUIT,Y
- Q
- ;
- EN1 ;
- S PSIVBR="D PROCESS^PSIVRD" D ENCHS1^PSIV
- Q
- EN1OLD ;
- ;S PSIVAC="RD" D ENNB^PSIVACT I P("PT")'="N" D GTORDRS Q
- ORDNO ;
- F R !!,"Enter the order number(s) to be processed: ",PSIVNU:DTIME Q:"^"[PSIVNU D READ
- Q
- ;
- READ ; Read order no.s, no profile.
- N DONE I '$T!(PSIVNU="^")!(PSIVNU="") S PSIVNU="" Q
- I PSIVNU["?" W !!,"Enter order number(s) separated by a comma e.g. 2,4,5,6.",! Q
- I PSIVNU[" " W $C(7),$C(7),"??",!! Q
- F I=1:1:$L(PSIVNU,",") S ON=$P(PSIVNU,",",I) D
- .I $L(ON)'>0 W $C(7),$C(7),"??",!! S DONE=1
- .F JJ=1:1:$L(ON) Q:$G(DONE) I $A($E(ON,JJ))<48!($A($E(ON,JJ))>57) W !!,$C(7),$C(7),"Order ",ON," is invalid.",!! S DONE=1
- I '$G(DONE) F I=1:1:$L(PSIVNU,",") S ON=$P(PSIVNU,",",I) I '$D(^PS(55,DFN,"IV",+ON,0)) W !!,$C(7),$C(7),"Order number ",+ON," does not exist for this patient.",! S DONE=1
- I '$G(DONE) D NOW^%DTC S PSIVNOW=% F ONCNT=1:1:$L(PSIVNU,",") D S ON=9999999999-$P(PSIVNU,",",ONCNT) D OV1
- .S X=$G(^PS(55,DFN,"IV",+ON,0)) I $P(X,U,3)<PSIVNOW,("AR"[$P(X,U,17)) S $P(^PS(55,DFN,"IV",+ON,0),U,17)="E" D EXPIR^PSIVOE
- Q
- ;**********************************************************
- ;* GTORDRS, ASK, OV subroutines are no longer use in 5.0. *
- ;**********************************************************
- GTORDRS ;Needs PSIVBR (Branch point)
- S IOP="HOME" D ^%ZIS K %ZIS,IOP Q:P("PT")="N"
- D ^PSIVPRO Q:X="^" I X]"" G OV
- ASK Q:PS<1 W !!,"Choose 1-",PS,": " R X:DTIME S:'$T X="^" Q:"^"[X
- I X?1."?" S HELP="CHSE" D ^PSIVHLP D:X?2."?" H2^PSGON G ASK
- S PSGLMT=PS D ^PSGON G:'$D(X) ASK
- OV ;
- W ! F PSIVOV1=1:1:PSGODDD F PSIVOV2=1:1:$L(PSGODDD(PSIVOV1),",")-1 S ON=+$P(PSGODDD(PSIVOV1),",",PSIVOV2),ON=$S($D(^TMP("PSIV",$J,"AB",ON)):^(ON),$D(^TMP("PSIV",$J,"NB",ON)):^(ON),$D(^TMP("PSIV",$J,"XB",ON)):^(ON),1:"") Q:'ON D OV1
- Q
- OV1 ;
- S (ON,ON55,P("PON"))=9999999999-ON_"V" K PSIVNUM D GT55^PSIVORFB,ENNONUM^PSIVORV2(DFN,ON)
- D PROCESS1
- Q
- ;
- PROCESS ;
- D FULL^VALM1
- S PSJORD=ON D ENNH^PSIVORV2(ON)
- PROCESS1 ;
- I '$D(^PS(55,DFN,"IV",+ON,9)) W !!,$C(7),$C(7),"No labels have been dispensed for this order." N DIR S DIR(0)="E" D ^DIR Q
- I $P(^PS(55,DFN,"IV",+ON,2),U,2)'=PSIVSN W !!,"WARNING ",$C(7),$C(7),$C(7),"This order is in a different IV room",!," from the one in which you are entering returned/destroyed!" S E1=$P(^(2),U,2),E=PSIVSN
- D PAUSE^VALM1
- S PSIVLBTP=2,PSJMORE=0,RDFLAG="ON" D EN^VALM("PSJ LM IV RETURN LABELS")
- Q
- ;
- ;S RDFLAG="ON",X="Was this bottle RECYCLED or DESTROYED or CANCELLED ?^R^^RECYCLED,DESTROYED,CANCELLED" D ENQ^PSIV Q:X=U I X["?" S HELP="RTDS" D ^PSIVHLP1 G PROCESS1
- ;W ! S Y=$E(X),PSIVC=$S(Y="R":2,Y="D":3,1:4)
- ;
- WARD ;Get the ward to associate returns or destroyed with.
- I '$D(PSJIDLST) W !,"No labels are available" D PAUSE^VALM1 Q
- K DIC I $D(^DPT(DFN,.1)) S DIC("B")=^DPT(DFN,.1)
- S DIC("A")="Enter ward or ^OUTPATIENT: ",DIC(0)="AEQ",DIC=42,D="B" D IX^DIC G:X="^"!(X="") KILL I $P("^OUTPATIENT",X)="" W $P("^OUTPATIENT",X,2) S RDWARD=.5 G WARD1
- S:Y>0 RDWARD=+Y I Y<0 G WARD
- ;
- WARD1 ;
- NEW PSIVCTD S PSIVCTD=""
- S PSJY=$$PROMPT^PSIVLBRP()
- Q:PSJY=""
- S PSIVNOL=0
- F PSJSEL=1:1 S PSJSEL1=$P(PSJY,",",PSJSEL) Q:PSJSEL1="" S PSIVNOL=PSIVNOL+1
- F PSJSEL=1:1 S PSJSEL1=$P(PSJY,",",PSJSEL) Q:PSJSEL1="" D
- . S PSJID=$G(PSJIDLST(PSJSEL1)) Q:PSJID=""
- . S PSJIDNO=$P(PSJID,"V",2) D NOW^%DTC
- . K DA,DR,DIE,DIC
- . S DA=PSJIDNO,DA(1)=DFN,DIE="^PS(55,"_DA(1)_",""IVBCMA"","
- . S DR="4////"_%_";5////"_$S(PSIVC=2:"RC",PSIVC=3:"DT",1:"CA")_";9////"_% D ^DIE
- . K DA,DR,DIE,DIC
- S LABELS=PSIVNOL,ACTION=$S(PSIVC=2:2,PSIVC=3:3,1:4) D ^PSIVLTR,^PSIVSTAT W "...Done."
- Q
- NRD ;Ask number of bottles/bags
- Q
- ;NO LONGER USE
- S MXMN=$P(^PS(55,DFN,"IV",+ON,9),U,3)
- NRD1 ;
- Q
- ;NO LONGER USE
- R !,"Number of bottles: ",X:DTIME W:'$T $C(7) S:'$T X="^" G:"^"[X KILL I X?1."?" S HELP="REDT" D ^PSIVHLP G NRD1
- I $S($E(X,$E(X)="-"+1,$L(X))'?1.N:1,X<-50:1,X>MXMN:1,1:'X) W $C(7)," ??" G NRD1
- ;
- S PSIVNOL=+X,LABELS=PSIVNOL,ACTION=$S(PSIVC=2:2,PSIVC=3:3,1:4) D ^PSIVLTR,^PSIVSTAT W "...Done."
- ;
- KILL ;
- Q
- ;NO LONGER USE
- W:"^"[X $C(7),"NO ACTION TAKEN" K D,LABELS,MXMN,X,Y,PSIVNOL,HELP,DIC,RDFLAG,PSIVC
- S VALMBCK="R"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVRD 4860 printed Feb 18, 2025@23:31:19 Page 2
- PSIVRD ;BIR/PR,MLM-HANDLE QUICK RET/DES ENTRY ;29 SEP 97 / 11:17 AM
- +1 ;;5.0;INPATIENT MEDICATIONS;**38,58,88,279,407**;16 DEC 97;Build 26
- +2 ; ;
- +3 ; Reference to ^PS(55 is supported by DBIA 2191
- +4 ;
- EN ; Entry point to enter returns/destroyed items.
- +1 ;P407 Added DONE
- DO ^PSIVXU
- if $DATA(XQUIT)!($GET(DONE))
- QUIT
- FOR
- DO ENGETP^PSIV
- if DFN<0
- QUIT
- DO EN1
- Q KILL ACTION,D,DFN,DIC,DIR,DRG,DRGI,DRGN,E,E1,HELP,I,I1,JJ,LABELS,MXMN,ON,ON55,ONCNT,P,PS,PSGDT,PSGID,PSGP,PSGLMT,PSGODDD,PSIVAC,PSIVC,PSIVNOL,PSIVNOW,PSIVON
- +1 KILL PSIVPL,PSIVPR,PSIVSITE,PSIVUP,PSIVX,PSJORIFN,PSJORL,PSJHT,PSJPWT,PSJSYSL,PSJSYSU,PSJSYSW,PSJSYSW0,Q,UL80,VA,VADM,VAIN,VAERR,PSIVNU,PSIVOV1,PSIVOV2,PSIVSN,RDFLAG,RDWARD,X,XQUIT,Y
- +2 QUIT
- +3 ;
- EN1 ;
- +1 SET PSIVBR="D PROCESS^PSIVRD"
- DO ENCHS1^PSIV
- +2 QUIT
- EN1OLD ;
- +1 ;S PSIVAC="RD" D ENNB^PSIVACT I P("PT")'="N" D GTORDRS Q
- ORDNO ;
- +1 FOR
- READ !!,"Enter the order number(s) to be processed: ",PSIVNU:DTIME
- if "^"[PSIVNU
- QUIT
- DO READ
- +2 QUIT
- +3 ;
- READ ; Read order no.s, no profile.
- +1 NEW DONE
- IF '$TEST!(PSIVNU="^")!(PSIVNU="")
- SET PSIVNU=""
- QUIT
- +2 IF PSIVNU["?"
- WRITE !!,"Enter order number(s) separated by a comma e.g. 2,4,5,6.",!
- QUIT
- +3 IF PSIVNU[" "
- WRITE $CHAR(7),$CHAR(7),"??",!!
- QUIT
- +4 FOR I=1:1:$LENGTH(PSIVNU,",")
- SET ON=$PIECE(PSIVNU,",",I)
- Begin DoDot:1
- +5 IF $LENGTH(ON)'>0
- WRITE $CHAR(7),$CHAR(7),"??",!!
- SET DONE=1
- +6 FOR JJ=1:1:$LENGTH(ON)
- if $GET(DONE)
- QUIT
- IF $ASCII($EXTRACT(ON,JJ))<48!($ASCII($EXTRACT(ON,JJ))>57)
- WRITE !!,$CHAR(7),$CHAR(7),"Order ",ON," is invalid.",!!
- SET DONE=1
- End DoDot:1
- +7 IF '$GET(DONE)
- FOR I=1:1:$LENGTH(PSIVNU,",")
- SET ON=$PIECE(PSIVNU,",",I)
- IF '$DATA(^PS(55,DFN,"IV",+ON,0))
- WRITE !!,$CHAR(7),$CHAR(7),"Order number ",+ON," does not exist for this patient.",!
- SET DONE=1
- +8 IF '$GET(DONE)
- DO NOW^%DTC
- SET PSIVNOW=%
- FOR ONCNT=1:1:$LENGTH(PSIVNU,",")
- Begin DoDot:1
- +9 SET X=$GET(^PS(55,DFN,"IV",+ON,0))
- IF $PIECE(X,U,3)<PSIVNOW
- IF ("AR"[$PIECE(X,U,17))
- SET $PIECE(^PS(55,DFN,"IV",+ON,0),U,17)="E"
- DO EXPIR^PSIVOE
- End DoDot:1
- SET ON=9999999999-$PIECE(PSIVNU,",",ONCNT)
- DO OV1
- +10 QUIT
- +11 ;**********************************************************
- +12 ;* GTORDRS, ASK, OV subroutines are no longer use in 5.0. *
- +13 ;**********************************************************
- GTORDRS ;Needs PSIVBR (Branch point)
- +1 SET IOP="HOME"
- DO ^%ZIS
- KILL %ZIS,IOP
- if P("PT")="N"
- QUIT
- +2 DO ^PSIVPRO
- if X="^"
- QUIT
- IF X]""
- GOTO OV
- ASK if PS<1
- QUIT
- WRITE !!,"Choose 1-",PS,": "
- READ X:DTIME
- if '$TEST
- SET X="^"
- if "^"[X
- QUIT
- +1 IF X?1."?"
- SET HELP="CHSE"
- DO ^PSIVHLP
- if X?2."?"
- DO H2^PSGON
- GOTO ASK
- +2 SET PSGLMT=PS
- DO ^PSGON
- if '$DATA(X)
- GOTO ASK
- OV ;
- +1 WRITE !
- FOR PSIVOV1=1:1:PSGODDD
- FOR PSIVOV2=1:1:$LENGTH(PSGODDD(PSIVOV1),",")-1
- SET ON=+$PIECE(PSGODDD(PSIVOV1),",",PSIVOV2)
- SET ON=$SELECT($DATA(^TMP("PSIV",$JOB,"AB",ON)):^(ON),$DATA(^TMP("PSIV",$JOB,"NB",ON)):^(ON),$DATA(^TMP("PSIV",$JOB,"XB",ON)):^(ON),1:"")
- if 'ON
- QUIT
- DO OV1
- +2 QUIT
- OV1 ;
- +1 SET (ON,ON55,P("PON"))=9999999999-ON_"V"
- KILL PSIVNUM
- DO GT55^PSIVORFB
- DO ENNONUM^PSIVORV2(DFN,ON)
- +2 DO PROCESS1
- +3 QUIT
- +4 ;
- PROCESS ;
- +1 DO FULL^VALM1
- +2 SET PSJORD=ON
- DO ENNH^PSIVORV2(ON)
- PROCESS1 ;
- +1 IF '$DATA(^PS(55,DFN,"IV",+ON,9))
- WRITE !!,$CHAR(7),$CHAR(7),"No labels have been dispensed for this order."
- NEW DIR
- SET DIR(0)="E"
- DO ^DIR
- QUIT
- +2 IF $PIECE(^PS(55,DFN,"IV",+ON,2),U,2)'=PSIVSN
- WRITE !!,"WARNING ",$CHAR(7),$CHAR(7),$CHAR(7),"This order is in a different IV room",!," from the one in which you are entering returned/destroyed!"
- SET E1=$PIECE(^(2),U,2)
- SET E=PSIVSN
- +3 DO PAUSE^VALM1
- +4 SET PSIVLBTP=2
- SET PSJMORE=0
- SET RDFLAG="ON"
- DO EN^VALM("PSJ LM IV RETURN LABELS")
- +5 QUIT
- +6 ;
- +7 ;S RDFLAG="ON",X="Was this bottle RECYCLED or DESTROYED or CANCELLED ?^R^^RECYCLED,DESTROYED,CANCELLED" D ENQ^PSIV Q:X=U I X["?" S HELP="RTDS" D ^PSIVHLP1 G PROCESS1
- +8 ;W ! S Y=$E(X),PSIVC=$S(Y="R":2,Y="D":3,1:4)
- +9 ;
- WARD ;Get the ward to associate returns or destroyed with.
- +1 IF '$DATA(PSJIDLST)
- WRITE !,"No labels are available"
- DO PAUSE^VALM1
- QUIT
- +2 KILL DIC
- IF $DATA(^DPT(DFN,.1))
- SET DIC("B")=^DPT(DFN,.1)
- +3 SET DIC("A")="Enter ward or ^OUTPATIENT: "
- SET DIC(0)="AEQ"
- SET DIC=42
- SET D="B"
- DO IX^DIC
- if X="^"!(X="")
- GOTO KILL
- IF $PIECE("^OUTPATIENT",X)=""
- WRITE $PIECE("^OUTPATIENT",X,2)
- SET RDWARD=.5
- GOTO WARD1
- +4 if Y>0
- SET RDWARD=+Y
- IF Y<0
- GOTO WARD
- +5 ;
- WARD1 ;
- +1 NEW PSIVCTD
- SET PSIVCTD=""
- +2 SET PSJY=$$PROMPT^PSIVLBRP()
- +3 if PSJY=""
- QUIT
- +4 SET PSIVNOL=0
- +5 FOR PSJSEL=1:1
- SET PSJSEL1=$PIECE(PSJY,",",PSJSEL)
- if PSJSEL1=""
- QUIT
- SET PSIVNOL=PSIVNOL+1
- +6 FOR PSJSEL=1:1
- SET PSJSEL1=$PIECE(PSJY,",",PSJSEL)
- if PSJSEL1=""
- QUIT
- Begin DoDot:1
- +7 SET PSJID=$GET(PSJIDLST(PSJSEL1))
- if PSJID=""
- QUIT
- +8 SET PSJIDNO=$PIECE(PSJID,"V",2)
- DO NOW^%DTC
- +9 KILL DA,DR,DIE,DIC
- +10 SET DA=PSJIDNO
- SET DA(1)=DFN
- SET DIE="^PS(55,"_DA(1)_",""IVBCMA"","
- +11 SET DR="4////"_%_";5////"_$SELECT(PSIVC=2:"RC",PSIVC=3:"DT",1:"CA")_";9////"_%
- DO ^DIE
- +12 KILL DA,DR,DIE,DIC
- End DoDot:1
- +13 SET LABELS=PSIVNOL
- SET ACTION=$SELECT(PSIVC=2:2,PSIVC=3:3,1:4)
- DO ^PSIVLTR
- DO ^PSIVSTAT
- WRITE "...Done."
- +14 QUIT
- NRD ;Ask number of bottles/bags
- +1 QUIT
- +2 ;NO LONGER USE
- +3 SET MXMN=$PIECE(^PS(55,DFN,"IV",+ON,9),U,3)
- NRD1 ;
- +1 QUIT
- +2 ;NO LONGER USE
- +3 READ !,"Number of bottles: ",X:DTIME
- if '$TEST
- WRITE $CHAR(7)
- if '$TEST
- SET X="^"
- if "^"[X
- GOTO KILL
- IF X?1."?"
- SET HELP="REDT"
- DO ^PSIVHLP
- GOTO NRD1
- +4 IF $SELECT($EXTRACT(X,$EXTRACT(X)="-"+1,$LENGTH(X))'?1.N:1,X<-50:1,X>MXMN:1,1:'X)
- WRITE $CHAR(7)," ??"
- GOTO NRD1
- +5 ;
- +6 SET PSIVNOL=+X
- SET LABELS=PSIVNOL
- SET ACTION=$SELECT(PSIVC=2:2,PSIVC=3:3,1:4)
- DO ^PSIVLTR
- DO ^PSIVSTAT
- WRITE "...Done."
- +7 ;
- KILL ;
- +1 QUIT
- +2 ;NO LONGER USE
- +3 if "^"[X
- WRITE $CHAR(7),"NO ACTION TAKEN"
- KILL D,LABELS,MXMN,X,Y,PSIVNOL,HELP,DIC,RDFLAG,PSIVC
- +4 SET VALMBCK="R"
- +5 QUIT
