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

ORKPS1.m

Go to the documentation of this file.
  1. ORKPS1 ; SLC/CLA - Order checking support procedures for medications ; Aug 31, 2023@13:07:24
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**232,272,346,352,345,311,402,457,469,481,578,605**;Dec 17, 1997;Build 4
  1. ;
  1. ; Reference to ^PS(53.1 in ICR #2907
  1. ; Reference to ZERO^PSS50P7 in ICR #4662
  1. Q
  1. PROCESS(OI,DFN,ORKDG,ORPROSP,ORGLOBL) ;process data from pharmacy order check API
  1. ;ORPROSP = pharmacy orderable item ien [file #50.7] ^ drug ien [file #50]
  1. ; NOTE: PIECE 1 WILL ONLY BE FILLED IN FOR ORDERABLE ITEMS THAT RESOLVE TO SUPPLY ITEMS
  1. Q:'$D(^TMP($J))
  1. N II,XX,ZZ,ZZD,ORMTYPE,ORN,ORZ,RCNT,GL,I,J,K,L,M,TDATA,VADMVT,ORX,ORY
  1. S II=1,XX=0,ZZ="",ZZD="",RCNT=0
  1. I $G(^TMP($J,ORGLOBL,"OUT",0))<0 D Q
  1. .S YY(II)="ERR^Drug-Drug order checks (Duplicate Therapy, Duplicate Drug, Drug Interaction) were not able to be performed. "_$P($G(^TMP($J,ORGLOBL,"OUT",0)),U,2)
  1. .S II=II+1
  1. I $D(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS")) D
  1. .S ORX="" F S ORX=$O(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS",ORX)) Q:'$L(ORX) D
  1. ..S ORY=0 F S ORY=$O(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS",ORX,ORY)) Q:'ORY D
  1. ...I $L($G(ORIFN))>0,$G(ORIFN)=$P($G(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS",ORX,ORY)),U,5) Q
  1. ...S YY(II)="ERR^"_$P($G(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS",ORX,ORY)),U,7)
  1. ...I $L($P($G(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS",ORX,ORY)),U,10))>0 S YY(II)=YY(II)_"("_$P($G(^TMP($J,ORGLOBL,"OUT","EXCEPTIONS",ORX,ORY)),U,10)_")"
  1. ...S II=II+1
  1. S ORX="" F ORX="DRUGDRUG","THERAPY" D
  1. .Q:'$D(^TMP($J,ORGLOBL,"OUT",ORX,"ERROR"))
  1. .S ORY="" F S ORY=$O(^TMP($J,ORGLOBL,"OUT",ORX,"ERROR",ORY)) Q:'$L(ORY) D
  1. ..S ORZ=0 F S ORZ=$O(^TMP($J,ORGLOBL,"OUT",ORX,"ERROR",ORY,ORZ)) Q:'ORZ D
  1. ...S YY(II)="ERR^"_$$UPPER^ORWDPS32($G(^TMP($J,ORGLOBL,"OUT",ORX,"ERROR",ORY,ORZ,"SEV")))_": "_$P($G(^TMP($J,ORGLOBL,"OUT",ORX,"ERROR",ORY,ORZ,0)),U)_" - "_$G(^TMP($J,ORGLOBL,"OUT",ORX,"ERROR",ORY,ORZ,"TEXT"))
  1. ...S II=II+1
  1. I +$P(ORPROSP,U,2) D
  1. .;set info about the drug being ordered
  1. .S TDATA("NEW","TXT")=""
  1. .S I="" F S I=$O(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",I)) Q:'$L(I) D
  1. ..I $P($G(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",I)),U,5)=+$G(ORIFN),$P($G(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",I)),U,3)=(+$P(ORPROSP,U,2)) D
  1. ...S TDATA("NEW","TXT")=$P($G(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",I)),U,4)
  1. ...S TDATA("NEW","PROSP")=$P(I,";",3,4)
  1. .;if we get here and we don't have anything in TDATA("NEW","PROSP") then we need to set to the first PROSPECTIVE
  1. .I '$L($G(TDATA("NEW","PROSP"))) D
  1. ..S I="" F S I=$O(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",I)) Q:'$L(I) I $P($G(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",I)),U,3)=(+$P(ORPROSP,U,2)) D
  1. ...S TDATA("NEW","TXT")=$P($G(^TMP($J,ORGLOBL,"IN","PROSPECTIVE",I)),U,4)
  1. ...S TDATA("NEW","PROSP")=$P(I,";",3,4)
  1. .;/////////////////GET PTYPE RIGHT///////////////////
  1. .S TDATA("NEW","OTYPE")=$S($G(ORKDG)="PSI":"UD",$G(ORKDG)="PSO":"OP",$G(ORKDG)="PSIV":"IV",$G(ORKDG)="PSH":"NV",1:"")
  1. .;initially base PTYPE on display group
  1. .S TDATA("NEW","PTYPE")=$S($G(ORKDG)="PSI":"I",$G(ORKDG)="PSO":"O",$G(ORKDG)="PSIV":"I",$G(ORKDG)="PSH":"O",1:"")
  1. .;if we have an order number then we can accurately determine if it is a Clinic med or not
  1. .I +$G(ORIFN) D
  1. ..I $$ISCLIN(+$G(ORIFN)) S TDATA("NEW","PTYPE")="C" Q
  1. .;if we don't have an order number then if the patient is an outpatient and the OTYPE is UD or IV we assume Clinic med
  1. .I '(+$G(ORIFN)) D
  1. ..I ($G(TDATA("NEW","OTYPE"))="UD")!($G(TDATA("NEW","OTYPE"))="IV") D
  1. ...I $$PATTYPE(DFN)="O" S TDATA("NEW","PTYPE")="C"
  1. .;if PTYPE not set at this point, set it to patient type (catch all for safety)
  1. .I '$L(TDATA("NEW","PTYPE")) D
  1. ..S TDATA("NEW","PTYPE")=$$PATTYPE(DFN)
  1. .;/////////////////END GET PTYPE RIGHT///////////////////
  1. D DD(.TDATA,$S(+ORPROSP>0:0,1:1))
  1. Q:'$L($G(TDATA("NEW","PROSP")))
  1. D DI(.TDATA)
  1. D DT(.TDATA)
  1. Q
  1. ;
  1. DI(TDATA) ;add drug interaction checks
  1. N GL,ORSEV,ORDRUG,ORTXT,ORIEN
  1. S GL=$NA(^TMP($J,ORGLOBL,"OUT","DRUGDRUG"))
  1. S J="" F S J=$O(@GL@(J)) Q:'$L(J) D
  1. .S K="" F S K=$O(@GL@(J,K)) Q:'$L(K) D
  1. ..S L=0 F S L=$O(@GL@(J,K,L)) Q:'$L(L) D
  1. ...S M=0 F S M=$O(@GL@(J,K,L,M)) Q:'M D
  1. ....N ORNUM,ORSEV,ORDNAME,ORZ,CNT,ORSTAT,ORMON,ORWHICH,ORLINE,ORIDX
  1. ....;get the associated order number
  1. ....S ORNUM=$P(L,";",1,2)
  1. ....;if the status of the associated order is DISCONTINUED then don't add
  1. ....S ORSTAT=$$PHSTAT(DFN,ORNUM)
  1. ....Q:ORSTAT="DISCONTINUED"
  1. ....S ORWHICH=""
  1. ....I $P($P(@GL@(J,K,L,M),U),";",3,4)=TDATA("NEW","PROSP") D
  1. .....S ORWHICH=K_" ["_$S($P(L,";",3)="PROSPECTIVE":"UNRELEASED",1:ORSTAT)_"]"
  1. ....I $P(L,";",3,4)=TDATA("NEW","PROSP") D
  1. .....S ORWHICH=$P(@GL@(J,K,L,M),U,4)_" ["
  1. .....S ORWHICH=ORWHICH_$S($P($P(@GL@(J,K,L,M),U),";",3)="PROSPECTIVE":"UNRELEASED",1:$$PHSTAT(DFN,$P($P(@GL@(J,K,L,M),U),";",1,2)))
  1. .....S ORWHICH=ORWHICH_"]"
  1. ....Q:$L(ORWHICH)<2
  1. ....;get text
  1. ....S ORTXT(J,K_";"_ORNUM)=$S($G(ORTXT(J,K))'="":ORTXT(J,K)_" ",1:"")_$P($G(@GL@(J,K,L,M,"CLIN")),"CLINICAL EFFECTS: ",2),ORTXT(J,K_";"_ORNUM,"ORWHICH")=ORWHICH ;*457
  1. ....;set the monograph into the temp global
  1. ....I $D(@GL@(J,K,L,M,"PMON")) D
  1. .....S ^TMP($J,"ORMONOGRAPH")=1+$G(^TMP($J,"ORMONOGRAPH"))
  1. .....S ORMON=^TMP($J,"ORMONOGRAPH")
  1. .....S ^TMP($J,"ORMONOGRAPH",ORMON,"INT")=@GL@(J,K,L,M,"INT")
  1. .....S ORIDX="",ORLINE=1 F S ORIDX=$O(@GL@(J,K,L,M,"PMON",ORIDX)) Q:+$G(ORIDX)=0 D
  1. ......S ^TMP($J,"ORMONOGRAPH",ORMON,"DATA",ORLINE,0)=@GL@(J,K,L,M,"PMON",ORIDX,0),ORLINE=ORLINE+1
  1. .....S ORTXT(J,K_";"_ORNUM,"MONOGRAPH")=1,ORTXT(J,K_";"_ORNUM,"ORMON",ORMON)="" ;*457
  1. ....;get the severity
  1. ....S ORSEV=$$UPPER^ORU($G(@GL@(J,K,L,M,"SEV")))
  1. ....;get the drug name
  1. ....S ORDNAME=K
  1. ....S ORTXT(J,K_";"_ORNUM,"YY")="DI^"_ORSEV_U_ORNUM_U_ORDNAME_U_U_$G(@GL@(J,K,L,M,"INT")) ;*457
  1. ;RETURN DATA IN EXPECTED FORMAT
  1. S ORSEV="" F S ORSEV=$O(ORTXT(ORSEV)) Q:$G(ORSEV)="" D
  1. .S ORDRUG="" F S ORDRUG=$O(ORTXT(ORSEV,ORDRUG)) Q:$G(ORDRUG)="" D
  1. ..S YY(II)=ORTXT(ORSEV,ORDRUG,"YY")
  1. ..S $P(YY(II),U,5)=TDATA("NEW","TXT")_" and "_ORTXT(ORSEV,ORDRUG,"ORWHICH")_" - "_ORTXT(ORSEV,ORDRUG)
  1. ..S ORIEN=0 F S ORIEN=$O(ORTXT(ORSEV,ORDRUG,"ORMON",ORIEN)) Q:+$G(ORIEN)=0 D
  1. ...S ^TMP($J,"ORMONOGRAPH",ORIEN,"OC")=$P(YY(II),U,5)
  1. ..S:$G(ORTXT(ORSEV,ORDRUG,"MONOGRAPH")) $P(YY(II),U,5)=$P(YY(II),U,5)_" - Monograph Available"
  1. ..S II=II+1
  1. Q
  1. ;
  1. DD(TDATA,ORDPROSP) ;add duplicate drug checks
  1. ;ORDPROSP: PERFORM PROSPECTIVE DRUG CHECK
  1. ; 1 FOR YES
  1. ; 0 FOR NO
  1. S XX=0,ZZ=""
  1. F S XX=$O(^TMP($J,"DD",XX)) Q:XX<1 D
  1. .N ORREM
  1. .S ZZ=$G(^TMP($J,"DD",XX,0)),ORMTYPE=$P($P(ZZ,U,4),";",2)
  1. .S ORREM=$P($P(ZZ,U,4),";") I (ORREM["Z"),$D(^TMP($J,ORGLOBL,"OUT","REMOTE",+ORREM)) D
  1. ..N ORTXT,ORREM1,ORREMSIG
  1. ..S ORREM1=$G(^TMP($J,ORGLOBL,"OUT","REMOTE",+ORREM))
  1. ..S ORREMSIG=$G(^TMP($J,ORGLOBL,"OUT","REMOTE",+ORREM,"SIG",0))
  1. ..S ORTXT=" "_ORREMSIG_" ["_$P(ORREM1,U,4)_" - Last Fill: "_$P(ORREM1,U,6)_" Quantity Dispensed: "_$P(ORREM1,U,8)_"] >>"_$P(ORREM1,U)
  1. ..S $P(ZZ,U,2)=$P(ZZ,U,2)_ORTXT
  1. .I +ORDPROSP,$G(TDATA("NEW","PTYPE"))'=$G(ORMTYPE) Q
  1. .S ORN=$P($P(ZZ,U,3),";"),ORZ=""
  1. .I $L($G(ORN))>0,+$G(ORN)=+$G(ORIFN) Q ;QUIT if dup med ord # = current ord #
  1. .I +$G(ORIFN),+$G(ORN)=$P(^OR(100,+ORIFN,3),U,5) Q ;QUIT if dup med ord # = the current order #'s REPLACED ORDER (changing an order)
  1. .I +ORDPROSP,+$P(ORPROSP,U,2)'=+ZZ Q
  1. .I $L(ORN),$D(^OR(100,ORN,8,0)) S ORZ=^OR(100,ORN,8,0)
  1. .I $L($G(ORZ)),($P(^OR(100,ORN,8,$P(ORZ,U,3),0),U,2)="DC") Q
  1. .I $L(ORN),$P(^ORD(100.01,$P(^OR(100,ORN,3),U,3),0),U)="DISCONTINUED" Q
  1. .I ZZ'="" S YY(II)="DD^"_ZZ,II=II+1
  1. .S ^TMP($J,"DD",XX,"OC")="" ;set this if this DD entry turned into an OC
  1. Q
  1. ;
  1. DT(TDATA) ;add duplicate therapy checks
  1. N I,GL
  1. S GL=$NA(^TMP($J,ORGLOBL,"OUT","THERAPY"))
  1. S I=0 F S I=$O(@GL@(I)) Q:'I D
  1. .N ORDRUGS,J,ORCLASS,ORNUM,ORRETSTR,ORPROSIN S ORPROSIN=0,ORDRUGS="",ORCLASS=""
  1. .S J=0 F S J=$O(@GL@(I,"DRUGS",J)) Q:'J D
  1. ..;get the type of the item checked against
  1. ..N ORPTYPE S ORPTYPE=$P($G(@GL@(I,"DRUGS",J)),U,5)
  1. ..;check if item being checked is a clinic med/inf
  1. ..I $E(@GL@(I,"DRUGS",J))="C" S ORPTYPE="C"
  1. ..;get if the item checked against is PROSPECTIVE or PROFILE
  1. ..N ORDTYPE S ORDTYPE=$P($G(@GL@(I,"DRUGS",J)),";",3)
  1. ..;if the item checked against is a PROSPECTIVE then get its type from file 100
  1. ..I ORDTYPE="PROSPECTIVE" D
  1. ...N ORXNUM S ORXNUM=+$P($G(@GL@(I,"DRUGS",J)),U,4)
  1. ...I ORXNUM D
  1. ....N ORKDGIEN S ORKDGIEN=$P($G(^OR(100,ORXNUM,0)),U,11)
  1. ....N ORKDG S ORKDG=$P($G(^ORD(100.98,ORKDGIEN,0)),U,3)
  1. ....S ORPTYPE=$S($G(ORKDG)="UD RX":"I",$G(ORKDG)="I RX":"I",$G(ORKDG)="IV RX":"I",$G(ORKDG)="CI RX":"C",$G(ORKDG)="CL OR":"C",$G(ORKDG)="C RX":"C",$G(ORKDG)="C RX":"C",1:"O")
  1. ..;consider Remote orders in the DRUGS array to be outpatient orders
  1. ..I ORPTYPE="R" S ORPTYPE="O"
  1. ..;if this is the prospective we are checking, set ORPROSIN=1 to indicate the one we are looking at is in this OC from the API
  1. ..I $G(TDATA("NEW","PROSP"))=$P($P($G(@GL@(I,"DRUGS",J)),U),";",3,4) S ORPROSIN=1
  1. ..;if neither the item being checked and the item checked against are not Clinic meds and they do not match in type, don't use it
  1. ..I ($G(TDATA("NEW","PTYPE"))'=ORPTYPE),(ORPTYPE'="C"),($G(TDATA("NEW","PTYPE"))'="C") Q
  1. ..;if this matches the replacement order of the item being checked against, don't use it
  1. ..I $L($P($G(@GL@(I,"DRUGS",J)),U,4))>0,(+$P($G(@GL@(I,"DRUGS",J)),U,4)=$P($G(^OR(100,+$G(ORIFN),3)),U,5)) Q
  1. ..;if this matches the order number of the item being checked against, don't use it
  1. ..I $L($P($G(@GL@(I,"DRUGS",J)),U,4))>0,(+$P($G(@GL@(I,"DRUGS",J)),U,4)=+$G(ORIFN)) Q
  1. ..;if this is the prospective we are checking, don't use it
  1. ..I $G(TDATA("NEW","PROSP"))=$P($P($G(@GL@(I,"DRUGS",J)),U),";",3,4) Q
  1. ..;if we got here then this order from the DRUGS array should be in the output message
  1. ..S ORNUM=$P($P($G(@GL@(I,"DRUGS",J)),U),";",1,2)
  1. ..;OR*3.0*578 begin - check for pending clinic or inpatient orders
  1. ..; with free text dosages (i.e. no dispense drug).
  1. ..N ORDRUGX
  1. ..S ORDRUGX=$P($G(@GL@(I,"DRUGS",J)),U,3)
  1. ..I $E(ORNUM)="C"!($E(ORNUM)="I") D
  1. ...N OR531,OIIEN
  1. ...S OR531=$P(ORNUM,";",2) Q:OR531'["P"
  1. ...I $O(^PS(53.1,+OR531,1,0)) Q
  1. ...;no dispense drug, so display only name and dosage type (TAB, etc.)
  1. ...S OIIEN=$$GET1^DIQ(53.1,+OR531,108,"I")
  1. ...D ZERO^PSS50P7(OIIEN,,,"OID")
  1. ...S ORDRUGX=$G(^TMP($J,"OID",OIIEN,.01))_" "_$P($G(^TMP($J,"OID",OIIEN,.02)),U,2)
  1. ...K ^TMP($J,"OID")
  1. ..S ORDRUGS=ORDRUGS_$S($L(ORDRUGS):", ",1:"")_ORDRUGX_" ["_$$PHSTAT(DFN,ORNUM)_"]"
  1. ..;OR*3.0*578 end
  1. .;quit if no drugs have been set into ORDRUGS
  1. .Q:('$L(ORDRUGS))
  1. .;quit if ORPROSIN is still 0 which means the prospective we are looking at was not part of this OC returned from the API
  1. .Q:'ORPROSIN
  1. .;get all classes
  1. .S J=0 F S J=$O(@GL@(I,J)) Q:'J D
  1. ..S ORCLASS=ORCLASS_$S($L(ORCLASS):", ",1:"")_$G(@GL@(I,J,"CLASS"))
  1. .;assemble return string ("DC"+ORNUM_U_Classes_U_Classes (drugs))
  1. .S ORRETSTR="Duplicate Therapy: Order(s) exist for {"_ORDRUGS_"} in the same therapeutic categor(ies): "_ORCLASS
  1. .S YY(II)="DC"_U_$G(ORNUM)_U_ORCLASS_U_ORRETSTR,II=II+1
  1. Q
  1. ;
  1. PHSTAT(DFN,ORNUM) ;get the status of the order
  1. N RET,J,I
  1. S RET=""
  1. I $P(ORNUM,";")="P" S RET="PENDING"
  1. I $P(ORNUM,";")="N" S RET="ACTIVE NON-VA"
  1. I $P(ORNUM,";")="O" D
  1. .N ORLAST
  1. .I $E($P(ORNUM,";"),1)="C" S ORLAST=$S($E($P(ORNUM,";"),2)=1:"V",$E($P(ORNUM,";"),2)=2:"U",1:"NV")
  1. .E S ORLAST=$E(ORNUM,$L(ORNUM))
  1. .I $L(ORNUM)=1,ORLAST="0" S RET="UNRELEASED" Q
  1. .I ORLAST="P" S RET="PENDING" Q
  1. .K ^TMP($J,"OROCLST") D RX^PSO52API(DFN,"OROCLST",$P(ORNUM,";",2),,"ST")
  1. .S RET=$P($G(^TMP($J,"OROCLST",DFN,$P(ORNUM,";",2),100)),U,2)
  1. .K ^TMP($J,"OROCLST")
  1. I $P(ORNUM,";")="I"!($E($P(ORNUM,";"),1)="C") D
  1. .N ORLAST,ORPHNUM
  1. .I $E($P(ORNUM,";"),1)="C" S ORLAST=$S($E($P(ORNUM,";"),2)=1:"V",$E($P(ORNUM,";"),2)=2:"U",1:"NV")
  1. .E S ORLAST=$E(ORNUM,$L(ORNUM))
  1. .I ORLAST="0" S RET="UNRELEASED" Q
  1. .I ORLAST="P" S RET="PENDING" Q
  1. .S ORPHNUM=+$P(ORNUM,";",2)
  1. .I ORLAST="U" D
  1. ..K ^TMP($J,"OR GET STATUS") D PSS431^PSS55(DFN,ORPHNUM,"","","OR GET STATUS")
  1. ..S RET=$P($G(^TMP($J,"OR GET STATUS",ORPHNUM,28)),U,2)
  1. .I ORLAST="V" D
  1. ..K ^TMP($J,"OR GET STATUS") D PSS436^PSS55(DFN,ORPHNUM,"OR GET STATUS")
  1. ..S RET=$P($G(^TMP($J,"OR GET STATUS",ORPHNUM,100)),U,2)
  1. .I ORLAST="NV" D
  1. ..K ^TMP($J,"OR GET STATUS") D PSJ^PSJ53P1(ORPHNUM,"OR GET STATUS")
  1. ..S RET=$P($G(^TMP($J,"OR GET STATUS",ORPHNUM,28)),U,2)
  1. .S:$E($P(ORNUM,";"),1)="C" RET=RET_" CLINIC ORDER"
  1. I $P(ORNUM,";")="R" D
  1. .N ORREMOTE S ORREMOTE=$G(^TMP($J,ORGLOBL,"OUT","REMOTE",$P(ORNUM,";",2)))
  1. .S RET=$P(ORREMOTE,U,4)_" >> "_$P(ORREMOTE,U)
  1. I "^PENDING^NON-VERIFIED^NON VERIFIED^INCOMPLETE^DRUG INTERACTIONS^"[(U_RET_U) S RET="PENDING"
  1. Q RET
  1. ;
  1. ISCLIN(ORNUM) ;check if the order number is a clinic order
  1. N ORRET
  1. D IMOOD^ORIMO(.ORRET,+ORNUM)
  1. Q ORRET
  1. ;
  1. PATTYPE(DFN) ;return if patient is Inpatient "I" or Outpatient "O"
  1. N ORRET
  1. D ADM^VADPT2
  1. S ORRET=$S(+$G(VADMVT)>0:"I",1:"O")
  1. K VADMVT
  1. Q ORRET
  1. ;