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

ORKCHK5.m

Go to the documentation of this file.
  1. ORKCHK5 ;SLC/CLA - SUPPORT ROUTINE FOR ACCEPT MODE ORDER CHECKS ;Aug 09, 2021@10:50:14
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,190,280,357,345,269,382,539,562,405**;Dec 17, 1997;Build 211
  1. ;
  1. ; Reference to ORCHK2^GMRAOR is supported by ICR #2378
  1. ; Reference to DS^PSSDSAPI is supported by ICR #5425
  1. ; Reference to ORDERCHK^PXRMORCH is supported by ICR #5531
  1. ;
  1. Q
  1. EN(ORKS,ORKDFN,ORKA,ORENT,ORKTMODE,OROIL,ORDODSG) ;perform order checking for orderable item acceptance
  1. ;ORDODSG: FLAG THAT DENOTES IF DOSAGE CHECKS SHOULD BE PERFORMED
  1. ; 1 FOR PERFORM DOSAGE CHECKS
  1. ; 0 FOR DO NOT PERFORM DOSAGE CHECKS
  1. Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE",1,"I")="D"
  1. ;
  1. N OI,ORKDG,HL7,ODT,ORNUM,HL7NPTR,HL7NTXT,HL7NCOD,HL7LPTR,HL7LTXT,HL7LCOD
  1. N OCN,DNGR,ORKMSG,ORKPDATA,ORKOCNUM
  1. ;
  1. S OI=$P(ORKA,"|"),ORKDG=$P(ORKA,"|",2),HL7=$P(ORKA,"|",3)
  1. S ODT=$P(ORKA,"|",4),ORNUM=$P(ORKA,"|",5),ORKPDATA=$P(ORKA,"|",6)
  1. S HL7NPTR=$P(HL7,U),HL7NTXT=$P(HL7,U,2),HL7NCOD=$P(HL7,U,3)
  1. S HL7LPTR=$P(HL7,U,4),HL7LTXT=$P(HL7,U,5),HL7LCOD=$P(HL7,U,6)
  1. I ORKDG="GMRC",'$L(ODT) S ODT=$$NOW^XLFDT ;def consult order d/t is now
  1. ;
  1. I $E(ORKDG,1,2)="PS" D PHARM
  1. I $E(ORKDG,1,2)'="PS",($E(ORKDG,1,2)'="LR"),($L($G(OI))),($L($G(ODT))),(ORKTMODE'="ALL") D DUPOR
  1. I $E(ORKDG,1,2)="LR",($L($G(OI))),($L($G(ODT))),(ORKTMODE'="ALL") D
  1. .D DUPLAB
  1. .D LABFREQ
  1. I $E(ORKDG,1,2)'="PS" D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
  1. D:ORKMODE'="ALLERGY" REMCHK(.ORKS,OI,ORKDFN) ;do reminder order checks
  1. Q
  1. ;
  1. PHARM ;process pharmacy order checks:
  1. N ORPSPKG,ORPSA,ORKDD
  1. N ORALLRN,ORALLRF,ORALLRD
  1. D PARAMS("ALLERGY-DRUG INTERACTION",.ORALLRN,.ORALLRF,.ORALLRD)
  1. ;
  1. D:+ORDODSG DSGCHK(.ORKS,ORKDFN,.OROIL,ORKA) ;do pharmacy dosage checks
  1. ;dispense drug selected:
  1. I $L($G(HL7LPTR)),($G(HL7LCOD)="99PSD") D
  1. .D:ORKMODE="ALLERGY"!(ORKMODE="ALLACC")!(ORKMODE="ACCEPT"&(ORKDG="PSIV")) RXOCS
  1. .D:ORKMODE'="ALLERGY"!(ORKMODE="ACCEPT"&(ORKDG="PSIV")) MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
  1. ;
  1. ;dispense drug NOT selected, split OI into dispense drugs:
  1. I '$L($G(HL7LPTR)) D
  1. .S ORPSPKG=$E(ORKDG,3)
  1. .I ORPSPKG="H" S ORPSPKG="X" ;change to "X" if "H"erbal/non-VA med
  1. .I "IOX"[ORPSPKG D OI2DD(.ORPSA,OI,ORPSPKG)
  1. .S ORKDD=0 F S ORKDD=$O(ORPSA(ORKDD)) Q:'ORKDD D
  1. ..S HL7LTXT=ORPSA(ORKDD)
  1. ..S HL7NPTR=$P(ORKDD,";",2)
  1. ..S HL7LPTR=+ORKDD
  1. ..S HL7LCOD="99PSD",HL7NCOD="99NDF"
  1. ..S $P(HL7,U)=HL7NPTR,$P(HL7,U,3)=HL7NCOD
  1. ..S $P(HL7,U,4)=HL7LPTR,$P(HL7,U,5)=HL7LTXT,$P(HL7,U,6)=HL7LCOD
  1. ..S $P(ORKA,"|",3)=HL7 ;set these for MLM OCX call
  1. ..D:ORKMODE="ALLERGY"!(ORKMODE="ALLACC")!(ORKMODE="ACCEPT"&(ORKDG="PSIV")) RXOCS
  1. ..D:ORKMODE'="ALLERGY"!(ORKMODE="ACCEPT"&(ORKDG="PSIV")) MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
  1. Q
  1. ;
  1. RXOCS ;drug-allergy interaction
  1. Q:ORALLRF="D"
  1. N DATA,J,DELIMIT,CRC16,FCOUNT,NUM
  1. Q:$$ORCHK2^GMRAOR(ORKDFN,"DR",$G(HL7NPTR)_$S($G(HL7NPTR)'[".":".",1:"")_"."_$G(HL7LPTR),,"DATA")<1
  1. F J=1:1:DATA D
  1. .N SIGN,GMRALLER,REACTANT,TEXT,ITM,ITEMS,NODE,COUNT,SEVERE,K,SITE,ORREMOTE,ORREMLST,MECH
  1. .S FCOUNT=2,GMRALLER=$P(DATA(J,"MESSAGE",2),U,3),REACTANT=$P(DATA(J,"MESSAGE",2),U,2),ORREMOTE=0,ORREMLST=""
  1. .;Previous [SEVERITY] adverse reaction
  1. .S K="" F S K=$O(DATA(J,K)) Q:K=""!(K'="MESSAGE")
  1. .I K'="" D
  1. ..S SITE=$P(DATA(J,K),U),SEVERE=$P(DATA(J,K),U,4),MECH=$P(DATA(J,K),U,11)
  1. ..I SEVERE'="" F ITM=1:1:$L(SEVERE,"~") I $P($P(SEVERE,"~",ITM),"|",2)>$G(SEVERE("MSG")) S SEVERE("MSG")=$P($P(SEVERE,"~",ITM),"|",2),SEVERE("MSG","NODE")=ITM
  1. .S ORKMSG="Previous "_$P(DATA(J,"MESSAGE",1,SITE),U,4)_" "_$S($G(SEVERE("MSG","NODE"))'="":$P(DATA(J,"MESSAGE",1,SITE,1,SEVERE("MSG","NODE")),U,2)_" ",1:"")_$S(MECH="A":"allergy ",MECH="P":"adverse reaction ",1:"unknown reaction ")
  1. .;to [GMR ALLERGY]
  1. .I GMRALLER="",(REACTANT'="") S GMRALLER=REACTANT
  1. .I GMRALLER'="" S ORKMSG=ORKMSG_"to "_GMRALLER_" "
  1. .;[[REACTANT]]
  1. .S ORKMSG=ORKMSG_$S(GMRALLER'=REACTANT:"["_REACTANT_"] ",1:"")
  1. .S ORKMSG=$P(ORKMSG,"[] ")
  1. .;(based on {INGREDIENT [DRUG_INGREDIENT]|DRUG CLASS [DRUG CLASS]|REACTANT [REACTANT]})
  1. .F NODE="ING","CLS","REC" I $D(DATA(J,"MESSAGE","OFFENDERS",NODE)) D
  1. ..S DELIMIT=", ",TEXT=""
  1. ..F ITM=1:1:$L(DATA(J,"MESSAGE","OFFENDERS",NODE),"~") D
  1. ...S:ITM=$L(DATA(J,"MESSAGE","OFFENDERS",NODE),"~") DELIMIT=" and "
  1. ...S TEXT=$S($G(TEXT)'="":TEXT_DELIMIT,1:"")_$P(DATA(J,"MESSAGE","OFFENDERS",NODE),"~",ITM)
  1. ..S TEXT(1)=$S(NODE="ING":"DRUG INGREDIENT",NODE="CLS":"DRUG CLASS",NODE="REC":"REACTANT",1:"")
  1. ..I TEXT[" and " S TEXT(1)=TEXT(1)_$S(NODE="CLS":"ES",1:"S")
  1. ..S TEXT("OUT")=$S($G(TEXT("OUT"))'="":TEXT("OUT")_"~",1:"")_TEXT(1)_" "_TEXT
  1. .S DELIMIT=", ",TEXT=""
  1. .F ITM=1:1:$L(TEXT("OUT"),"~") D
  1. ..S:ITM=$L(TEXT("OUT"),"~") DELIMIT=" and "
  1. ..S TEXT=$S($G(TEXT)'="":TEXT_DELIMIT,1:"")_$P(TEXT("OUT"),"~",ITM)
  1. .S:$G(TEXT)'="" ORKMSG=ORKMSG_"(based on "_TEXT_") "
  1. .;resulted in [SIGNS/SYMPTOMS]
  1. .I $P(DATA(J,"MESSAGE",2),U)'="" S ORKMSG=ORKMSG_"resulted in "_$P(DATA(J,"MESSAGE",2),U)_" "
  1. .;([STATION NAME] entered on [DOCUMENTATION DATE/TIME]).
  1. .K TEXT
  1. .S DELIMIT=", ",COUNT=1,COUNT("TOTAL")=DATA(J,"MESSAGE",1)
  1. .S ITM=0 F S ITM=$O(DATA(J,"MESSAGE",1,ITM)) Q:ITM="" D
  1. ..S:COUNT=COUNT("TOTAL") DELIMIT=" and "
  1. ..S TEXT=$S($G(TEXT)'="":TEXT_DELIMIT,1:"")_$P(DATA(J,"MESSAGE",1,ITM),U)_" entered on "_$P(DATA(J,"MESSAGE",1,ITM),U,3)
  1. ..;check for remote allergies and related comments
  1. ..I $P(DATA(J,"MESSAGE",1,ITM),U,2)["REMOTE" D
  1. ... S ORREMOTE=1
  1. ..S COUNT=1+COUNT
  1. .S ORKMSG=ORKMSG_"("_TEXT_")."
  1. .S ORKS("ORK",ORALLRD_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_ORALLRN_U_ORALLRD_U_ORKMSG
  1. .;SAVE DATA FOR ORDER CHECK INSTANCES FILE ENTRY
  1. .S CRC16=$$CRC16^XLFCRC(ORKMSG),NUM=0
  1. .S ITM="" F S ITM=$O(DATA(J,ITM)) Q:ITM="" D
  1. ..Q:ITM="MESSAGE"
  1. ..S NUM=1+$G(NUM)
  1. ..K:NUM=1 ^TMP("OROCIDATA",$J,CRC16)
  1. ..S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,.01)=$P(DATA(J,ITM),U,6)
  1. ..S:$P(DATA(J,ITM),U,7)'="" ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,2)=$P(DATA(J,ITM),U,7)
  1. ..S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,6)=$P(DATA(J,ITM),U,2)
  1. ..S:$P(DATA(J,ITM),U,2)="R" ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,7)=$P(DATA(J,ITM),U)
  1. ..S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,8)=$P(DATA(J,ITM),U,3)
  1. ..S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,9)=$$UP^XLFSTR($P(DATA(J,ITM),U,8))
  1. ..S:$G(SEVERE("MSG"))'="" ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,10)=SEVERE("MSG")
  1. ..S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,11)=$P(DATA(J,ITM),U,10)
  1. ..S ^TMP("OROCIDATA",$J,CRC16,100.517,NUM,9)=$$UP^XLFSTR($P(DATA(J,ITM),U,8))
  1. ..F ITM(1)=1:1:$L($P(DATA(J,ITM),U,5),"~") S ^TMP("OROCIDATA",$J,CRC16,"SIGN",NUM,"+"_ITM(1)_",")=$P($P(DATA(J,ITM),U,5),"~",ITM(1))
  1. ..S FCOUNT=ITM(1)+1
  1. ..S ^TMP("OROCIDATA",$J,CRC16,100.05,84)=$P(DATA(J,ITM),U,9)
  1. ..F NODE="ING","CLS" I $D(DATA(J,ITM,NODE)) F ITM(1)=1:1:$L(DATA(J,ITM,NODE),"~") D
  1. ...S ^TMP("OROCIDATA",$J,CRC16,$S(NODE="ING":"INGREDIENT",NODE="CLS":"CLASS",1:""),NUM,"+"_FCOUNT_",")=$P(DATA(J,ITM,NODE),"~",ITM(1)),FCOUNT=FCOUNT+1
  1. ..S ORREMLST=$P(DATA(J,ITM),U)_";"_$P(DATA(J,ITM),U,6)_"^"_$P(DATA(J,ITM),U,10)
  1. .;Now save the message to the ORKS array (moved here to allow for remote allergy comment changes)
  1. .S ORKS("ORK",ORALLRD_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_ORALLRN_U_ORALLRD_U_ORKMSG_U_ORREMOTE_U_ORREMLST
  1. Q
  1. ;
  1. OI2DD(ORPSA,OROI,ORPSPKG) ;rtn dispense drugs for a PS OI
  1. N PSOI
  1. Q:'$D(^ORD(101.43,OROI,0))
  1. S PSOI=$P($P(^ORD(101.43,OROI,0),U,2),";")
  1. Q:+$G(PSOI)<1
  1. D DRG^PSSUTIL1(.ORPSA,PSOI,ORPSPKG)
  1. Q
  1. ;
  1. DUPOR ;duplicate orders for non-pharmacy and non-lab:
  1. S OCN=0,OCN=$O(^ORD(100.8,"B","DUPLICATE ORDER",OCN))
  1. Q:+$G(OCN)<1
  1. Q:$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
  1. N ORKOR S ORKOR=0
  1. D DUP^ORKOR(.ORKOR,ORKDFN,OI,ODT,ORKDG) I (ORKOR>0) D
  1. .S ORKOCNUM=+$P(ORKOR,U)
  1. .S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
  1. .S ORKMSG="Duplicate order: "_$P(ORKOR,U,2)
  1. .S ORKS("ORK",DNGR_","_$G(ORNUM)_","_ORKOCNUM_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG_U_ORKOCNUM
  1. Q
  1. ;
  1. DUPLAB ;duplicate laboratory orders:
  1. N ORKLR,OCI
  1. S ORKLR=0,OCI=""
  1. S OCN=0,OCN=$O(^ORD(100.8,"B","DUPLICATE ORDER",OCN))
  1. Q:+$G(OCN)<1
  1. Q:$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
  1. S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
  1. D DUP^ORKLR(.ORKLR,OI,ORKDFN,ODT,ORKPDATA)
  1. F S OCI=$O(ORKLR(OCI)) Q:OCI="" D
  1. .S ORKOCNUM=+$P(ORKLR(OCI),U)
  1. .S ORKMSG="Duplicate order: "_$P(ORKLR(OCI),U,2)
  1. .S ORKS("ORK",DNGR_","_$G(ORNUM)_","_ORKOCNUM_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG_U_ORKOCNUM
  1. Q
  1. ;
  1. LABFREQ ;lab order frequency restrictions:
  1. N ORKLR,OCI
  1. S ORKLR=0,OCI=""
  1. S OCN=0,OCN=$O(^ORD(100.8,"B","LAB ORDER FREQ RESTRICTIONS",OCN))
  1. Q:+$G(OCN)<1
  1. Q:$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
  1. S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
  1. D ORFREQ^ORKLR2(.ORKLR,OI,ORKDFN_";DPT(",ODT,ORKPDATA)
  1. S OCI="" F S OCI=$O(ORKLR(OCI)) Q:OCI="" D
  1. .S ORKMSG=$P(ORKLR(OCI),U,2)
  1. .S ORKS("ORK",DNGR_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG
  1. Q
  1. ;
  1. PARAMS(ORKNAME,ORKNUM,ORKFLAG,ORKDNGR) ; get parameter values for an order chk
  1. S ORKNUM=0,ORKNUM=$O(^ORD(100.8,"B",ORKNAME,ORKNUM))
  1. S ORKFLAG=$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",ORKNUM,"I")
  1. S ORKDNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",ORKNUM,"I")
  1. Q
  1. REMCHK(ORRET,OROI,ORDFN) ; DO REMINDER ORDER CHECKS
  1. ;
  1. N ORKGLOB S ORKGLOB=$H
  1. ;order check for TEST OC for this OI
  1. N ORKNUM,ORKFLAG,ORKDNGR
  1. D PARAMS("CLINICAL REMINDER TEST",.ORKNUM,.ORKFLAG,.ORKDNGR)
  1. I ORKFLAG'="D" D
  1. .D ORDERCHK^PXRMORCH(ORDFN,OROI,1,0,0)
  1. .Q:'$D(^TMP($J,OROI))
  1. .N ORCDL S ORCDL="" F S ORCDL=$O(^TMP($J,OROI,ORCDL)) Q:'$L(ORCDL) S ORKDNGR=$S(ORCDL="H":1,ORCDL="M":2,1:3) D
  1. ..N ORRULE S ORRULE="" F S ORRULE=$O(^TMP($J,OROI,ORCDL,ORRULE)) Q:'$L(ORRULE) D
  1. ...S ORRET("ORK",ORCDL_","_$G(ORNUM)_","_ORKNUM_","_ORRULE)=ORNUM_U_ORKNUM_U_ORCDL_U_"||"_ORKGLOB_"&"_ORRULE
  1. ...M ^TMP($J,"ORK XTRA TXT",ORKGLOB,ORRULE)=^TMP($J,OROI,ORCDL,ORRULE)
  1. .K ^TMP($J,OROI)
  1. ;order checks for LIVE OC for this OI
  1. K ORKNUM,ORKFLAG,ORKDNGR
  1. D PARAMS("CLINICAL REMINDER LIVE",.ORKNUM,.ORKFLAG,.ORKDNGR)
  1. Q:ORKFLAG="D"
  1. D ORDERCHK^PXRMORCH(ORDFN,OROI,0,0,0)
  1. Q:'$D(^TMP($J,OROI))
  1. N ORCDL S ORCDL="" F S ORCDL=$O(^TMP($J,OROI,ORCDL)) Q:'$L(ORCDL) S ORKDNGR=$S(ORCDL="H":1,ORCDL="M":2,1:3) D
  1. .N ORRULE S ORRULE="" F S ORRULE=$O(^TMP($J,OROI,ORCDL,ORRULE)) Q:'$L(ORRULE) D
  1. ..S ORRET("ORK",ORCDL_","_$G(ORNUM)_","_ORKNUM_","_ORRULE)=ORNUM_U_ORKNUM_U_ORCDL_U_"||"_ORKGLOB_"&"_ORRULE
  1. ..M ^TMP($J,"ORK XTRA TXT",ORKGLOB,ORRULE)=^TMP($J,OROI,ORCDL,ORRULE)
  1. K ^TMP($J,OROI)
  1. Q
  1. ;
  1. DSGCHK(ORRET,ORDFN,OROIL,ORKA) ;DO DOSAGE ORDER CHECKS
  1. Q:'$$PATCH^XPDUTL("PSS*1.0*117")
  1. Q:$G(XQY0)="OR BCMA ORDER COM"
  1. N ORTYPE,ORY,ORI,ORKNUM,ORKFLAG,ORKDNGR
  1. D PARAMS("DRUG DOSAGE",.ORKNUM,.ORKFLAG,.ORKDNGR)
  1. Q:ORKFLAG="D" ;this checks if the order check is turned on or not
  1. I '$$DS^PSSDSAPI D Q
  1. .N ORDWNMSG S ORDWNMSG=$$DSDWNMSG^ORDSGCHK
  1. .S ORRET("ORK",ORKDNGR_","_$G(ORNUM)_","_ORDWNMSG)=ORNUM_U_25_U_2_ORDWNMSG
  1. S ORTYPE=$P(ORKA,"|",2)
  1. D EN^ORDSGCHK(.ORY,ORDFN,ORTYPE,.OROIL)
  1. N ORI S ORI=0 F S ORI=$O(ORY(ORI)) Q:'ORI D
  1. .I $P(ORY(ORI),U)="ERR" S ORRET("ORK",ORKDNGR_","_$G(ORNUM)_","_$E($P(ORY(ORI),U,2),1,225))=ORNUM_U_25_U_2_U_$P(ORY(ORI),U,2)
  1. .I $P(ORY(ORI),U)="DS" S ORRET("ORK",ORKDNGR_","_$G(ORNUM)_","_$E($P(ORY(ORI),U,2),1,225))=ORNUM_U_ORKNUM_U_ORKDNGR_U_$P(ORY(ORI),U,2)
  1. .N ORIPAD S ORIPAD=$$PAD^ORUTL(ORI,3)_ORI
  1. .I $P(ORY(ORI),U)="ERR" S ORRET("ORK",ORKDNGR_","_$G(ORNUM)_","_ORIPAD_","_$E($P(ORY(ORI),U,2),1,225))=ORNUM_U_25_U_3_U_$P(ORY(ORI),U,2)
  1. .I $P(ORY(ORI),U)="DS" S ORRET("ORK",ORKDNGR_","_$G(ORNUM)_","_ORIPAD_","_$E($P(ORY(ORI),U,2),1,225))=ORNUM_U_ORKNUM_U_ORKDNGR_U_$P(ORY(ORI),U,2)
  1. .I $P(ORY(ORI),U)="INFO" S ORRET("ORK",ORKDNGR_","_$G(ORNUM)_","_ORIPAD_","_$E($P(ORY(ORI),U,2),1,225))=ORNUM_U_ORKNUM_U_3_U_$P(ORY(ORI),U,2)
  1. Q