PSIVORC ;BIR/MLM-COMPLETE IV ORDERS ENTERED THROUGH OE/RR ;29-May-2012 14:34;PLS
;;5.0; INPATIENT MEDICATIONS ;**23,53,80,1013,110,134,1015**;16 DEC 97;Build 62
;
; Reference to ^DIC(42 is supported by DBIA 10039
; Reference to ^DPT is supported by DBIA 10035
; Reference to ^%DTC is supported by DBIA 10000
; Reference to ^DID is supported by DBIA 2052
;
; Modified - IHS/MSC/PLS - 10/16/2011 - DISCONT+1
EN ; Set IV parameters.
D SITE^PSIVORE Q:'$G(PSIVQ) K PSIVQ
;
SELECT ;
F S PSGSSH="ORVC" D ^PSGSEL Q:U[PSGSS D GTORDRS
D DONE^PSIVORC1
Q
GTORDRS ;
K ^TMP("PSIV",$J) N DIC,Y D @PSGSS Q:+$G(Y)'>0 W:PSGSS'="P" !,"...a few moments, please..." D @("G"_PSGSS)
I $G(Y),'$D(^TMP("PSIV",$J)) W !,$C(7),"NO PENDING ORDERS FOR ",$S(PSGSS="P":"PATIENT",1:"WARD"),$S(PSGSS="G":" GROUP",1:"")," SELECTED." Q
D NOW^%DTC S HDT=$$ENDTC^PSGMI(%),PSIVAC="C",DONE=0,WDN=""
F S WDN=$O(^TMP("PSIV",$J,WDN)) Q:WDN=""!DONE S PNME="" F S PNME=$O(^TMP("PSIV",$J,WDN,PNME)) Q:PNME=""!DONE D
. I PSGSS'="P" S PSGDFN=$P(PNME,";",2)_"^"_$P(PNME,";") D CHK^PSJDPT(.PSGDFN,1,1) I PSGDFN=-1 Q
. D PROFILE D:PSIVHD ASK
D:$G(PSIVHD) ASK
Q
;
PROFILE ; Display profile of all incomplete orders.
;
K PSGODDD S (DFN,PSGP)=$P(PNME,";",2) D ENBOTH^PSJAC
S RB=PSJPRB,PG=1,PSJORL=$$ENORL^PSJUTL($G(VAIN(4))),PSJIVOF=PSJORL,PSGLMT=0,LN2="" D ENHEAD^PSJO3
S (DONE1,TYP)="" F S TYP=$O(^TMP("PSIV",$J,WDN,PNME,TYP)) Q:TYP=""!(DONE1) D:$Y+5'>IOSL GTYP F ON1=0:0 S ON1=$O(^TMP("PSIV",$J,WDN,PNME,TYP,ON1)) Q:'ON1!(DONE1) D DISPLAY
Q
;
DISPLAY ; Display order on profile.
I $Y+5>IOSL D ASK Q:DONE1 D ENHEAD^PSJO3,GTYP
S PSIVHD=1,PSGLMT=PSGLMT+1,PSIVCV(PSGLMT)=ON1,PSJC="" W !?3,PSGLMT D PIV^PSIVUTL(+ON1_"P")
Q
;
GTYP ; Get formatted heading for type
N PSJD5314 D FIELD^DID(53.1,4,"","POINTER","PSJD5314")
; removed ^DD ref 3-2-99, pass ^^_set of codes value
; because codes^psivutl uses the 3rd piece
S X=$$CODES^PSIVUTL(TYP,"^^"_PSJD5314("POINTER"),"")
S PSIV=$S(X]"":X,1:"UNKNOWN"),X="",$P(X,"-",40-($L(PSIV)/2))="" W !,X_PSIV_X
Q
;
ASK ; Ask which orders to view.
S PSIVHD=0,ACTION="ORDER" D RD1^PSGON I X="^" S (DONE,DONE1)=1 Q
Q:'$D(PSGODDD) S DONE1=0 F PN=1:1:$L(PSGODDD(1),",")-1 S ON=+$P(PSGODDD(1),",",PN) Q:ON=""!DONE1 S ON=+$P(PSGODDD(1),",",PN) D SHOW
S DONE1=1,PSGOP=DFN D:$P(PSJSYSL,U,2)]"" ENQL^PSGLW
Q
;
SHOW ; Display selected order and prompt for action
S (P("PON"),ON)=PSIVCV(ON)
;
SHOW1 ; Entry point from backdoor.
S PSIVUP=+$$GTPCI^PSIVUTL D GT531^PSIVORFA(DFN,ON) I $G(PSIVAC)="PRO" D ENNONUM^PSIVORV2(DFN,ON) Q
I $G(PSJORD)["P" D REQDT^PSJLIVMD(PSJORD)
S PSJORD=+ON D ^PSJLIFN
Q
;
; look-ups on ward group, ward, or patient; depending on value of SS
G S DIC="^PS(57.5,",DIC(0)="QEAMI",DIC("A")="Select WARD GROUP: " W ! D ^DIC S:+Y>0 WG=+Y Q
W S DIC="^DIC(42,",DIC(0)="QEAMI",DIC("A")="Select WARD: " W ! D ^DIC S:+Y>0 WD=+Y Q
P D ENGETP^PSIV Q:DFN<0 S Y=1 I $D(^PS(53.1,"AS","P",+DFN)) S PNME=$G(^DPT(+DFN,0)),PNME=$P(PNME,U)_";"_DFN,WDN=$S(VAIN(4)]"":$P(VAIN(4),U,2),1:"OUTPATIENT") D GP
Q
;
GG ; put patient(s) with incomplete orders into array
F WD=0:0 S WD=$O(^PS(57.5,"AC",WG,WD)) Q:'WD D GW
Q
GW S WDN=$G(^DIC(42,WD,0)),WDN=$P(WDN,U) I WDN]"" F DFN=0:0 S DFN=$O(^DPT("CN",WDN,DFN)) Q:'DFN I $D(^PS(53.1,"AS","P",DFN)) S Y=$G(^DPT(+DFN,0)),PNME=$P(Y,U)_";"_DFN D:PNME]"" GP
Q
GP ;
F ON=0:0 S ON=$O(^PS(53.1,"AS","P",DFN,ON)) Q:'ON S Y=$G(^PS(53.1,ON,0)),TYP=$S($P(Y,U,4)]"":$P(Y,U,4),1:"Z"),^TMP("PSIV",$J,WDN,PNME,TYP,ON)=""
Q
DISCONT ; Cancel incomplete order
N PSJDCTYP I $G(ON)["P",$P($G(^PS(53.1,+$G(ON),0)),"^",24)="R" S PSJDCTYP=$$PNDRNA^PSGOEC(ON) I $G(PSJDCTYP)'=1 D PNDRN(PSJDCTYP) Q
N INCOM
D2 ; Called from PNDRN for pending order
D:'$D(PSJIVORF) ORPARM^PSIVOREN I PSJIVORF S INCOM=$$INPTCOM^APSPFUNC() D NATURE^PSIVOREN I '$D(P("NAT"))!(INCOM="") W !,$C(7),"Order Unchanged." Q
;Prompt for requesting provider
W ! I '$$REQPROV^PSGOEC W !,$C(7),"Order Unchanged." K PSJDCTYP Q
W !
;
D3 ; called from PNDRN for original order
I 'PSJCOM N PSJORNAT S PSJORIFN=$P($G(^PS(53.1,+ON,0)),U,21),PSJORD=ON,PSJORNAT=P("NAT") D DC^PSIVORA ;* I PSJIVORF,PSJORIFN,(ON["V") D EN1^PSJHL2(PSGP,"OD",+ON_"V","ORDER DISCONTINUED")
I PSJCOM,PSJORD["P" N O S O="" F S O=$O(^PS(53.1,"ACX",PSJCOM,O)) Q:O="" D
.S ON=O_"P",PSJORIFN=$P($G(^PS(53.1,+ON,0)),U,21),PSJORD=ON,PSJORNAT=P("NAT") D DC^PSIVORA
W !,"Order discontinued.",!
Q
;
EDIT ; Edit incomplete order
S PSIVAC="CE" L +^PS(53.1,+ON):1 E W !,$C(7),"This order LOCKED by another user." Q
D EDIT^PSIVORC2 L -^PS(53.1,+ON)
Q
;
FINISH ; Finish incomplete order
S PSIVAC="CF" L +^PS(53.1,+ON):1 E W !,$C(7),"This order LOCKED by another user." Q
D FINISH^PSIVORC2 L -^PS(53.1,+ON)
Q
;
PNDRN(PSJDCTYP) ; Discontinue pending renewal only or both pending and original orders
I PSJDCTYP=2 S PSJDCTYP=1 D D2 Q:'$G(PSJDCTYP) D
.N ND5310 S ND5310=$G(^PS(53.1,+ON,0))
.N ON S ON=$P(ND5310,"^",25) I ON S PSJDCTYP=2 D D3
Q
PSIVORC ;BIR/MLM-COMPLETE IV ORDERS ENTERED THROUGH OE/RR ;29-May-2012 14:34;PLS
+1 ;;5.0; INPATIENT MEDICATIONS ;**23,53,80,1013,110,134,1015**;16 DEC 97;Build 62
+2 ;
+3 ; Reference to ^DIC(42 is supported by DBIA 10039
+4 ; Reference to ^DPT is supported by DBIA 10035
+5 ; Reference to ^%DTC is supported by DBIA 10000
+6 ; Reference to ^DID is supported by DBIA 2052
+7 ;
+8 ; Modified - IHS/MSC/PLS - 10/16/2011 - DISCONT+1
EN ; Set IV parameters.
+1 DO SITE^PSIVORE
IF '$GET(PSIVQ)
QUIT
KILL PSIVQ
+2 ;
SELECT ;
+1 FOR
SET PSGSSH="ORVC"
DO ^PSGSEL
IF U[PSGSS
QUIT
DO GTORDRS
+2 DO DONE^PSIVORC1
+3 QUIT
GTORDRS ;
+1 KILL ^TMP("PSIV",$JOB)
NEW DIC,Y
DO @PSGSS
IF +$GET(Y)'>0
QUIT
IF PSGSS'="P"
WRITE !,"...a few moments, please..."
DO @("G"_PSGSS)
+2 IF $GET(Y)
IF '$DATA(^TMP("PSIV",$JOB))
WRITE !,$CHAR(7),"NO PENDING ORDERS FOR ",$SELECT(PSGSS="P":"PATIENT",1:"WARD"),$SELECT(PSGSS="G":" GROUP",1:"")," SELECTED."
QUIT
+3 DO NOW^%DTC
SET HDT=$$ENDTC^PSGMI(%)
SET PSIVAC="C"
SET DONE=0
SET WDN=""
+4 FOR
SET WDN=$ORDER(^TMP("PSIV",$JOB,WDN))
IF WDN=""!DONE
QUIT
SET PNME=""
FOR
SET PNME=$ORDER(^TMP("PSIV",$JOB,WDN,PNME))
IF PNME=""!DONE
QUIT
Begin DoDot:1
+5 IF PSGSS'="P"
SET PSGDFN=$PIECE(PNME,";",2)_"^"_$PIECE(PNME,";")
DO CHK^PSJDPT(.PSGDFN,1,1)
IF PSGDFN=-1
QUIT
+6 DO PROFILE
IF PSIVHD
DO ASK
End DoDot:1
+7 IF $GET(PSIVHD)
DO ASK
+8 QUIT
+9 ;
PROFILE ; Display profile of all incomplete orders.
+1 ;
+2 KILL PSGODDD
SET (DFN,PSGP)=$PIECE(PNME,";",2)
DO ENBOTH^PSJAC
+3 SET RB=PSJPRB
SET PG=1
SET PSJORL=$$ENORL^PSJUTL($GET(VAIN(4)))
SET PSJIVOF=PSJORL
SET PSGLMT=0
SET LN2=""
DO ENHEAD^PSJO3
+4 SET (DONE1,TYP)=""
FOR
SET TYP=$ORDER(^TMP("PSIV",$JOB,WDN,PNME,TYP))
IF TYP=""!(DONE1)
QUIT
IF $Y+5'>IOSL
DO GTYP
FOR ON1=0:0
SET ON1=$ORDER(^TMP("PSIV",$JOB,WDN,PNME,TYP,ON1))
IF 'ON1!(DONE1)
QUIT
DO DISPLAY
+5 QUIT
+6 ;
DISPLAY ; Display order on profile.
+1 IF $Y+5>IOSL
DO ASK
IF DONE1
QUIT
DO ENHEAD^PSJO3
DO GTYP
+2 SET PSIVHD=1
SET PSGLMT=PSGLMT+1
SET PSIVCV(PSGLMT)=ON1
SET PSJC=""
WRITE !?3,PSGLMT
DO PIV^PSIVUTL(+ON1_"P")
+3 QUIT
+4 ;
GTYP ; Get formatted heading for type
+1 NEW PSJD5314
DO FIELD^DID(53.1,4,"","POINTER","PSJD5314")
+2 ; removed ^DD ref 3-2-99, pass ^^_set of codes value
+3 ; because codes^psivutl uses the 3rd piece
+4 SET X=$$CODES^PSIVUTL(TYP,"^^"_PSJD5314("POINTER"),"")
+5 SET PSIV=$SELECT(X]"":X,1:"UNKNOWN")
SET X=""
SET $PIECE(X,"-",40-($LENGTH(PSIV)/2))=""
WRITE !,X_PSIV_X
+6 QUIT
+7 ;
ASK ; Ask which orders to view.
+1 SET PSIVHD=0
SET ACTION="ORDER"
DO RD1^PSGON
IF X="^"
SET (DONE,DONE1)=1
QUIT
+2 IF '$DATA(PSGODDD)
QUIT
SET DONE1=0
FOR PN=1:1:$LENGTH(PSGODDD(1),",")-1
SET ON=+$PIECE(PSGODDD(1),",",PN)
IF ON=""!DONE1
QUIT
SET ON=+$PIECE(PSGODDD(1),",",PN)
DO SHOW
+3 SET DONE1=1
SET PSGOP=DFN
IF $PIECE(PSJSYSL,U,2)]""
DO ENQL^PSGLW
+4 QUIT
+5 ;
SHOW ; Display selected order and prompt for action
+1 SET (P("PON"),ON)=PSIVCV(ON)
+2 ;
SHOW1 ; Entry point from backdoor.
+1 SET PSIVUP=+$$GTPCI^PSIVUTL
DO GT531^PSIVORFA(DFN,ON)
IF $GET(PSIVAC)="PRO"
DO ENNONUM^PSIVORV2(DFN,ON)
QUIT
+2 IF $GET(PSJORD)["P"
DO REQDT^PSJLIVMD(PSJORD)
+3 SET PSJORD=+ON
DO ^PSJLIFN
+4 QUIT
+5 ;
+6 ; look-ups on ward group, ward, or patient; depending on value of SS
G SET DIC="^PS(57.5,"
SET DIC(0)="QEAMI"
SET DIC("A")="Select WARD GROUP: "
WRITE !
DO ^DIC
IF +Y>0
SET WG=+Y
QUIT
W SET DIC="^DIC(42,"
SET DIC(0)="QEAMI"
SET DIC("A")="Select WARD: "
WRITE !
DO ^DIC
IF +Y>0
SET WD=+Y
QUIT
P DO ENGETP^PSIV
IF DFN<0
QUIT
SET Y=1
IF $DATA(^PS(53.1,"AS","P",+DFN))
SET PNME=$GET(^DPT(+DFN,0))
SET PNME=$PIECE(PNME,U)_";"_DFN
SET WDN=$SELECT(VAIN(4)]"":$PIECE(VAIN(4),U,2),1:"OUTPATIENT")
DO GP
+1 QUIT
+2 ;
GG ; put patient(s) with incomplete orders into array
+1 FOR WD=0:0
SET WD=$ORDER(^PS(57.5,"AC",WG,WD))
IF 'WD
QUIT
DO GW
+2 QUIT
GW SET WDN=$GET(^DIC(42,WD,0))
SET WDN=$PIECE(WDN,U)
IF WDN]""
FOR DFN=0:0
SET DFN=$ORDER(^DPT("CN",WDN,DFN))
IF 'DFN
QUIT
IF $DATA(^PS(53.1,"AS","P",DFN))
SET Y=$GET(^DPT(+DFN,0))
SET PNME=$PIECE(Y,U)_";"_DFN
IF PNME]""
DO GP
+1 QUIT
GP ;
+1 FOR ON=0:0
SET ON=$ORDER(^PS(53.1,"AS","P",DFN,ON))
IF 'ON
QUIT
SET Y=$GET(^PS(53.1,ON,0))
SET TYP=$SELECT($PIECE(Y,U,4)]"":$PIECE(Y,U,4),1:"Z")
SET ^TMP("PSIV",$JOB,WDN,PNME,TYP,ON)=""
+2 QUIT
DISCONT ; Cancel incomplete order
+1 NEW PSJDCTYP
IF $GET(ON)["P"
IF $PIECE($GET(^PS(53.1,+$GET(ON),0)),"^",24)="R"
SET PSJDCTYP=$$PNDRNA^PSGOEC(ON)
IF $GET(PSJDCTYP)'=1
DO PNDRN(PSJDCTYP)
QUIT
+2 NEW INCOM
D2 ; Called from PNDRN for pending order
+1 IF '$DATA(PSJIVORF)
DO ORPARM^PSIVOREN
IF PSJIVORF
SET INCOM=$$INPTCOM^APSPFUNC()
DO NATURE^PSIVOREN
IF '$DATA(P("NAT"))!(INCOM="")
WRITE !,$CHAR(7),"Order Unchanged."
QUIT
+2 ;Prompt for requesting provider
+3 WRITE !
IF '$$REQPROV^PSGOEC
WRITE !,$CHAR(7),"Order Unchanged."
KILL PSJDCTYP
QUIT
+4 WRITE !
+5 ;
D3 ; called from PNDRN for original order
+1 ;* I PSJIVORF,PSJORIFN,(ON["V") D EN1^PSJHL2(PSGP,"OD",+ON_"V","ORDER DISCONTINUED")
IF 'PSJCOM
NEW PSJORNAT
SET PSJORIFN=$PIECE($GET(^PS(53.1,+ON,0)),U,21)
SET PSJORD=ON
SET PSJORNAT=P("NAT")
DO DC^PSIVORA
+2 IF PSJCOM
IF PSJORD["P"
NEW O
SET O=""
FOR
SET O=$ORDER(^PS(53.1,"ACX",PSJCOM,O))
IF O=""
QUIT
Begin DoDot:1
+3 SET ON=O_"P"
SET PSJORIFN=$PIECE($GET(^PS(53.1,+ON,0)),U,21)
SET PSJORD=ON
SET PSJORNAT=P("NAT")
DO DC^PSIVORA
End DoDot:1
+4 WRITE !,"Order discontinued.",!
+5 QUIT
+6 ;
EDIT ; Edit incomplete order
+1 SET PSIVAC="CE"
LOCK +^PS(53.1,+ON):1
IF '$TEST
WRITE !,$CHAR(7),"This order LOCKED by another user."
QUIT
+2 DO EDIT^PSIVORC2
LOCK -^PS(53.1,+ON)
+3 QUIT
+4 ;
FINISH ; Finish incomplete order
+1 SET PSIVAC="CF"
LOCK +^PS(53.1,+ON):1
IF '$TEST
WRITE !,$CHAR(7),"This order LOCKED by another user."
QUIT
+2 DO FINISH^PSIVORC2
LOCK -^PS(53.1,+ON)
+3 QUIT
+4 ;
PNDRN(PSJDCTYP) ; Discontinue pending renewal only or both pending and original orders
+1 IF PSJDCTYP=2
SET PSJDCTYP=1
DO D2
IF '$GET(PSJDCTYP)
QUIT
Begin DoDot:1
+2 NEW ND5310
SET ND5310=$GET(^PS(53.1,+ON,0))
+3 NEW ON
SET ON=$PIECE(ND5310,"^",25)
IF ON
SET PSJDCTYP=2
DO D3
End DoDot:1
+4 QUIT
