- PSGOEF1 ;BIR/CML3 - FINISH ORDERS ENTERED THROUGH OE/RR (CONT) ; Feb 02, 2022
- ;;5.0;INPATIENT MEDICATIONS;**2,7,35,39,45,47,50,63,67,58,95,110,186,181,267,315,317,337,411,399**;16 DEC 97;Build 64
- ;
- ; Reference to ^VALM1 is supported by DBIA# 10116.
- ; Reference to ^PS(55 is supported by DBIA 2191.
- ; Reference to ^PSDRUG( is supported by DBIA 2192.
- ; Reference to ^%DTC is supported by DBIA 10000.
- ; Reference to ^%RCR is supported by DBIA 10022.
- ; Reference to ^DIE is supported by DBIA 10018.
- ; Reference to ^DIR is supported by DBIA 10026.
- ; Reference to $$GET^XPAR is supported by DBIA #2263
- ;
- UPD ;
- W !!,"...accepting order..."
- I PSGST="",(PSGSCH="NOW"!(PSGSCH="ONCE")) S PSGST="O"
- I PSJCOM D UPD^PSJCOM Q
- N INDCHNG S INDCHNG=$$DIFFIND^PSGOE42($G(DFN),PSGORD,PSGIND) ;*399-IND
- K DA,DR S DA=+PSGORD,DIE="^PS(53.1,",DR="28////N;4////U"_";7////"_PSGST_";10////"_PSGSD_";25////"_PSGFD
- I $D(PSGSI),$P($G(^PS(53.1,+PSGORD,0)),U,24)'="R" S ^PS(53.1,DA,6)=PSGSI
- I $D(PSGSI),$P($G(^PS(53.1,+PSGORD,0)),U,24)="R" S $P(^PS(53.1,DA,6),U)=$P(PSGSI,U) I $P(^PS(53.1,DA,6),U)="" S $P(^PS(53.1,DA,6),U,2)=""
- I $D(PSGIND) S DR=DR_";132////"_PSGIND ;*399-IND
- S:PSGOEFF#2 DR=DR_";26////"_PSGSCH
- ;*315 DRP Add removal fields if flag set.
- S:+$G(PSGRF) DR=DR_";137////"_$G(PSGDUR)_";138////"_$G(PSGRMVT)_";139////"_$G(PSGRMV)_";140////"_$G(PSGRF)
- I PSGSM,PSGOHSM'=PSGHSM S DR=DR_";5////"_PSGSM_";6////"_PSGHSM
- ;*411 clinic orders
- N OLCLN
- S OLCLN=$G(^PS(53.1,+PSGORD,"DSS"))
- I ($G(P("CLIN")))!($G(P("APPT"))) D
- .I $G(P("CLIN")),P("CLIN")'=$G(P("CLINO")) S DR=DR_";113////"_P("CLIN")
- .I $G(P("APPT")),P("APPT")'=$G(P("APPTO")) S DR=DR_";126////"_P("APPT")
- D ^DIE W "."
- F Q=1,3 K @(PSGOEEWF_Q_")") S %X="^PS(53.45,"_PSJSYSP_","_$S(Q=1:2,1:1)_",",%Y=PSGOEEWF_Q_"," K @(PSGOEEWF_Q_")") D %XY^%RCR W "." ;MOU-0100-30945
- S PSGND=$G(^PS(53.1,+PSGORD,0)),X=$P(PSGND,U,24)
- I $S(X="R":1,+$G(^PS(55,PSGP,5.1))>PSGDT:0,1:X'="E") S X=$G(^PS(53.1,DA,2)) D ENWALL^PSGNE3(+$P(X,U,2),+$P(X,U,4),PSGP)
- I $P(PSGND,U,24)="R",$P(PSGND,U,25),PSGSD<$P($G(^PS(55,PSGP,5,+$P(PSGND,U,25),2)),U,4) D
- .K DA,DR S DA(1)=PSGP,DA=+$P(PSGND,U,25),DIE="^PS(55,"_PSGP_",5,",DR="34////"_PSGFD_";25////"_$P($G(^PS(55,PSGP,5,+$P(PSGND,U,25),2)),U,4)
- .S:+$G(PSGRF) DR=DR_";137////"_$G(PSGDUR)_";138////"_$G(PSGRMVT)_";139////"_$G(PSGRMV)_";140////"_$G(PSGRF) ;*315
- .D ^DIE,EN1^PSJHL2(PSGP,"XX",$P(PSGND,U,25))
- S $P(^PS(53.1,+PSGORD,.2),U,2)=PSGDO,$P(^PS(53.1,+PSGORD,2),U,5)=PSGAT S:$G(PSGS0XT) $P(^(2),U,6)=PSGS0XT
- I 'PSGOEAV D NEWNVAL^PSGAL5(PSGORD,$S(+PSJSYSU=3:22005,1:22000))
- I $D(^PS(53.45,+$G(DUZ),5,1,0)) D FILESI^PSJBCMA5(PSGP,PSGORD) N SIARRAY S SIARRAY="" D NEWNVAL^PSGAL5(PSGORD,6000,"SPECIAL INSTRUCTIONS",,.SIARRAY)
- I $D(^PS(53.45,+$G(DUZ),6,1,0)) D FILEOPI^PSJBCMA5(PSGP,PSGORD) N SIARRAY S SIARRAY="" D NEWNVAL^PSGAL5(PSGORD,6000,"OTHER PRINT INFO",,.SIARRAY)
- ;*411 clinic order activity log
- I $P(OLCLN,"^")'="",$P(OLCLN,"^")'=$G(P("CLIN")) D NEWNVAL^PSGAL5(PSGORD,6000,"CLINIC",$P($G(^SC(+$P(OLCLN,"^"),0)),"^"))
- I $P(OLCLN,"^",2)'="",$P(OLCLN,"^",2)'=$G(P("APPT")) D NEWNVAL^PSGAL5(PSGORD,6000,"APPOINTMENT DATE/TIME",$P(OLCLN,"^",2))
- I +INDCHNG=1 D ;*399-IND
- .I PSGORD["P" D NEWNVAL^PSGAL5(PSGORD,6000,"INDICATION",$P(INDCHNG,U,2))
- .I PSGORD["U" D NEWUDAL^PSGAL5(DFN,PSGORD,6000,"INDICATION",$P(INDCHNG,U,2))
- I PSGOEAV,+$G(PSJSYSU)=3 D VFY^PSGOEV Q
- I PSGOEAV,$G(PSJRNF) D VFY^PSGOEV
- Q
- ;
- ENDRG(PSGPDRG,DRGDA) ; enter dispense drug for order w/o one
- NEW PSJALLGY
- K PSGORQF
- D NOW^%DTC K DRG S (DRG,Q)=0 F S Q=$O(^PSDRUG("ASP",+PSGPDRG,Q)) Q:'Q I $D(^PSDRUG(Q,0)),$P($G(^(2)),U,3)["U" S X=+$G(^("I")) I 'X!(X>%) S DRG=DRG+1,DRG(DRG)=Q_"^"_^(0)
- I 'DRG W $C(7),!!,"No dispense drugs were found for this order's Orderable Item." K DIR S DIR(0)="E" D ^DIR K DIR S CHK=-1 Q
- S:DRG=1 Y(0)=1
- I DRG>1 D I 'Y S DRG=0,CHK=-1 Q
- .N PSJPADLK
- .; PSJ*5*317 - If PSJ PADE OE BALANCES parameter is YES, PADE balances should display.
- .I $$GET^XPAR("SYS","PSJ PADE OE BALANCES") D
- ..N DFN,PSJORD,PSJORCL,PSJCLNK S DFN=$G(PSGP),PSJORD=$G(PSGORD)
- ..I '$G(VAIN(4)) N VAIN D INP^VADPT
- ..; If clinic order, quit if clinic location is not linked to PADE
- ..S PSJORCL=$S($G(PSGORD)["P":$G(^PS(53.1,+$G(PSGORD),"DSS")),$G(PSGORD)["U":$G(^PS(55,+$G(PSGP),5,+$G(PSGORD),8)),$G(PSGORD)["V":$G(^PS(55,+$G(PSGP),"IV",+$G(PSGORD),"DSS")),1:"")
- ..I PSJORCL,$P(PSJORCL,"^",2) S PSJCLNK=$$PADECL^PSJPAD50(+$G(PSJORCL)) Q:'PSJCLNK
- ..I '$G(PSJCLNK) Q:'$$PADEWD^PSJPAD50(+$G(VAIN(4)))
- ..S PSJPADLK=1
- ..W !!,"CHOOSE FROM:",?59,"PADE" F Q=1:1:DRG W !?3,$J(Q,3),". ",$P(DRG(Q),"^",2),?60,$$DRGSTOCK^PSJPADSI(DFN,$G(PSGORD),,,+$G(DRG(Q)))
- .I '$G(PSJPADLK) W !!,"CHOOSE FROM:" F Q=1:1:DRG W !?3,$J(Q,3),". ",$P(DRG(Q),"^",2)
- .N DIR S DIR(0)="LAO^1:"_DRG_U_"I X#1!(X[""."") K X",DIR("A")="Select DISPENSE DRUG(S) for this order: " S:DRG=1 DIR("B")=1 S DIR("?")="^D DRGH^PSGOEF1" W ! D ^DIR
- ;
- S DRG=Y(0) F Q1=1:1 S Q2=$P(DRG,",",Q1) Q:'Q2 D
- . S PSJALLGY(+DRG(Q2))=""
- I 'DRGDA S ^PS(53.45,PSJSYSP,2,0)="^53.4502P"
- F Q1=1:1 S Q2=$P(DRG,",",Q1) Q:'Q2 D
- . S DRGDA=DRGDA+1,^PS(53.45,PSJSYSP,2,DRGDA,0)=+DRG(Q2),^PS(53.45,PSJSYSP,2,"B",+DRG(Q2),DRGDA)=""
- . S DA(1)=PSJSYSP,DA=DRGDA,DIE="^PS(53.45,"_PSJSYSP_",2,",DR=".02//1" W !!,$P(DRG(Q2),U,2) D ^DIE
- D ENCKDD(PSGP,+$O(PSJALLGY(0))) Q:$G(PSGORQF)
- S PSGDI=0
- S:DRGDA>0 $P(^PS(53.45,PSJSYSP,2,0),"^",3,4)=DRGDA_"^"_DRGDA,CHK=0 Q
- Q
- ;
- DRGH ;
- W !!?2,"This order must have at least one dispense drug before it can be completed.",!,"Select one or more items listed. For each item selected, you will be",!,"prompted for the UNITS PER DOSE for the item."
- Q
- ENIVUD(PSJORD) ;
- ;Determine if user should be prompted to transfer the order to IV.
- ; INPUT: PSJORD - IEN in 53.1_order location code.
- ; OUTPUT: 1 - Order not transferred, process as always.
- ; 0 - User selected to transfer order and quit upon return.
- ;
- NEW DIR,DIRUT,PSJCOI,PSJND0,Y
- S PSJND0=$G(^PS(53.1,+PSJORD,0)),PSJCOI=+$G(^PS(53.1,+PSJORD,.2))
- I $P(PSJND0,U,4)="F" Q 1
- D FULL^VALM1
- I $S($P(PSJND0,U,24)="R":1,1:'$P(PSJND0,U,13)) Q 1
- S DIR(0)="SAB^I:IV;U:UNIT DOSE",DIR("A")="COMPLETE THIS ORDER AS IV OR UNIT DOSE? ",DIR("B")=$S($P(PSJND0,U,4)="I":"IV",1:"UNIT DOSE")
- S DIR("??")="^D THELP^PSGOEF1("""_$S(DIR("B")="IV":"UNIT DOSE",1:"IV")_""","_PSJCOI_")"
- D ^DIR K DIR
- I $D(DTOUT)!$D(DUOUT) Q 0
- I Y="I" D Q 0
- . I +PSJSYSU=1,'$G(PSJIRNF) W !!!!,"You need the PSJI RNFINISH key to finish this order as IV!" D PAUSE^VALM1 S VALMBCK="R" Q
- . D IV^PSJLIFNI(PSJORD,PSJCOI)
- I Y="U" D Q 0
- . I +PSJSYSU=1,'$G(PSJRNF) W !!!!,"You need the PSJ RNFINISH key to finish this order as Unit Dose!" D PAUSE^VALM1 S VALMBCK="R" Q
- . I $G(PSJITECH),($P(PSJSYSU,";",3)'=3) W !!!!,"You may not finish this order as Unit Dose!" D PAUSE^VALM1 S VALMBCK="R" Q
- . D ENUD^PSGOEF1(PSJORD,PSJCOI)
- Q 1
- ;
- ENUD(PSJORD,PSGPD) ;
- N PSJTUD S PSJTUD=1,DFN=$P($G(^PS(53.1,+PSJORD,0)),U,15)
- K DRG,DRGOC,DRGT,DRGTMP,ERR,ON,ON55,P,PSJSTAR,PSJTIM,UL80
- D DISACTIO^PSJOE(DFN,PSJORD,$G(PSJPNV)) S VALMBCK="Q"
- I +$G(PSGORQF) S VALMBCK="R"
- Q
- THELP(PKG,COI) ;
- W !,"Choose the package this order should be completed as a IV or Unit Dose order",!
- Q
- ;
- ENCKDD(PSGP,PSJDRG) ;
- ;If the OI is edited, the OC is done in ^PSGOEE (PSGOE8 - Non-VFY; PSGOE9 - Active)
- Q:$G(PSGOEER)["101^PSGOE8"
- Q:$G(PSGOEER)["101^PSGOE9"
- N DRG
- S PSGORQF=0
- D ENDDC^PSGSICHK(PSGP,PSJDRG) Q:$G(PSGORQF)
- D IN^PSJOCDS($G(PSGORD),"UD",+PSJDRG)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGOEF1 7553 printed Jan 18, 2025@03:03:25 Page 2
- PSGOEF1 ;BIR/CML3 - FINISH ORDERS ENTERED THROUGH OE/RR (CONT) ; Feb 02, 2022
- +1 ;;5.0;INPATIENT MEDICATIONS;**2,7,35,39,45,47,50,63,67,58,95,110,186,181,267,315,317,337,411,399**;16 DEC 97;Build 64
- +2 ;
- +3 ; Reference to ^VALM1 is supported by DBIA# 10116.
- +4 ; Reference to ^PS(55 is supported by DBIA 2191.
- +5 ; Reference to ^PSDRUG( is supported by DBIA 2192.
- +6 ; Reference to ^%DTC is supported by DBIA 10000.
- +7 ; Reference to ^%RCR is supported by DBIA 10022.
- +8 ; Reference to ^DIE is supported by DBIA 10018.
- +9 ; Reference to ^DIR is supported by DBIA 10026.
- +10 ; Reference to $$GET^XPAR is supported by DBIA #2263
- +11 ;
- UPD ;
- +1 WRITE !!,"...accepting order..."
- +2 IF PSGST=""
- IF (PSGSCH="NOW"!(PSGSCH="ONCE"))
- SET PSGST="O"
- +3 IF PSJCOM
- DO UPD^PSJCOM
- QUIT
- +4 ;*399-IND
- NEW INDCHNG
- SET INDCHNG=$$DIFFIND^PSGOE42($GET(DFN),PSGORD,PSGIND)
- +5 KILL DA,DR
- SET DA=+PSGORD
- SET DIE="^PS(53.1,"
- SET DR="28////N;4////U"_";7////"_PSGST_";10////"_PSGSD_";25////"_PSGFD
- +6 IF $DATA(PSGSI)
- IF $PIECE($GET(^PS(53.1,+PSGORD,0)),U,24)'="R"
- SET ^PS(53.1,DA,6)=PSGSI
- +7 IF $DATA(PSGSI)
- IF $PIECE($GET(^PS(53.1,+PSGORD,0)),U,24)="R"
- SET $PIECE(^PS(53.1,DA,6),U)=$PIECE(PSGSI,U)
- IF $PIECE(^PS(53.1,DA,6),U)=""
- SET $PIECE(^PS(53.1,DA,6),U,2)=""
- +8 ;*399-IND
- IF $DATA(PSGIND)
- SET DR=DR_";132////"_PSGIND
- +9 if PSGOEFF#2
- SET DR=DR_";26////"_PSGSCH
- +10 ;*315 DRP Add removal fields if flag set.
- +11 if +$GET(PSGRF)
- SET DR=DR_";137////"_$GET(PSGDUR)_";138////"_$GET(PSGRMVT)_";139////"_$GET(PSGRMV)_";140////"_$GET(PSGRF)
- +12 IF PSGSM
- IF PSGOHSM'=PSGHSM
- SET DR=DR_";5////"_PSGSM_";6////"_PSGHSM
- +13 ;*411 clinic orders
- +14 NEW OLCLN
- +15 SET OLCLN=$GET(^PS(53.1,+PSGORD,"DSS"))
- +16 IF ($GET(P("CLIN")))!($GET(P("APPT")))
- Begin DoDot:1
- +17 IF $GET(P("CLIN"))
- IF P("CLIN")'=$GET(P("CLINO"))
- SET DR=DR_";113////"_P("CLIN")
- +18 IF $GET(P("APPT"))
- IF P("APPT")'=$GET(P("APPTO"))
- SET DR=DR_";126////"_P("APPT")
- End DoDot:1
- +19 DO ^DIE
- WRITE "."
- +20 ;MOU-0100-30945
- FOR Q=1,3
- KILL @(PSGOEEWF_Q_")")
- SET %X="^PS(53.45,"_PSJSYSP_","_$SELECT(Q=1:2,1:1)_","
- SET %Y=PSGOEEWF_Q_","
- KILL @(PSGOEEWF_Q_")")
- DO %XY^%RCR
- WRITE "."
- +21 SET PSGND=$GET(^PS(53.1,+PSGORD,0))
- SET X=$PIECE(PSGND,U,24)
- +22 IF $SELECT(X="R":1,+$GET(^PS(55,PSGP,5.1))>PSGDT:0,1:X'="E")
- SET X=$GET(^PS(53.1,DA,2))
- DO ENWALL^PSGNE3(+$PIECE(X,U,2),+$PIECE(X,U,4),PSGP)
- +23 IF $PIECE(PSGND,U,24)="R"
- IF $PIECE(PSGND,U,25)
- IF PSGSD<$PIECE($GET(^PS(55,PSGP,5,+$PIECE(PSGND,U,25),2)),U,4)
- Begin DoDot:1
- +24 KILL DA,DR
- SET DA(1)=PSGP
- SET DA=+$PIECE(PSGND,U,25)
- SET DIE="^PS(55,"_PSGP_",5,"
- SET DR="34////"_PSGFD_";25////"_$PIECE($GET(^PS(55,PSGP,5,+$PIECE(PSGND,U,25),2)),U,4)
- +25 ;*315
- if +$GET(PSGRF)
- SET DR=DR_";137////"_$GET(PSGDUR)_";138////"_$GET(PSGRMVT)_";139////"_$GET(PSGRMV)_";140////"_$GET(PSGRF)
- +26 DO ^DIE
- DO EN1^PSJHL2(PSGP,"XX",$PIECE(PSGND,U,25))
- End DoDot:1
- +27 SET $PIECE(^PS(53.1,+PSGORD,.2),U,2)=PSGDO
- SET $PIECE(^PS(53.1,+PSGORD,2),U,5)=PSGAT
- if $GET(PSGS0XT)
- SET $PIECE(^(2),U,6)=PSGS0XT
- +28 IF 'PSGOEAV
- DO NEWNVAL^PSGAL5(PSGORD,$SELECT(+PSJSYSU=3:22005,1:22000))
- +29 IF $DATA(^PS(53.45,+$GET(DUZ),5,1,0))
- DO FILESI^PSJBCMA5(PSGP,PSGORD)
- NEW SIARRAY
- SET SIARRAY=""
- DO NEWNVAL^PSGAL5(PSGORD,6000,"SPECIAL INSTRUCTIONS",,.SIARRAY)
- +30 IF $DATA(^PS(53.45,+$GET(DUZ),6,1,0))
- DO FILEOPI^PSJBCMA5(PSGP,PSGORD)
- NEW SIARRAY
- SET SIARRAY=""
- DO NEWNVAL^PSGAL5(PSGORD,6000,"OTHER PRINT INFO",,.SIARRAY)
- +31 ;*411 clinic order activity log
- +32 IF $PIECE(OLCLN,"^")'=""
- IF $PIECE(OLCLN,"^")'=$GET(P("CLIN"))
- DO NEWNVAL^PSGAL5(PSGORD,6000,"CLINIC",$PIECE($GET(^SC(+$PIECE(OLCLN,"^"),0)),"^"))
- +33 IF $PIECE(OLCLN,"^",2)'=""
- IF $PIECE(OLCLN,"^",2)'=$GET(P("APPT"))
- DO NEWNVAL^PSGAL5(PSGORD,6000,"APPOINTMENT DATE/TIME",$PIECE(OLCLN,"^",2))
- +34 ;*399-IND
- IF +INDCHNG=1
- Begin DoDot:1
- +35 IF PSGORD["P"
- DO NEWNVAL^PSGAL5(PSGORD,6000,"INDICATION",$PIECE(INDCHNG,U,2))
- +36 IF PSGORD["U"
- DO NEWUDAL^PSGAL5(DFN,PSGORD,6000,"INDICATION",$PIECE(INDCHNG,U,2))
- End DoDot:1
- +37 IF PSGOEAV
- IF +$GET(PSJSYSU)=3
- DO VFY^PSGOEV
- QUIT
- +38 IF PSGOEAV
- IF $GET(PSJRNF)
- DO VFY^PSGOEV
- +39 QUIT
- +40 ;
- ENDRG(PSGPDRG,DRGDA) ; enter dispense drug for order w/o one
- +1 NEW PSJALLGY
- +2 KILL PSGORQF
- +3 DO NOW^%DTC
- KILL DRG
- SET (DRG,Q)=0
- FOR
- SET Q=$ORDER(^PSDRUG("ASP",+PSGPDRG,Q))
- if 'Q
- QUIT
- IF $DATA(^PSDRUG(Q,0))
- IF $PIECE($GET(^(2)),U,3)["U"
- SET X=+$GET(^("I"))
- IF 'X!(X>%)
- SET DRG=DRG+1
- SET DRG(DRG)=Q_"^"_^(0)
- +4 IF 'DRG
- WRITE $CHAR(7),!!,"No dispense drugs were found for this order's Orderable Item."
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- SET CHK=-1
- QUIT
- +5 if DRG=1
- SET Y(0)=1
- +6 IF DRG>1
- Begin DoDot:1
- +7 NEW PSJPADLK
- +8 ; PSJ*5*317 - If PSJ PADE OE BALANCES parameter is YES, PADE balances should display.
- +9 IF $$GET^XPAR("SYS","PSJ PADE OE BALANCES")
- Begin DoDot:2
- +10 NEW DFN,PSJORD,PSJORCL,PSJCLNK
- SET DFN=$GET(PSGP)
- SET PSJORD=$GET(PSGORD)
- +11 IF '$GET(VAIN(4))
- NEW VAIN
- DO INP^VADPT
- +12 ; If clinic order, quit if clinic location is not linked to PADE
- +13 SET PSJORCL=$SELECT($GET(PSGORD)["P":$GET(^PS(53.1,+$GET(PSGORD),"DSS")),$GET(PSGORD)["U":$GET(^PS(55,+$GET(PSGP),5,+$GET(PSGORD),8)),$GET(PSGORD)["V":$GET(^PS(55,+$GET(PSGP),"IV",+$GET(PSGORD),"DSS")),1:"")
- +14 IF PSJORCL
- IF $PIECE(PSJORCL,"^",2)
- SET PSJCLNK=$$PADECL^PSJPAD50(+$GET(PSJORCL))
- if 'PSJCLNK
- QUIT
- +15 IF '$GET(PSJCLNK)
- if '$$PADEWD^PSJPAD50(+$GET(VAIN(4)))
- QUIT
- +16 SET PSJPADLK=1
- +17 WRITE !!,"CHOOSE FROM:",?59,"PADE"
- FOR Q=1:1:DRG
- WRITE !?3,$JUSTIFY(Q,3),". ",$PIECE(DRG(Q),"^",2),?60,$$DRGSTOCK^PSJPADSI(DFN,$GET(PSGORD),,,+$GET(DRG(Q)))
- End DoDot:2
- +18 IF '$GET(PSJPADLK)
- WRITE !!,"CHOOSE FROM:"
- FOR Q=1:1:DRG
- WRITE !?3,$JUSTIFY(Q,3),". ",$PIECE(DRG(Q),"^",2)
- +19 NEW DIR
- SET DIR(0)="LAO^1:"_DRG_U_"I X#1!(X[""."") K X"
- SET DIR("A")="Select DISPENSE DRUG(S) for this order: "
- if DRG=1
- SET DIR("B")=1
- SET DIR("?")="^D DRGH^PSGOEF1"
- WRITE !
- DO ^DIR
- End DoDot:1
- IF 'Y
- SET DRG=0
- SET CHK=-1
- QUIT
- +20 ;
- +21 SET DRG=Y(0)
- FOR Q1=1:1
- SET Q2=$PIECE(DRG,",",Q1)
- if 'Q2
- QUIT
- Begin DoDot:1
- +22 SET PSJALLGY(+DRG(Q2))=""
- End DoDot:1
- +23 IF 'DRGDA
- SET ^PS(53.45,PSJSYSP,2,0)="^53.4502P"
- +24 FOR Q1=1:1
- SET Q2=$PIECE(DRG,",",Q1)
- if 'Q2
- QUIT
- Begin DoDot:1
- +25 SET DRGDA=DRGDA+1
- SET ^PS(53.45,PSJSYSP,2,DRGDA,0)=+DRG(Q2)
- SET ^PS(53.45,PSJSYSP,2,"B",+DRG(Q2),DRGDA)=""
- +26 SET DA(1)=PSJSYSP
- SET DA=DRGDA
- SET DIE="^PS(53.45,"_PSJSYSP_",2,"
- SET DR=".02//1"
- WRITE !!,$PIECE(DRG(Q2),U,2)
- DO ^DIE
- End DoDot:1
- +27 DO ENCKDD(PSGP,+$ORDER(PSJALLGY(0)))
- if $GET(PSGORQF)
- QUIT
- +28 SET PSGDI=0
- +29 if DRGDA>0
- SET $PIECE(^PS(53.45,PSJSYSP,2,0),"^",3,4)=DRGDA_"^"_DRGDA
- SET CHK=0
- QUIT
- +30 QUIT
- +31 ;
- DRGH ;
- +1 WRITE !!?2,"This order must have at least one dispense drug before it can be completed.",!,"Select one or more items listed. For each item selected, you will be",!,"prompted for the UNITS PER DOSE for the item."
- +2 QUIT
- ENIVUD(PSJORD) ;
- +1 ;Determine if user should be prompted to transfer the order to IV.
- +2 ; INPUT: PSJORD - IEN in 53.1_order location code.
- +3 ; OUTPUT: 1 - Order not transferred, process as always.
- +4 ; 0 - User selected to transfer order and quit upon return.
- +5 ;
- +6 NEW DIR,DIRUT,PSJCOI,PSJND0,Y
- +7 SET PSJND0=$GET(^PS(53.1,+PSJORD,0))
- SET PSJCOI=+$GET(^PS(53.1,+PSJORD,.2))
- +8 IF $PIECE(PSJND0,U,4)="F"
- QUIT 1
- +9 DO FULL^VALM1
- +10 IF $SELECT($PIECE(PSJND0,U,24)="R":1,1:'$PIECE(PSJND0,U,13))
- QUIT 1
- +11 SET DIR(0)="SAB^I:IV;U:UNIT DOSE"
- SET DIR("A")="COMPLETE THIS ORDER AS IV OR UNIT DOSE? "
- SET DIR("B")=$SELECT($PIECE(PSJND0,U,4)="I":"IV",1:"UNIT DOSE")
- +12 SET DIR("??")="^D THELP^PSGOEF1("""_$SELECT(DIR("B")="IV":"UNIT DOSE",1:"IV")_""","_PSJCOI_")"
- +13 DO ^DIR
- KILL DIR
- +14 IF $DATA(DTOUT)!$DATA(DUOUT)
- QUIT 0
- +15 IF Y="I"
- Begin DoDot:1
- +16 IF +PSJSYSU=1
- IF '$GET(PSJIRNF)
- WRITE !!!!,"You need the PSJI RNFINISH key to finish this order as IV!"
- DO PAUSE^VALM1
- SET VALMBCK="R"
- QUIT
- +17 DO IV^PSJLIFNI(PSJORD,PSJCOI)
- End DoDot:1
- QUIT 0
- +18 IF Y="U"
- Begin DoDot:1
- +19 IF +PSJSYSU=1
- IF '$GET(PSJRNF)
- WRITE !!!!,"You need the PSJ RNFINISH key to finish this order as Unit Dose!"
- DO PAUSE^VALM1
- SET VALMBCK="R"
- QUIT
- +20 IF $GET(PSJITECH)
- IF ($PIECE(PSJSYSU,";",3)'=3)
- WRITE !!!!,"You may not finish this order as Unit Dose!"
- DO PAUSE^VALM1
- SET VALMBCK="R"
- QUIT
- +21 DO ENUD^PSGOEF1(PSJORD,PSJCOI)
- End DoDot:1
- QUIT 0
- +22 QUIT 1
- +23 ;
- ENUD(PSJORD,PSGPD) ;
- +1 NEW PSJTUD
- SET PSJTUD=1
- SET DFN=$PIECE($GET(^PS(53.1,+PSJORD,0)),U,15)
- +2 KILL DRG,DRGOC,DRGT,DRGTMP,ERR,ON,ON55,P,PSJSTAR,PSJTIM,UL80
- +3 DO DISACTIO^PSJOE(DFN,PSJORD,$GET(PSJPNV))
- SET VALMBCK="Q"
- +4 IF +$GET(PSGORQF)
- SET VALMBCK="R"
- +5 QUIT
- THELP(PKG,COI) ;
- +1 WRITE !,"Choose the package this order should be completed as a IV or Unit Dose order",!
- +2 QUIT
- +3 ;
- ENCKDD(PSGP,PSJDRG) ;
- +1 ;If the OI is edited, the OC is done in ^PSGOEE (PSGOE8 - Non-VFY; PSGOE9 - Active)
- +2 if $GET(PSGOEER)["101^PSGOE8"
- QUIT
- +3 if $GET(PSGOEER)["101^PSGOE9"
- QUIT
- +4 NEW DRG
- +5 SET PSGORQF=0
- +6 DO ENDDC^PSGSICHK(PSGP,PSJDRG)
- if $GET(PSGORQF)
- QUIT
- +7 DO IN^PSJOCDS($GET(PSGORD),"UD",+PSJDRG)
- +8 QUIT