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

ORDSGCHK.m

Go to the documentation of this file.
  1. ORDSGCHK ;SLC/AGP - PRE 0.5 DOSE ORDER CHECKS;Nov 04, 2020@13:35:30
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**280,352,345,311,384,395,382,481,413,405**;Dec 17, 1997;Build 211
  1. ;
  1. EN(ORY,DFN,TYPE,OIL) ;
  1. N ARRAY,CNT,NAME
  1. ;if renewed order build OIL array
  1. I $G(ORREN)=1,+$G(ORIFN)>0 D
  1. .;IV orders should only have a null type
  1. .I TYPE="" S TYPE="PSIV"
  1. .D BLDREN(TYPE,ORIFN,.OIL)
  1. ;Build easy array to work with
  1. S CNT=0 F S CNT=$O(OIL(CNT)) Q:CNT'>0 D
  1. .S NODE=$G(OIL(CNT)) Q:$P(NODE,U,2)="PSIV"
  1. .S NAME=$P(NODE,U,2)
  1. .Q:'$P(NODE,U,3)
  1. .S ARRAY(NAME,$P(NODE,U,3))=NODE
  1. I TYPE="PSH" Q
  1. I TYPE="PSIV" D IV(.ORY,DFN,.ARRAY)
  1. I TYPE'="PSIV" D NONIV(.ORY,DFN,.ARRAY)
  1. Q
  1. ;
  1. BLDREN(TYPE,ORIFN,OUT) ;
  1. N CNT,EXTVALUE,ISOI,ITEM,LOC,NAME,NUM,NODE,ORDIALOG,TEXT,VALUE,X0,ORDSGSET
  1. S ORDSGSET=0
  1. S CNT=$O(OUT(""),-1)
  1. S X0=$G(^OR(100,+ORIFN,0))
  1. S ORDIALOG=+$P(X0,U,5)
  1. D GETDLG^ORCD(ORDIALOG)
  1. D GETORDER^ORCD(+ORIFN)
  1. ; for titration renewals only copy maintenance portion
  1. I $$ISTITR^ORUTL3(+ORIFN) D EDTDLG^ORWTITR(.ORDIALOG,+ORIFN)
  1. ;If Refills^Pickup^Days Supply^Quantity is passed in (with new renewal values), use new values
  1. I $G(ORRENFLDS)'="" D
  1. . S ORDIALOG($$PTR^ORCD("OR GTX REFILLS"),1)=$P(ORRENFLDS,U,1)
  1. . S ORDIALOG($$PTR^ORCD("OR GTX ROUTING"),1)=$P(ORRENFLDS,U,2)
  1. . S ORDIALOG($$PTR^ORCD("OR GTX DAYS SUPPLY"),1)=$P(ORRENFLDS,U,3)
  1. . S ORDIALOG($$PTR^ORCD("OR GTX QUANTITY"),1)=$P(ORRENFLDS,U,4)
  1. S LOC=0 F S LOC=$O(ORDIALOG(LOC)) Q:LOC'>0 D
  1. .S ITEM=$P($G(ORDIALOG(LOC)),U,2)
  1. .I ITEM="" Q
  1. .I ITEM="COMMENT" Q
  1. .S ISOI=$S($G(ORDIALOG(LOC,0))[101.43:1,1:0)
  1. .S NUM=0 F S NUM=$O(ORDIALOG(LOC,NUM)) Q:NUM'>0 D
  1. ..I NUM<1 Q
  1. ..S VALUE=$G(ORDIALOG(LOC,NUM)),EXTVALUE=""
  1. ..I ISOI=1 D
  1. ...S EXTVALUE=$P($G(^ORD(101.43,VALUE,0)),U)
  1. ...I $P($G(^ORD(101.41,LOC,0)),U)="OR GTX ADDITIVE" S ITEM="ADDITIVE"
  1. ..I ITEM="RATE" S EXTVALUE=VALUE
  1. ..I ITEM="DOSE" S ORDSGSET=1
  1. ..S TEXT=TYPE_U_ITEM_U_NUM_U_VALUE_U_EXTVALUE
  1. ..S CNT=CNT+1,OUT(CNT)=TEXT
  1. ;SET THE DOSE AS BLANK IN THE OUTPUT ARRAY IF IT WASN'T SET ALREADY
  1. I 'ORDSGSET S CNT=CNT+1,OUT(CNT)=TYPE_U_"DOSE^1^^"
  1. Q
  1. ;
  1. DURATION(STR) ;
  1. N LEN,VAL,UNIT,IVLMT,TVAL
  1. S (UNIT,IVLMT)="",VAL=0
  1. I $E($$LOW^XLFSTR(STR))="f" D
  1. . I STR["for a total of" D Q
  1. . .S VAL=$P(STR," ",5)
  1. . .S UNIT=$P(STR," ",6)
  1. . .S STR=""
  1. . S VAL=$P(STR," ",2)
  1. . S UNIT=$E($P(STR," ",3))
  1. . S STR=""
  1. I $E($$LOW^XLFSTR(STR))="w" D
  1. . S TVAL=$P(STR," ",4)
  1. . S VAL=+TVAL
  1. . S LEN=$F(TVAL,VAL)
  1. . I $P(VAL,".")="" S VAL=0_VAL
  1. . F S UNIT=$E(TVAL,LEN) Q:((UNIT'=0)&(UNIT'=".")) D
  1. . . S LEN=LEN+1
  1. . S STR=""
  1. I $L(UNIT),$L(VAL) S IVLMT=VAL_$$UP^XLFSTR(UNIT)
  1. I STR'="",IVLMT="" D
  1. .I STR["ML" S IVLMT=$P(STR,"M")_"M" Q
  1. .I STR["CC" S IVLMT=$P(STR,"C")_"M" Q
  1. .S IVLMT=STR
  1. Q IVLMT
  1. ;
  1. IV(ORY,DFN,ARRAY) ;
  1. N CNT,DRUG,DRUGIEN,DRUGNAME,NAME,NUM,OI,ORBASE,ORPSJARR,STR,STRENGTH,NODE
  1. ;
  1. I '$D(ARRAY) D Q
  1. . S ORY=$G(ORY)+1,ORY(ORY)="ERR^Incomplete data. Dosage check could not be performed."
  1. ;populate single values from order
  1. S ORPSJARR("TVOL_DUR")="",ORPSJARR("SCHEDULE")=""
  1. I $D(ARRAY("DAYS")) S ORPSJARR("TVOL_DUR")=$$DURATION($P(ARRAY("DAYS",1),U,4))
  1. ;S RATE=$P(ARRAY(NAME,1),U,4)
  1. S ORPSJARR("MR_IEN")=$P(ARRAY("ROUTE",1),U,4)
  1. I $D(ARRAY("SCHEDULE")) S ORPSJARR("SCHEDULE")=$P(ARRAY("SCHEDULE",1),U,4)
  1. S ORPSJARR("IV_TYPE")=$S($P(ARRAY("TYPE",1),U,4)="I":1,1:2)
  1. I ORPSJARR("IV_TYPE")=2 S ORPSJARR("INF_RATE")=$P(ARRAY("RATE",1),U,5)
  1. ;
  1. ;build additive first, Drug, Strength/unit, bag
  1. F NAME="ADDITIVE","ORDERABLE" D
  1. .K DRUG
  1. .S CNT=0,NUM=0
  1. .F S NUM=$O(ARRAY(NAME,NUM)) Q:NUM'>0 D
  1. ..S CNT=CNT+1
  1. ..S NODE=$G(ARRAY(NAME,NUM)),OI=$P(NODE,U,4)
  1. ..;
  1. ..S DRUGIEN=+$P(^ORD(101.43,OI,0),U,2) I DRUGIEN="" Q ;PHARMACY OI FROM 101.43
  1. ..S DRUGNAME=$P($G(ARRAY(NAME,NUM)),U,5) ;OI NAME
  1. ..;
  1. ..I NAME="ADDITIVE" D Q
  1. ...S STRENGTH=$P($G(ARRAY("STRENGTH",NUM)),U,4)_" "_$P($G(ARRAY("UNITS",NUM)),U,4)
  1. ...S STR=+DRUGIEN_U_DRUGNAME_U_STRENGTH_U_$P($G(ARRAY("ADDFREQ",NUM)),U,4)
  1. ...S ORPSJARR("AD",CNT)=STR_U_0
  1. ...;check if enhanced order checks were done for this drug order and if so set ORDRUG(CNT,"ENH")=1
  1. ...I $G(^TMP($J,"ORENHCHK"))=1 S ORPSJARR("AD",CNT)=STR_U_1
  1. ..;
  1. ..;Solution information
  1. ..S STR=+DRUGIEN_U_DRUGNAME_U_$P($G(ARRAY("VOLUME",NUM)),U,4)_" ML"
  1. ..S ORPSJARR("SOL",CNT)=STR,$P(ORPSJARR("SOL",CNT),U,5)=0
  1. ..;check if enhanced order checks were done for this drug order and if so set ORDRUG(CNT,"ENH")=1
  1. ..I $G(^TMP($J,"ORENHCHK"))=1 S ORPSJARR("SOL",CNT)=STR,$P(ORPSJARR("SOL",CNT),U,5)=1
  1. ;
  1. I $D(^TMP($J,"ORDSGCHK_CACHE")) M ^TMP($J,"ORDSGCHK2")=^TMP($J,"ORDSGCHK_CACHE")
  1. I '$D(^TMP($J,"ORDSGCHK_CACHE")) D
  1. .S ORBASE(1)="ORDSGCHK1"
  1. .S ORBASE(2)="ORDSGCHK2"
  1. .D DOSE^PSJAPIDS(.ORBASE,DFN,.ORPSJARR)
  1. .M ^TMP($J,"ORDSGCHK_CACHE")=^TMP($J,"ORDSGCHK2")
  1. D PARSEOUT
  1. K ^TMP($J,"ORDSGCHK1"),^TMP($J,"ORDSGCHK2")
  1. Q
  1. ;
  1. NONIV(ORY,DFN,ARRAY) ;
  1. N CNT,DISPDRUGIEN,DOSESTR,DRUG,DRUGARR,DRUGIEN,DRUGNAME,DUR,NAME,NODE
  1. N OIIEN,ORBASE,ORDRUG,ORPSARR,PACK,PSNODE,SUB,TYPE,ADMIN
  1. ;
  1. ;assume same drug type used throughout the order dialog
  1. ;new free-text dose orders do not have a drug, all other free-text orders do
  1. S DISPDRUGIEN=+$P($G(ARRAY("DRUG",1)),U,4)
  1. I DISPDRUGIEN>0,$$EXMT^PSSDSAPI(DISPDRUGIEN)=1 Q
  1. ;if no ARRAY(DOSE) node set it to null to force free text evaluation
  1. N I S I=0 F S I=$O(ARRAY("INSTR",I)) Q:'I I '$D(ARRAY("DOSE",I)) S ARRAY("DOSE",I)=$P(ARRAY("INSTR",I),U)_"^DOSE^"_I_"^"
  1. ;
  1. S ADMIN="",ADMIN("SAVE")=1
  1. S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D
  1. .S SUB=$$GETSUB(NAME) I SUB="" Q
  1. .S CNT=0 F S CNT=$O(ARRAY(NAME,CNT)) Q:CNT'>0 D
  1. ..S NODE=$G(ARRAY(NAME,CNT))
  1. ..;
  1. ..;get dose information and drug information from Dose Prompt
  1. ..I SUB="DOSE" D
  1. ...S PACK=$P(NODE,U)
  1. ...S TYPE=$S($P(NODE,U)="PSO":"O",1:"I")
  1. ...S DOSESTR=$P(NODE,U,4)
  1. ...;free text dose
  1. ...I DOSESTR="" D
  1. ....S ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT
  1. ....I DISPDRUGIEN>0 D Q
  1. .....S ORPSARR(CNT,"DO")=$P($G(ARRAY("INSTR",CNT)),U,4)
  1. .....S ORDRUG(CNT,"DRUG_IEN")=DISPDRUGIEN
  1. .....S ORDRUG(CNT,"DRUG_NM")=$$GETPSNM^ORKPS(DISPDRUGIEN) ;DRUGNAME
  1. ....N ORTDOSE,ORTDNAME
  1. ....S ARRAY("ORPSA",CNT)=$$OI2DD^ORKPS($P(ARRAY("ORDERABLE",1),U,4),$E($P(ARRAY("ORDERABLE",1),U,1),3),2)
  1. ....Q:'$P(ARRAY("ORPSA",CNT),";",1)
  1. ....K ^TMP($J,"DRUGARR") D ZERO^PSS50($P(ARRAY("ORPSA",CNT),";",1),,,,,"DRUGARR")
  1. ....N ORDRGNM S ORDRGNM=$G(^TMP($J,"DRUGARR",$P(ARRAY("ORPSA",CNT),";",1),.01))
  1. ....S ORPSARR(CNT,"DO")=$$TRIM^ORBCMA32($P($P($G(ARRAY("INSTR",CNT)),U,4),ORDRGNM))
  1. ....S OIIEN=$P($G(ARRAY("ORDERABLE",1)),U,4) ;orderable only exists for first item (in complex order)
  1. ....S ORDRUG("OI")=+$P($G(^ORD(101.43,OIIEN,0)),U,2)
  1. ....S ORDRUG("PACKAGE")=$S(PACK="PSO":"O",PACK="PSH":"X",1:"I")
  1. ....S PSNODE=$G(^ORD(101.43,OIIEN,"PS"))
  1. ....S ORDRUG("OI_USAGE")=$S($P(PSNODE,U,4)=1:"A",1:"")_$S($P(PSNODE,U,3)=1:"B",1:"")
  1. ....S ORDRUG(CNT,"DRUG_NM")=$$TRIM^ORBCMA32($P($G(ARRAY("ORDERABLE",1)),U,5))
  1. ...;
  1. ...;check if enhanced order checks were done for this drug order and if so set ORDRUG(CNT,"ENH")=1
  1. ...I $G(^TMP($J,"ORENHCHK"))=1,((DOSESTR=""&$D(ORDRUG))!(DOSESTR'="")) S ORDRUG(CNT,"ENH")=1
  1. ...Q:DOSESTR=""
  1. ...S DRUGIEN=$P(DOSESTR,"&",6)
  1. ...K ^TMP($J,"DRUGARR")
  1. ...D ZERO^PSS50(DRUGIEN,,,,,"DRUGARR")
  1. ...S DRUGNAME=$G(^TMP($J,"DRUGARR",DRUGIEN,.01))
  1. ...K ^TMP($J,"DRUGARR")
  1. ...;
  1. ...;Local Possible Dose
  1. ...I $P(DOSESTR,"&")="" D Q
  1. ....S ORPSARR(CNT,"DO")=$P($G(ARRAY("INSTR",CNT)),U,4)
  1. ....S ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT
  1. ....S ORDRUG(CNT,"DRUG_IEN")=DRUGIEN
  1. ....S ORDRUG(CNT,"DRUG_NM")=$$GETPSNM^ORKPS(DRUGIEN) ;DRUGNAME
  1. ...;
  1. ...;Possible Dose
  1. ...S ORPSARR(CNT,"DRG_AMT")=$P(DOSESTR,"&")
  1. ...S ORPSARR(CNT,"DRG_UNIT")=$P(DOSESTR,"&",2)
  1. ...S ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT
  1. ...S ORDRUG(CNT,"DRUG_IEN")=DRUGIEN
  1. ...S ORDRUG(CNT,"DRUG_NM")=$$GETPSNM^ORKPS(DRUGIEN) ;DRUGNAME
  1. ..;
  1. ..;Additional Order Data
  1. ..I SUB="DRATE" D Q
  1. ...S DUR=$P($P(NODE,U,4)," ")
  1. ...S ORPSARR(CNT,SUB)=DUR_$$DRATESTR($P($P(NODE,U,4)," ",2))
  1. ..I SUB="CONJ",$P(NODE,U)="PSI",ADMIN("SAVE") D
  1. ...S:$D(ARRAY("SCHEDULE",CNT))=1 ADMIN=ADMIN_";"_$P(ARRAY("SCHEDULE",CNT),U,4)
  1. ...I $P($G(ARRAY(SUB,CNT)),U,4)'="A" S ADMIN("SAVE")=0
  1. ..S ORPSARR(CNT,SUB)=$P(NODE,U,4)
  1. ;
  1. ;Get rid of any preceeding or trailing spaces on the dose
  1. N ORSPI S ORSPI=0 F S ORSPI=$O(ORPSARR(ORSPI)) Q:'ORSPI D
  1. .I $D(ORPSARR(ORSPI,"DO")) S ORPSARR(ORSPI,"DO")=$$TRIM^XLFSTR(ORPSARR(ORSPI,"DO"))
  1. ;
  1. I ADMIN'="" D
  1. .N ORAT
  1. .D ADMIN^ORWDPS2(.ORAT,DFN,ADMIN,$P($G(ARRAY("ORDERABLE",1)),U,4),+ORL,$P($G(ARRAY("ADMIN",1)),U,4))
  1. .I $P(ORAT,U,4)'="" S ORPSARR(1,"EFD")=$P(ORAT,U,4)
  1. ;
  1. I $D(ORDRUG) D
  1. .S ORBASE(1)="ORDSGCHK1",ORBASE(2)="ORDSGCHK2"
  1. .S ORPSARR("CONTEXT")="CPRS-UD"
  1. .D DOSE^PSSDSAPD(.ORBASE,DFN,.ORPSARR,.ORDRUG),PARSEOUT
  1. .K ^TMP($J,"ORDSGCHK1"),^TMP($J,"ORDSGCHK2")
  1. Q
  1. ;
  1. PARSEOUT ;PARSE OUTPUT GLOBAL
  1. N ORNBP S ORNBP=""
  1. I $D(^TMP($J,"ORDSGCHK2")) D
  1. .I $P($G(^TMP($J,"ORDSGCHK2","OUT",0)),U)=-1 S ORNBP=$$DSDWNMSG^ORDSGCHK Q
  1. .I $D(^TMP($J,"ORDSGCHK2","OUT","ERROR")) D
  1. ..N I S I="" F S I=$O(^TMP($J,"ORDSGCHK2","OUT","ERROR",I)) Q:'$L(I) D
  1. ...N J S J="" F S J=$O(^TMP($J,"ORDSGCHK2","OUT","ERROR",I,J)) Q:'$L(J) D
  1. ....N K S K="" F S K=$O(^TMP($J,"ORDSGCHK2","OUT","ERROR",I,J,K)) Q:'$L(K) D
  1. .....I $L($G(^TMP($J,"ORDSGCHK2","OUT","ERROR",I,J,K,"MSG"))) S ORY=$G(ORY)+1,ORY(ORY)="ERR^"_^TMP($J,"ORDSGCHK2","OUT","ERROR",I,J,K,"MSG") D
  1. ......I $L($G(^TMP($J,"ORDSGCHK2","OUT","ERROR",I,J,K,"TEXT"))) S ORY(ORY)=ORY(ORY)_" "_$G(^TMP($J,"ORDSGCHK2","OUT","ERROR",I,J,K,"TEXT"))
  1. .I $D(^TMP($J,"ORDSGCHK2","OUT","CHECK")) D
  1. .N ORI S ORI=0 F S ORI=$O(^TMP($J,"ORDSGCHK2","OUT","CHECK",ORI)) Q:'ORI D
  1. ..N ORJ S ORJ="" F S ORJ=$O(^TMP($J,"ORDSGCHK2","OUT","CHECK",ORI,ORJ)) Q:'$L(ORJ) D
  1. ...N ORK S ORK=0 F S ORK=$O(^TMP($J,"ORDSGCHK2","OUT","CHECK",ORI,ORJ,ORK)) Q:'ORK D
  1. ....N ORDGTYPE S ORDGTYPE="DS"
  1. ....N ORRTTYPE S ORRTTYPE=$P($G(^TMP($J,"ORDSGCHK2","OUT","CHECK",ORI,ORJ,ORK,"ATYPE")),U,2)
  1. ....I ORRTTYPE="INFORMATIONAL" S ORDGTYPE="INFO"
  1. ....I ORRTTYPE="GENERAL" S ORDGTYPE="INFO"
  1. ....I ORRTTYPE="EXCEPTION" S ORDGTYPE="INFO"
  1. ....S ORY=$G(ORY)+1,ORY(ORY)=ORDGTYPE_U
  1. ....N ORL S ORL=0 F S ORL=$O(^TMP($J,"ORDSGCHK2","OUT","CHECK",ORI,ORJ,ORK,"MSG",ORL)) Q:'ORL D
  1. .....S ORY(ORY)=ORY(ORY)_^TMP($J,"ORDSGCHK2","OUT","CHECK",ORI,ORJ,ORK,"MSG",ORL)_" "
  1. I $L(ORNBP)>1 S ORY=$G(ORY)+1,ORY(ORY)="ERR^"_ORNBP,ORNBP=""
  1. Q
  1. ;
  1. GETSUB(NAME) ;
  1. I NAME="DAYS" Q "DRATE"
  1. I NAME="ROUTE" Q "MR_IEN"
  1. I "^CONJ^DOSE^SCHEDULE^"[(U_NAME_U) Q NAME
  1. Q ""
  1. ;
  1. DRATESTR(ORIN) ;change the form of the DURATION
  1. ;DAYS=D,WEEKS=W,MONTHS=L,HOURS=H,MINUTES=M
  1. I $$UP^XLFSTR(ORIN)="MONTHS" Q "L"
  1. Q $E($$UP^XLFSTR(ORIN))
  1. ;
  1. DSDWNMSG() ;dosage down message (not displayed to user)
  1. Q "Drug Dosage checks were not able to be performed."