Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJLIFN

PSJLIFN.m

Go to the documentation of this file. 
  1. PSJLIFN ;BIR/MV - IV FINISH USING LM ;Jun 17, 2020@15:43:29
  1.  ;;5.0;INPATIENT MEDICATIONS ;**1,29,34,37,42,47,50,56,94,80,116,110,181,261,252,313,333,256,380,399**;16 DEC 97;Build 64
  1.  ;
  1.  ; Reference to ^PS(51.2 is supported by DBIA #2178.
  1.  ; Reference to ^PS(52.6 supported by DBIA #1231.
  1.  ; Reference to ^PS(52.7 supported by DBIA #2173.
  1.  ; Reference to ^PSDRUG( is supported by DBIA #2192.
  1.  ; Reference to ^PSOORDRG is supported by DBIA #2190.
  1.  ; Reference to ^%DT is supported by DBIA #10003.
  1.  ; Reference to ^VALM is supported by DBIA #10118.
  1.  ; Reference to ^VALM1 is supported by DBIA #10116.
  1.  ; Reference to RE^VALM4 is supported by DBIA #10120.
  1.  ;
  1. EN ; Display order with numbers.
  1.  L +^PS(53.1,+PSJORD):1 I '$T W !,$C(7),$C(7),"This order is being edited by another user. Try later." D PAUSE^VALM1 Q
  1.  NEW PSJOCFG
  1.  S PSJOCFG="FN IV"
  1.  D PENDING K PSJREN,PSJOCFG
  1.  L -^PS(53.1,+PSJORD)
  1.  Q
  1. PENDING ; Process pending order.
  1.  ;* PSIVFN1 is used so it will display the AC/Edit screen
  1.  ;* instead of go to the "IS this O.K." prompt
  1.  ;* PSIVACEP only when accept the order. Original screen won't redisp.
  1.  ;* PSJLMX is defined in WRTDRG^PSIVUTL and it was being call in PSJLIVMD & PSJLIVFD
  1.  ;*        to count # of AD/SOL
  1.  NEW PSIVFN1,PSIVACEP,PSJLMX,PSIVOI,PSJOCCHK,PSJFNDS
  1.  K PSJIVBD ;This variable was left over from the new backdoor order entry.
  1.  ; PSJOCCHK is set so if EDIT was use instead of FN to finish order the OC is triggered
  1.  S PSJOCCHK=1
  1.  ;* PSJFNDS is set so dosing is trigger during finishing without changes to the add/sol
  1.  S PSJFNDS=1
  1.  S PSIVAC="CF" S (P("PON"),ON)=+PSJORD_"P",DFN=PSGP
  1.  S PSIVUP=+$$GTPCI^PSIVUTL D GT531^PSIVORFA(DFN,ON)
  1.  D:'$D(P("OT")) GTOT^PSIVUTL(P(4))
  1.  NEW PSJL
  1.  N PSIVNUM,PSJSTAR S PSIVNUM=1
  1.  Q:ON'=PSJORD
  1.  I $G(PSJLYN)]"" Q:ON'=PSJLYN
  1.  S PSJMAI=ON
  1.  I P("OT")="I" D  Q
  1.  . S PSJSTAR="(5)^(7)^(9)^(10)"
  1.  . D EN^VALM("PSJ LM IV INPT PENDING") ;; ^PSJLIVMD
  1.  S PSJSTAR="(1)^(2)^(3)^(5)^(7)^(9)"
  1.  D GTDATA D EN^VALM("PSJ LM IV PENDING") ;; ^PSJLIVFD
  1.  K PSJMAI Q
  1.  ;
  1. DISPLAY ;
  1.  S VALMSG="Press Return to continue"
  1.  D:$E(P("OT"))="I" EN^VALM("PSJ LM IV INPT DISPLAY")
  1.  D:$E(P("OT"))'="I" EN^VALM("PSJ LM IV DISPLAY")
  1.  K PSJDISP
  1.  S:'$G(PSJHIS) VALMBCK=""
  1.  Q
  1. GTDATA ;
  1.  ;* D:P(4)="" 53^PSIVORC1 Q:P(4)=""  S P("DTYP")=$S(P(4)="":0,P(4)="P"!(P(23)="P")!(P(5)):1,P(4)="H":2,1:3)
  1.  S P("DTYP")=$S(P(4)="":0,P(4)="P"!(P(23)="P")!(P(5)):1,P(4)="H":2,1:3)
  1.  I 'P(2) D
  1.  .I P("RES")="R" S PSJREN=1
  1.  .D ENT^PSIVCAL K %DT S X=P(2),%DT="RTX" D ^%DT S P(2)=+Y
  1.  I 'P(3) D ENSTOP^PSIVCAL K %DT S X=P(3),%DT="RTX" D ^%DT S P(3)=+Y
  1.  I 'P("MR") S P("MR")=$O(^PS(51.2,"B","INTRAVENOUS",0))_"^IV"
  1.  Q
  1. FINISH ; Prompt for missing data
  1.  ;* Ord chk for Inpat. pending only. Pend renew should not be checked.
  1.  ;* PSIVOCON needed so this order will be excluded from the order
  1.  ;*          list(ORDCHK^PSJLMUT1)
  1.  ;* PSGORQF defined means cancel the order due to order check.
  1.  ;Q:'$$LS^PSSLOCK(DFN,PSJORD)
  1.  N PSJCOM,PSIVEDIT,PSJOLDNM,PSIVCAL
  1.  S PSJCOM=+$P($G(^PS(53.1,+PSJORD,.2)),"^",8)
  1.  K PSJIVBD,PSGRDTX,PSIVEDIT
  1.  N FIL,PSIVS,DRGOC,PSIVXD,DRGTMP,PSIVOCON,PSGORQF,ON55,NSFF K PSGORQF S NSFF=1
  1.  S (ON,PSIVOCON,ON55,PSGORD)=PSJORD D GTDRG^PSIVORFA Q:PSJORD'=PSJMAI  I $G(PSJLYN)]"" Q:PSJORD'=PSJLYN
  1.  D UDVARS^PSJLIORD
  1.  I $G(PSJPROT)=3,'$$ENIVUD^PSGOEF1(PSJORD) K NSFF Q
  1.  D HOLDHDR^PSJOE
  1.  ;PRE UAT group requested to not show the second screen since FDB OC has more text and provider override reason appears after 2nd screen
  1.  ; force the display of the second screen if CPRS order checks exist
  1.  ;I $O(^PS(53.1,+PSJORD,12,0))!$O(^PS(53.1,+PSJORD,10,0)) D
  1.  ;.Q:$G(PSJLMX)=1   ;no second screen to display
  1.  ;.S VALMBG=16 D RE^VALM4,PAUSE^VALM1 S VALMBG=1
  1.  S P("OPI")=$$ENPC^PSJUTL("V",+PSIVUP,60,P("OPI"))
  1.  ;I $E(P("OT"))="I" D GTDATA Q:P(4)=""
  1.  ;I $E(P("OT"))="I",'$D(DRG("AD")),('$D(DRG("SOL"))) D
  1.  I $G(P("RES"))'="R" D 53^PSIVORC1
  1.  I $G(P(4))]"",$G(P(15))]"",$G(P(9))]"",$$SCHREQ^PSJLIVFD(.P) D  Q:$G(PSGORQF)
  1.  . ;*** PSJ*5*256
  1.  . S PSJOLDNM("ORD_SCHD")=P(9)
  1.  . I $$CHKSCHD^PSJMISC2(.PSJOLDNM,$S($G(P("RES"))="R":"R",1:"")) S PSGORQF=1,VALMBCK="R" Q
  1.  . S:$G(PSJOLDNM("NEW_SCHD"))]"" P(9)=PSJOLDNM("NEW_SCHD")
  1.  . N PSGS0XT,X,PSJNSS S PSJNSS=1,X=P(9),PSGS0XT=P(15) D Q2^PSGS0
  1.  . I ON["P",$G(PSJOLDNM("NEW_SCHD"))]"" D
  1.  ..I $G(PSGS0Y)]"",$G(P(11))]"",(PSGS0Y'=PSJOLDNM("NEW_SCHD")) D
  1.  ...W $C(7),!!,"PLEASE NOTE:  This order's admin times (",P(11),") do not match the times"
  1.  ...W !?13," for this administration schedule (",PSJOLDNM("NEW_SCHD"),")",!
  1.  ...D PAUSE^VALM1
  1.  I P(4)="" D RE^VALM4 Q
  1.  I $E(P("OT"))="I" D GTDATA  D
  1.  . I '$D(DRG("AD")),('$D(DRG("SOL"))) S DNE=0 D GTIVDRG^PSIVORC2 S P(3)="" D ENSTOP^PSIVCAL
  1.  S VALMBG=1
  1.  I $E(P("OT"))="F" S DNE=0 I $G(PSGORQF) D RE^VALM4 Q
  1.  I $G(PSGORQF) S VALMBCK="R",P(4)="" K DRG Q
  1.  ; Will prompt users to choose Dispense IV Additive when more than one are available for the Orderable Item
  1.  N PSJQUIT S PSJQUIT=0 D MULTADDS I $G(PSJQUIT) S VALMBCK="R" Q
  1.  S PSIVEDIT=""
  1.  S PSIVOK="1^3^10^25^26^39^57^58^59^63^64" D CKFLDS^PSIVORC1 I EDIT]"" D EDIT^PSIVEDT
  1.  ;S PSIVOK="1^3^10^25^26^39^57^58^59^63^64" D CKFLDS^PSIVORC1 I EDIT]"" S PSIVEDIT=EDIT D EDIT^PSIVEDT
  1.  ;I $G(EDIT)="" D OC^PSIVOC D:'$G(PSGORQF) IN^PSJOCDS($G(ON),"IV","") Q:$G(PSGORQF)
  1.  I $D(PSIVEDIT) D OC^PSIVOC
  1.  ;PSJ*5*261 - Remedy #490875 PSPO 2040
  1.  D ENSTOP^PSIVCAL
  1.  ;D:'$G(PSGORQF) IN^PSJOCDS($G(ON),"IV","")
  1.   ;If quit then restore DRG( to pre-edit state
  1.  I $G(PSGORQF) D GT531^PSIVORFA(DFN,ON) Q
  1.  I $G(DONE) S VALMBCK="R" Q
  1.  ;* PSJFNDS is set so dosing is trigger during finishing without changes to the add/sol
  1.  ;S PSJFNDS=1
  1.  D COMPLTE^PSIVORC1
  1.  S:$G(PSIVACEP) VALMBCK="Q"
  1.  ;Reset PSJFNDS so if FN again, the dosing check is triggered.
  1.  S:'$G(PSIVACEP) PSJFNDS=1
  1.  I $G(PSGORQF) S VALMBG=1 D RE^VALM4
  1.  K NSFF
  1.  Q
  1.  ;
  1. MULTADDS ; If there are multiple IV Additives per Orderable Item, it will prompt for selection
  1.  N TMPDRG
  1.  S PSJQUIT=0
  1.  I $O(DRG("AD",0)) D  I PSJQUIT D SAVEDRG^PSIVEDRG(.DRG,.TMPDRG) Q
  1.  . D SAVEDRG^PSIVEDRG(.TMPDRG,.DRG)
  1.  . N PSIDX,OI,IVLIST
  1.  . F PSIDX=1:1 Q:'$D(DRG("AD",PSIDX))  D  I PSJQUIT Q
  1.  . . S OI=$P(DRG("AD",PSIDX),"^",6) I 'OI Q
  1.  . . K IVLIST D IVADDCNT(OI,.IVLIST) I $O(IVLIST(""),-1)'>1 Q
  1.  . . W !!,"More than one dispense IV Additives are available for:"
  1.  . . W !,"Orderable Item: ",$$GET1^DIQ(50.7,OI,.01)
  1.  . . W !,"  Ordered Dose: ",$P(DRG("AD",PSIDX),"^",3)
  1.  . . W !!,"Please select the correct dispense IV Additive below for this order:"
  1.  . . N DIR,IVADD,IVCNT,X,Y,DIRUT,DUOUT
  1.  . . S DIR("?")="Please select the correct dispense IV Additive below for this order:"
  1.  . . F IVCNT=1:1 Q:'$D(IVLIST(IVCNT))  D  I PSJQUIT Q
  1.  . . . S IVADD=IVLIST(IVCNT)
  1.  . . . S X="  "_IVCNT_"  "_$$GET1^DIQ(52.6,IVADD,.01)
  1.  . . . S $E(X,45)="Additive Strength: "_$S($$GET1^DIQ(52.6,IVADD,19)'="":$$GET1^DIQ(52.6,IVADD,19)_" "_$$GET1^DIQ(52.6,IVADD,2),1:"N/A")
  1.  . . . S DIR("A",IVCNT)=X
  1.  . . S DIR("A")="Select (1 - "_(IVCNT-1)_"): "
  1.  . . S DIR(0)="LA^1:"_(IVCNT-1) D ^DIR I $D(DUOUT)!$D(DIRUT) S PSJQUIT=1 Q
  1.  . . I (Y>0) D
  1.  . . . S $P(DRG("AD",PSIDX),"^",1,2)=+IVLIST(+Y)_"^"_$$GET1^DIQ(52.6,+IVLIST(+Y),.01)
  1.  . W !
  1.  Q
  1.  ;
  1. ORDCHK ;* Do order check for Inpatient Meds IV.
  1.  ; PSGORQF is defined (CONT^PSGSICHK) if not log an intervention
  1.  ; No longer use after PSJ*5*181
  1.  K PSGORQF
  1.  Q
  1.  ;NEW DRGOC
  1.  ;D OCORD Q:$G(PSGORQF)
  1.  ;D GTIVDRG^PSIVORC2 S P(3)="" D ENSTOP^PSIVCAL
  1. ORDCHKA ;* Do order check against existing orders on the profile
  1.  ;No longer use as of PSJ*5*181
  1.  Q
  1.  F PSIVAS="AD","SOL" Q:$G(PSGORQF)  S FIL=$S(PSIVAS="AD":52.6,1:52.7) D
  1.  . F PSIVX=0:0 S PSIVX=$O(DRG(PSIVAS,PSIVX)) Q:'PSIVX!($G(PSGORQF))  D
  1.  .. S DRGTMP=DRG(PSIVAS,PSIVX)
  1.  .. ;* Do only 1 duplicate warning when order has >1 of the same additive
  1.  .. Q:$D(PSJADTMP(+DRGTMP))
  1.  .. D ORDERCHK^PSIVEDRG(PSGP,ON,$D(DRGOC(ON)))
  1.  .. S DRGOC(ON,PSIVAS,PSIVX)=DRG(PSIVAS,PSIVX)
  1.  .. S PSJADTMP(+DRGTMP)=""
  1.  K PSJADTMP
  1.  Q
  1. OCORD ;* Do order check for each drug against the drugs within the order.
  1.  ;OCORD was called by ORDCHK.  This entry point is no longer use as of PSJ*5*181
  1.  Q
  1.  NEW X,Y,DDRUG,PSIVX,PSJAD,PSJSOL,TMPDRG
  1.  D SAVEDRG^PSIVEDRG(.TMPDRG,.DRG)
  1.  ; Find the corresponding DD for the additive within the order
  1.  F X=0:0 S X=$O(DRG("AD",X)) Q:'X  D
  1.  . S DDRUG=$P($G(^PS(52.6,+DRG("AD",X),0)),U,2)
  1.  . S:+DDRUG (DDRUG(DDRUG),PSJAD(DDRUG))=$D(DDRUG(DDRUG))+1
  1.  ;
  1.  ; Find the corresponding DD for the solution
  1.  ;
  1.  F X=0:0 S X=$O(DRG("SOL",X)) Q:'X  D
  1.  . S DDRUG=$P($G(^PS(52.7,+DRG("SOL",X),0)),U,2)
  1.  . S:+DDRUG (DDRUG(DDRUG),PSJSOL(DDRUG))=$D(DDRUG(DDRUG))+1
  1.  ;
  1.  ; Loop thru each additive to check for DD,DI & DC against the
  1.  ; order's dispense drugs
  1.  ;
  1.  NEW PSJDFN,INTERVEN S INTERVEN=""
  1.  S PSJDFN=DFN ;DFN will be killed when call ^PSOORDRG
  1.  F PSIVX=0:0 S PSIVX=$O(PSJAD(PSIVX)) Q:'PSIVX  D
  1.  . K DDRUG(PSIVX) D DRGCHK^PSOORDRG(PSJDFN,PSIVX,.DDRUG)
  1.  . I PSJAD(PSIVX)>1 S ^TMP($J,"DD",1,0)=PSIVX_U_$P($G(^PSDRUG(PSIVX,0)),U)_"^^"_ON_";I"
  1.  . NEW TYPE F TYPE="DD","DI","DC" D ORDCHK^PSJLIFNI(PSJDFN,TYPE)
  1.  F PSIVX=0:0 S PSIVX=$O(PSJSOL(PSIVX)) Q:'PSIVX  D
  1.  . K DDRUG(PSIVX) D DRGCHK^PSOORDRG(PSJDFN,PSIVX,.DDRUG)
  1.  . NEW TYPE F TYPE="DI" D ORDCHK^PSJLIFNI(PSJDFN,TYPE)
  1.  S DFN=PSJDFN
  1.  D SAVEDRG^PSIVEDRG(.DRG,.TMPDRG)
  1.  Q
  1.  ;
  1. IVADDCNT(OI,IVLIST) ; Returns the number of IV Addtives Associated to the OI and Marked for IV Order Dialog
  1.  ;Input: OI - PHARMACY ORDERABLE ITEM file (#50.7) IEN
  1.  ;Output: $$IVADDCNT - Number of IV Additives linked to the Orderable Item
  1.  ;        IVLIST(IV_IEN) - List of IV Additives linked to the Orderable Item
  1.  N IVADD,IVADDCNT
  1.  S IVADDCNT=0,IVADD=""
  1.  F  S IVADD=$O(^PS(52.6,"AOI",OI,IVADD)) Q:'IVADD  D
  1.  . ; Not Used in the IV Order Dialog
  1.  . I '$$GET1^DIQ(52.6,IVADD,17,"I") Q
  1.  . ; Other IV Solution is INACTIVE
  1.  . I $$GET1^DIQ(52.6,IVADD,12,"I"),($$GET1^DIQ(52.6,IVADD,12,"I")'>DT) Q
  1.  . ; Other IV Dispense Drug
  1.  . S IVADDCNT=IVADDCNT+1,IVLIST(IVADDCNT)=IVADD
  1.  Q