ORDSGCHK ;SLC/AGP - PRE 0.5 DOSE ORDER CHECKS;Nov 04, 2020@13:35:30
;;3.0;ORDER ENTRY/RESULTS REPORTING;**280,352,345,311,384,395,382,481,413,405**;Dec 17, 1997;Build 211
;
EN(ORY,DFN,TYPE,OIL) ;
N ARRAY,CNT,NAME
;if renewed order build OIL array
I $G(ORREN)=1,+$G(ORIFN)>0 D
.;IV orders should only have a null type
.I TYPE="" S TYPE="PSIV"
.D BLDREN(TYPE,ORIFN,.OIL)
;Build easy array to work with
S CNT=0 F S CNT=$O(OIL(CNT)) Q:CNT'>0 D
.S NODE=$G(OIL(CNT)) Q:$P(NODE,U,2)="PSIV"
.S NAME=$P(NODE,U,2)
.Q:'$P(NODE,U,3)
.S ARRAY(NAME,$P(NODE,U,3))=NODE
I TYPE="PSH" Q
I TYPE="PSIV" D IV(.ORY,DFN,.ARRAY)
I TYPE'="PSIV" D NONIV(.ORY,DFN,.ARRAY)
Q
;
BLDREN(TYPE,ORIFN,OUT) ;
N CNT,EXTVALUE,ISOI,ITEM,LOC,NAME,NUM,NODE,ORDIALOG,TEXT,VALUE,X0,ORDSGSET
S ORDSGSET=0
S CNT=$O(OUT(""),-1)
S X0=$G(^OR(100,+ORIFN,0))
S ORDIALOG=+$P(X0,U,5)
D GETDLG^ORCD(ORDIALOG)
D GETORDER^ORCD(+ORIFN)
; for titration renewals only copy maintenance portion
I $$ISTITR^ORUTL3(+ORIFN) D EDTDLG^ORWTITR(.ORDIALOG,+ORIFN)
;If Refills^Pickup^Days Supply^Quantity is passed in (with new renewal values), use new values
I $G(ORRENFLDS)'="" D
. S ORDIALOG($$PTR^ORCD("OR GTX REFILLS"),1)=$P(ORRENFLDS,U,1)
. S ORDIALOG($$PTR^ORCD("OR GTX ROUTING"),1)=$P(ORRENFLDS,U,2)
. S ORDIALOG($$PTR^ORCD("OR GTX DAYS SUPPLY"),1)=$P(ORRENFLDS,U,3)
. S ORDIALOG($$PTR^ORCD("OR GTX QUANTITY"),1)=$P(ORRENFLDS,U,4)
S LOC=0 F S LOC=$O(ORDIALOG(LOC)) Q:LOC'>0 D
.S ITEM=$P($G(ORDIALOG(LOC)),U,2)
.I ITEM="" Q
.I ITEM="COMMENT" Q
.S ISOI=$S($G(ORDIALOG(LOC,0))[101.43:1,1:0)
.S NUM=0 F S NUM=$O(ORDIALOG(LOC,NUM)) Q:NUM'>0 D
..I NUM<1 Q
..S VALUE=$G(ORDIALOG(LOC,NUM)),EXTVALUE=""
..I ISOI=1 D
...S EXTVALUE=$P($G(^ORD(101.43,VALUE,0)),U)
...I $P($G(^ORD(101.41,LOC,0)),U)="OR GTX ADDITIVE" S ITEM="ADDITIVE"
..I ITEM="RATE" S EXTVALUE=VALUE
..I ITEM="DOSE" S ORDSGSET=1
..S TEXT=TYPE_U_ITEM_U_NUM_U_VALUE_U_EXTVALUE
..S CNT=CNT+1,OUT(CNT)=TEXT
;SET THE DOSE AS BLANK IN THE OUTPUT ARRAY IF IT WASN'T SET ALREADY
I 'ORDSGSET S CNT=CNT+1,OUT(CNT)=TYPE_U_"DOSE^1^^"
Q
;
DURATION(STR) ;
N LEN,VAL,UNIT,IVLMT,TVAL
S (UNIT,IVLMT)="",VAL=0
I $E($$LOW^XLFSTR(STR))="f" D
. I STR["for a total of" D Q
. .S VAL=$P(STR," ",5)
. .S UNIT=$P(STR," ",6)
. .S STR=""
. S VAL=$P(STR," ",2)
. S UNIT=$E($P(STR," ",3))
. S STR=""
I $E($$LOW^XLFSTR(STR))="w" D
. S TVAL=$P(STR," ",4)
. S VAL=+TVAL
. S LEN=$F(TVAL,VAL)
. I $P(VAL,".")="" S VAL=0_VAL
. F S UNIT=$E(TVAL,LEN) Q:((UNIT'=0)&(UNIT'=".")) D
. . S LEN=LEN+1
. S STR=""
I $L(UNIT),$L(VAL) S IVLMT=VAL_$$UP^XLFSTR(UNIT)
I STR'="",IVLMT="" D
.I STR["ML" S IVLMT=$P(STR,"M")_"M" Q
.I STR["CC" S IVLMT=$P(STR,"C")_"M" Q
.S IVLMT=STR
Q IVLMT
;
IV(ORY,DFN,ARRAY) ;
N CNT,DRUG,DRUGIEN,DRUGNAME,NAME,NUM,OI,ORBASE,ORPSJARR,STR,STRENGTH,NODE
;
I '$D(ARRAY) D Q
. S ORY=$G(ORY)+1,ORY(ORY)="ERR^Incomplete data. Dosage check could not be performed."
;populate single values from order
S ORPSJARR("TVOL_DUR")="",ORPSJARR("SCHEDULE")=""
I $D(ARRAY("DAYS")) S ORPSJARR("TVOL_DUR")=$$DURATION($P(ARRAY("DAYS",1),U,4))
;S RATE=$P(ARRAY(NAME,1),U,4)
S ORPSJARR("MR_IEN")=$P(ARRAY("ROUTE",1),U,4)
I $D(ARRAY("SCHEDULE")) S ORPSJARR("SCHEDULE")=$P(ARRAY("SCHEDULE",1),U,4)
S ORPSJARR("IV_TYPE")=$S($P(ARRAY("TYPE",1),U,4)="I":1,1:2)
I ORPSJARR("IV_TYPE")=2 S ORPSJARR("INF_RATE")=$P(ARRAY("RATE",1),U,5)
;
;build additive first, Drug, Strength/unit, bag
F NAME="ADDITIVE","ORDERABLE" D
.K DRUG
.S CNT=0,NUM=0
.F S NUM=$O(ARRAY(NAME,NUM)) Q:NUM'>0 D
..S CNT=CNT+1
..S NODE=$G(ARRAY(NAME,NUM)),OI=$P(NODE,U,4)
..;
..S DRUGIEN=+$P(^ORD(101.43,OI,0),U,2) I DRUGIEN="" Q ;PHARMACY OI FROM 101.43
..S DRUGNAME=$P($G(ARRAY(NAME,NUM)),U,5) ;OI NAME
..;
..I NAME="ADDITIVE" D Q
...S STRENGTH=$P($G(ARRAY("STRENGTH",NUM)),U,4)_" "_$P($G(ARRAY("UNITS",NUM)),U,4)
...S STR=+DRUGIEN_U_DRUGNAME_U_STRENGTH_U_$P($G(ARRAY("ADDFREQ",NUM)),U,4)
...S ORPSJARR("AD",CNT)=STR_U_0
...;check if enhanced order checks were done for this drug order and if so set ORDRUG(CNT,"ENH")=1
...I $G(^TMP($J,"ORENHCHK"))=1 S ORPSJARR("AD",CNT)=STR_U_1
..;
..;Solution information
..S STR=+DRUGIEN_U_DRUGNAME_U_$P($G(ARRAY("VOLUME",NUM)),U,4)_" ML"
..S ORPSJARR("SOL",CNT)=STR,$P(ORPSJARR("SOL",CNT),U,5)=0
..;check if enhanced order checks were done for this drug order and if so set ORDRUG(CNT,"ENH")=1
..I $G(^TMP($J,"ORENHCHK"))=1 S ORPSJARR("SOL",CNT)=STR,$P(ORPSJARR("SOL",CNT),U,5)=1
;
I $D(^TMP($J,"ORDSGCHK_CACHE")) M ^TMP($J,"ORDSGCHK2")=^TMP($J,"ORDSGCHK_CACHE")
I '$D(^TMP($J,"ORDSGCHK_CACHE")) D
.S ORBASE(1)="ORDSGCHK1"
.S ORBASE(2)="ORDSGCHK2"
.D DOSE^PSJAPIDS(.ORBASE,DFN,.ORPSJARR)
.M ^TMP($J,"ORDSGCHK_CACHE")=^TMP($J,"ORDSGCHK2")
D PARSEOUT
K ^TMP($J,"ORDSGCHK1"),^TMP($J,"ORDSGCHK2")
Q
;
NONIV(ORY,DFN,ARRAY) ;
N CNT,DISPDRUGIEN,DOSESTR,DRUG,DRUGARR,DRUGIEN,DRUGNAME,DUR,NAME,NODE
N OIIEN,ORBASE,ORDRUG,ORPSARR,PACK,PSNODE,SUB,TYPE,ADMIN
;
;assume same drug type used throughout the order dialog
;new free-text dose orders do not have a drug, all other free-text orders do
S DISPDRUGIEN=+$P($G(ARRAY("DRUG",1)),U,4)
I DISPDRUGIEN>0,$$EXMT^PSSDSAPI(DISPDRUGIEN)=1 Q
;if no ARRAY(DOSE) node set it to null to force free text evaluation
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_"^"
;
S ADMIN="",ADMIN("SAVE")=1
S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D
.S SUB=$$GETSUB(NAME) I SUB="" Q
.S CNT=0 F S CNT=$O(ARRAY(NAME,CNT)) Q:CNT'>0 D
..S NODE=$G(ARRAY(NAME,CNT))
..;
..;get dose information and drug information from Dose Prompt
..I SUB="DOSE" D
...S PACK=$P(NODE,U)
...S TYPE=$S($P(NODE,U)="PSO":"O",1:"I")
...S DOSESTR=$P(NODE,U,4)
...;free text dose
...I DOSESTR="" D
....S ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT
....I DISPDRUGIEN>0 D Q
.....S ORPSARR(CNT,"DO")=$P($G(ARRAY("INSTR",CNT)),U,4)
.....S ORDRUG(CNT,"DRUG_IEN")=DISPDRUGIEN
.....S ORDRUG(CNT,"DRUG_NM")=$$GETPSNM^ORKPS(DISPDRUGIEN) ;DRUGNAME
....N ORTDOSE,ORTDNAME
....S ARRAY("ORPSA",CNT)=$$OI2DD^ORKPS($P(ARRAY("ORDERABLE",1),U,4),$E($P(ARRAY("ORDERABLE",1),U,1),3),2)
....Q:'$P(ARRAY("ORPSA",CNT),";",1)
....K ^TMP($J,"DRUGARR") D ZERO^PSS50($P(ARRAY("ORPSA",CNT),";",1),,,,,"DRUGARR")
....N ORDRGNM S ORDRGNM=$G(^TMP($J,"DRUGARR",$P(ARRAY("ORPSA",CNT),";",1),.01))
....S ORPSARR(CNT,"DO")=$$TRIM^ORBCMA32($P($P($G(ARRAY("INSTR",CNT)),U,4),ORDRGNM))
....S OIIEN=$P($G(ARRAY("ORDERABLE",1)),U,4) ;orderable only exists for first item (in complex order)
....S ORDRUG("OI")=+$P($G(^ORD(101.43,OIIEN,0)),U,2)
....S ORDRUG("PACKAGE")=$S(PACK="PSO":"O",PACK="PSH":"X",1:"I")
....S PSNODE=$G(^ORD(101.43,OIIEN,"PS"))
....S ORDRUG("OI_USAGE")=$S($P(PSNODE,U,4)=1:"A",1:"")_$S($P(PSNODE,U,3)=1:"B",1:"")
....S ORDRUG(CNT,"DRUG_NM")=$$TRIM^ORBCMA32($P($G(ARRAY("ORDERABLE",1)),U,5))
...;
...;check if enhanced order checks were done for this drug order and if so set ORDRUG(CNT,"ENH")=1
...I $G(^TMP($J,"ORENHCHK"))=1,((DOSESTR=""&$D(ORDRUG))!(DOSESTR'="")) S ORDRUG(CNT,"ENH")=1
...Q:DOSESTR=""
...S DRUGIEN=$P(DOSESTR,"&",6)
...K ^TMP($J,"DRUGARR")
...D ZERO^PSS50(DRUGIEN,,,,,"DRUGARR")
...S DRUGNAME=$G(^TMP($J,"DRUGARR",DRUGIEN,.01))
...K ^TMP($J,"DRUGARR")
...;
...;Local Possible Dose
...I $P(DOSESTR,"&")="" D Q
....S ORPSARR(CNT,"DO")=$P($G(ARRAY("INSTR",CNT)),U,4)
....S ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT
....S ORDRUG(CNT,"DRUG_IEN")=DRUGIEN
....S ORDRUG(CNT,"DRUG_NM")=$$GETPSNM^ORKPS(DRUGIEN) ;DRUGNAME
...;
...;Possible Dose
...S ORPSARR(CNT,"DRG_AMT")=$P(DOSESTR,"&")
...S ORPSARR(CNT,"DRG_UNIT")=$P(DOSESTR,"&",2)
...S ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT
...S ORDRUG(CNT,"DRUG_IEN")=DRUGIEN
...S ORDRUG(CNT,"DRUG_NM")=$$GETPSNM^ORKPS(DRUGIEN) ;DRUGNAME
..;
..;Additional Order Data
..I SUB="DRATE" D Q
...S DUR=$P($P(NODE,U,4)," ")
...S ORPSARR(CNT,SUB)=DUR_$$DRATESTR($P($P(NODE,U,4)," ",2))
..I SUB="CONJ",$P(NODE,U)="PSI",ADMIN("SAVE") D
...S:$D(ARRAY("SCHEDULE",CNT))=1 ADMIN=ADMIN_";"_$P(ARRAY("SCHEDULE",CNT),U,4)
...I $P($G(ARRAY(SUB,CNT)),U,4)'="A" S ADMIN("SAVE")=0
..S ORPSARR(CNT,SUB)=$P(NODE,U,4)
;
;Get rid of any preceeding or trailing spaces on the dose
N ORSPI S ORSPI=0 F S ORSPI=$O(ORPSARR(ORSPI)) Q:'ORSPI D
.I $D(ORPSARR(ORSPI,"DO")) S ORPSARR(ORSPI,"DO")=$$TRIM^XLFSTR(ORPSARR(ORSPI,"DO"))
;
I ADMIN'="" D
.N ORAT
.D ADMIN^ORWDPS2(.ORAT,DFN,ADMIN,$P($G(ARRAY("ORDERABLE",1)),U,4),+ORL,$P($G(ARRAY("ADMIN",1)),U,4))
.I $P(ORAT,U,4)'="" S ORPSARR(1,"EFD")=$P(ORAT,U,4)
;
I $D(ORDRUG) D
.S ORBASE(1)="ORDSGCHK1",ORBASE(2)="ORDSGCHK2"
.S ORPSARR("CONTEXT")="CPRS-UD"
.D DOSE^PSSDSAPD(.ORBASE,DFN,.ORPSARR,.ORDRUG),PARSEOUT
.K ^TMP($J,"ORDSGCHK1"),^TMP($J,"ORDSGCHK2")
Q
;
PARSEOUT ;PARSE OUTPUT GLOBAL
N ORNBP S ORNBP=""
I $D(^TMP($J,"ORDSGCHK2")) D
.I $P($G(^TMP($J,"ORDSGCHK2","OUT",0)),U)=-1 S ORNBP=$$DSDWNMSG^ORDSGCHK Q
.I $D(^TMP($J,"ORDSGCHK2","OUT","ERROR")) D
..N I S I="" F S I=$O(^TMP($J,"ORDSGCHK2","OUT","ERROR",I)) Q:'$L(I) D
...N J S J="" F S J=$O(^TMP($J,"ORDSGCHK2","OUT","ERROR",I,J)) Q:'$L(J) D
....N K S K="" F S K=$O(^TMP($J,"ORDSGCHK2","OUT","ERROR",I,J,K)) Q:'$L(K) D
.....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
......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"))
.I $D(^TMP($J,"ORDSGCHK2","OUT","CHECK")) D
.N ORI S ORI=0 F S ORI=$O(^TMP($J,"ORDSGCHK2","OUT","CHECK",ORI)) Q:'ORI D
..N ORJ S ORJ="" F S ORJ=$O(^TMP($J,"ORDSGCHK2","OUT","CHECK",ORI,ORJ)) Q:'$L(ORJ) D
...N ORK S ORK=0 F S ORK=$O(^TMP($J,"ORDSGCHK2","OUT","CHECK",ORI,ORJ,ORK)) Q:'ORK D
....N ORDGTYPE S ORDGTYPE="DS"
....N ORRTTYPE S ORRTTYPE=$P($G(^TMP($J,"ORDSGCHK2","OUT","CHECK",ORI,ORJ,ORK,"ATYPE")),U,2)
....I ORRTTYPE="INFORMATIONAL" S ORDGTYPE="INFO"
....I ORRTTYPE="GENERAL" S ORDGTYPE="INFO"
....I ORRTTYPE="EXCEPTION" S ORDGTYPE="INFO"
....S ORY=$G(ORY)+1,ORY(ORY)=ORDGTYPE_U
....N ORL S ORL=0 F S ORL=$O(^TMP($J,"ORDSGCHK2","OUT","CHECK",ORI,ORJ,ORK,"MSG",ORL)) Q:'ORL D
.....S ORY(ORY)=ORY(ORY)_^TMP($J,"ORDSGCHK2","OUT","CHECK",ORI,ORJ,ORK,"MSG",ORL)_" "
I $L(ORNBP)>1 S ORY=$G(ORY)+1,ORY(ORY)="ERR^"_ORNBP,ORNBP=""
Q
;
GETSUB(NAME) ;
I NAME="DAYS" Q "DRATE"
I NAME="ROUTE" Q "MR_IEN"
I "^CONJ^DOSE^SCHEDULE^"[(U_NAME_U) Q NAME
Q ""
;
DRATESTR(ORIN) ;change the form of the DURATION
;DAYS=D,WEEKS=W,MONTHS=L,HOURS=H,MINUTES=M
I $$UP^XLFSTR(ORIN)="MONTHS" Q "L"
Q $E($$UP^XLFSTR(ORIN))
;
DSDWNMSG() ;dosage down message (not displayed to user)
Q "Drug Dosage checks were not able to be performed."
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDSGCHK 10997 printed Apr 09, 2024@21:38:07 Page 2
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
+2 ;
EN(ORY,DFN,TYPE,OIL) ;
+1 NEW ARRAY,CNT,NAME
+2 ;if renewed order build OIL array
+3 IF $GET(ORREN)=1
IF +$GET(ORIFN)>0
Begin DoDot:1
+4 ;IV orders should only have a null type
+5 IF TYPE=""
SET TYPE="PSIV"
+6 DO BLDREN(TYPE,ORIFN,.OIL)
End DoDot:1
+7 ;Build easy array to work with
+8 SET CNT=0
FOR
SET CNT=$ORDER(OIL(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+9 SET NODE=$GET(OIL(CNT))
if $PIECE(NODE,U,2)="PSIV"
QUIT
+10 SET NAME=$PIECE(NODE,U,2)
+11 if '$PIECE(NODE,U,3)
QUIT
+12 SET ARRAY(NAME,$PIECE(NODE,U,3))=NODE
End DoDot:1
+13 IF TYPE="PSH"
QUIT
+14 IF TYPE="PSIV"
DO IV(.ORY,DFN,.ARRAY)
+15 IF TYPE'="PSIV"
DO NONIV(.ORY,DFN,.ARRAY)
+16 QUIT
+17 ;
BLDREN(TYPE,ORIFN,OUT) ;
+1 NEW CNT,EXTVALUE,ISOI,ITEM,LOC,NAME,NUM,NODE,ORDIALOG,TEXT,VALUE,X0,ORDSGSET
+2 SET ORDSGSET=0
+3 SET CNT=$ORDER(OUT(""),-1)
+4 SET X0=$GET(^OR(100,+ORIFN,0))
+5 SET ORDIALOG=+$PIECE(X0,U,5)
+6 DO GETDLG^ORCD(ORDIALOG)
+7 DO GETORDER^ORCD(+ORIFN)
+8 ; for titration renewals only copy maintenance portion
+9 IF $$ISTITR^ORUTL3(+ORIFN)
DO EDTDLG^ORWTITR(.ORDIALOG,+ORIFN)
+10 ;If Refills^Pickup^Days Supply^Quantity is passed in (with new renewal values), use new values
+11 IF $GET(ORRENFLDS)'=""
Begin DoDot:1
+12 SET ORDIALOG($$PTR^ORCD("OR GTX REFILLS"),1)=$PIECE(ORRENFLDS,U,1)
+13 SET ORDIALOG($$PTR^ORCD("OR GTX ROUTING"),1)=$PIECE(ORRENFLDS,U,2)
+14 SET ORDIALOG($$PTR^ORCD("OR GTX DAYS SUPPLY"),1)=$PIECE(ORRENFLDS,U,3)
+15 SET ORDIALOG($$PTR^ORCD("OR GTX QUANTITY"),1)=$PIECE(ORRENFLDS,U,4)
End DoDot:1
+16 SET LOC=0
FOR
SET LOC=$ORDER(ORDIALOG(LOC))
if LOC'>0
QUIT
Begin DoDot:1
+17 SET ITEM=$PIECE($GET(ORDIALOG(LOC)),U,2)
+18 IF ITEM=""
QUIT
+19 IF ITEM="COMMENT"
QUIT
+20 SET ISOI=$SELECT($GET(ORDIALOG(LOC,0))[101.43:1,1:0)
+21 SET NUM=0
FOR
SET NUM=$ORDER(ORDIALOG(LOC,NUM))
if NUM'>0
QUIT
Begin DoDot:2
+22 IF NUM<1
QUIT
+23 SET VALUE=$GET(ORDIALOG(LOC,NUM))
SET EXTVALUE=""
+24 IF ISOI=1
Begin DoDot:3
+25 SET EXTVALUE=$PIECE($GET(^ORD(101.43,VALUE,0)),U)
+26 IF $PIECE($GET(^ORD(101.41,LOC,0)),U)="OR GTX ADDITIVE"
SET ITEM="ADDITIVE"
End DoDot:3
+27 IF ITEM="RATE"
SET EXTVALUE=VALUE
+28 IF ITEM="DOSE"
SET ORDSGSET=1
+29 SET TEXT=TYPE_U_ITEM_U_NUM_U_VALUE_U_EXTVALUE
+30 SET CNT=CNT+1
SET OUT(CNT)=TEXT
End DoDot:2
End DoDot:1
+31 ;SET THE DOSE AS BLANK IN THE OUTPUT ARRAY IF IT WASN'T SET ALREADY
+32 IF 'ORDSGSET
SET CNT=CNT+1
SET OUT(CNT)=TYPE_U_"DOSE^1^^"
+33 QUIT
+34 ;
DURATION(STR) ;
+1 NEW LEN,VAL,UNIT,IVLMT,TVAL
+2 SET (UNIT,IVLMT)=""
SET VAL=0
+3 IF $EXTRACT($$LOW^XLFSTR(STR))="f"
Begin DoDot:1
+4 IF STR["for a total of"
Begin DoDot:2
+5 SET VAL=$PIECE(STR," ",5)
+6 SET UNIT=$PIECE(STR," ",6)
+7 SET STR=""
End DoDot:2
QUIT
+8 SET VAL=$PIECE(STR," ",2)
+9 SET UNIT=$EXTRACT($PIECE(STR," ",3))
+10 SET STR=""
End DoDot:1
+11 IF $EXTRACT($$LOW^XLFSTR(STR))="w"
Begin DoDot:1
+12 SET TVAL=$PIECE(STR," ",4)
+13 SET VAL=+TVAL
+14 SET LEN=$FIND(TVAL,VAL)
+15 IF $PIECE(VAL,".")=""
SET VAL=0_VAL
+16 FOR
SET UNIT=$EXTRACT(TVAL,LEN)
if ((UNIT'=0)&(UNIT'="."))
QUIT
Begin DoDot:2
+17 SET LEN=LEN+1
End DoDot:2
+18 SET STR=""
End DoDot:1
+19 IF $LENGTH(UNIT)
IF $LENGTH(VAL)
SET IVLMT=VAL_$$UP^XLFSTR(UNIT)
+20 IF STR'=""
IF IVLMT=""
Begin DoDot:1
+21 IF STR["ML"
SET IVLMT=$PIECE(STR,"M")_"M"
QUIT
+22 IF STR["CC"
SET IVLMT=$PIECE(STR,"C")_"M"
QUIT
+23 SET IVLMT=STR
End DoDot:1
+24 QUIT IVLMT
+25 ;
IV(ORY,DFN,ARRAY) ;
+1 NEW CNT,DRUG,DRUGIEN,DRUGNAME,NAME,NUM,OI,ORBASE,ORPSJARR,STR,STRENGTH,NODE
+2 ;
+3 IF '$DATA(ARRAY)
Begin DoDot:1
+4 SET ORY=$GET(ORY)+1
SET ORY(ORY)="ERR^Incomplete data. Dosage check could not be performed."
End DoDot:1
QUIT
+5 ;populate single values from order
+6 SET ORPSJARR("TVOL_DUR")=""
SET ORPSJARR("SCHEDULE")=""
+7 IF $DATA(ARRAY("DAYS"))
SET ORPSJARR("TVOL_DUR")=$$DURATION($PIECE(ARRAY("DAYS",1),U,4))
+8 ;S RATE=$P(ARRAY(NAME,1),U,4)
+9 SET ORPSJARR("MR_IEN")=$PIECE(ARRAY("ROUTE",1),U,4)
+10 IF $DATA(ARRAY("SCHEDULE"))
SET ORPSJARR("SCHEDULE")=$PIECE(ARRAY("SCHEDULE",1),U,4)
+11 SET ORPSJARR("IV_TYPE")=$SELECT($PIECE(ARRAY("TYPE",1),U,4)="I":1,1:2)
+12 IF ORPSJARR("IV_TYPE")=2
SET ORPSJARR("INF_RATE")=$PIECE(ARRAY("RATE",1),U,5)
+13 ;
+14 ;build additive first, Drug, Strength/unit, bag
+15 FOR NAME="ADDITIVE","ORDERABLE"
Begin DoDot:1
+16 KILL DRUG
+17 SET CNT=0
SET NUM=0
+18 FOR
SET NUM=$ORDER(ARRAY(NAME,NUM))
if NUM'>0
QUIT
Begin DoDot:2
+19 SET CNT=CNT+1
+20 SET NODE=$GET(ARRAY(NAME,NUM))
SET OI=$PIECE(NODE,U,4)
+21 ;
+22 ;PHARMACY OI FROM 101.43
SET DRUGIEN=+$PIECE(^ORD(101.43,OI,0),U,2)
IF DRUGIEN=""
QUIT
+23 ;OI NAME
SET DRUGNAME=$PIECE($GET(ARRAY(NAME,NUM)),U,5)
+24 ;
+25 IF NAME="ADDITIVE"
Begin DoDot:3
+26 SET STRENGTH=$PIECE($GET(ARRAY("STRENGTH",NUM)),U,4)_" "_$PIECE($GET(ARRAY("UNITS",NUM)),U,4)
+27 SET STR=+DRUGIEN_U_DRUGNAME_U_STRENGTH_U_$PIECE($GET(ARRAY("ADDFREQ",NUM)),U,4)
+28 SET ORPSJARR("AD",CNT)=STR_U_0
+29 ;check if enhanced order checks were done for this drug order and if so set ORDRUG(CNT,"ENH")=1
+30 IF $GET(^TMP($JOB,"ORENHCHK"))=1
SET ORPSJARR("AD",CNT)=STR_U_1
End DoDot:3
QUIT
+31 ;
+32 ;Solution information
+33 SET STR=+DRUGIEN_U_DRUGNAME_U_$PIECE($GET(ARRAY("VOLUME",NUM)),U,4)_" ML"
+34 SET ORPSJARR("SOL",CNT)=STR
SET $PIECE(ORPSJARR("SOL",CNT),U,5)=0
+35 ;check if enhanced order checks were done for this drug order and if so set ORDRUG(CNT,"ENH")=1
+36 IF $GET(^TMP($JOB,"ORENHCHK"))=1
SET ORPSJARR("SOL",CNT)=STR
SET $PIECE(ORPSJARR("SOL",CNT),U,5)=1
End DoDot:2
End DoDot:1
+37 ;
+38 IF $DATA(^TMP($JOB,"ORDSGCHK_CACHE"))
MERGE ^TMP($JOB,"ORDSGCHK2")=^TMP($JOB,"ORDSGCHK_CACHE")
+39 IF '$DATA(^TMP($JOB,"ORDSGCHK_CACHE"))
Begin DoDot:1
+40 SET ORBASE(1)="ORDSGCHK1"
+41 SET ORBASE(2)="ORDSGCHK2"
+42 DO DOSE^PSJAPIDS(.ORBASE,DFN,.ORPSJARR)
+43 MERGE ^TMP($JOB,"ORDSGCHK_CACHE")=^TMP($JOB,"ORDSGCHK2")
End DoDot:1
+44 DO PARSEOUT
+45 KILL ^TMP($JOB,"ORDSGCHK1"),^TMP($JOB,"ORDSGCHK2")
+46 QUIT
+47 ;
NONIV(ORY,DFN,ARRAY) ;
+1 NEW CNT,DISPDRUGIEN,DOSESTR,DRUG,DRUGARR,DRUGIEN,DRUGNAME,DUR,NAME,NODE
+2 NEW OIIEN,ORBASE,ORDRUG,ORPSARR,PACK,PSNODE,SUB,TYPE,ADMIN
+3 ;
+4 ;assume same drug type used throughout the order dialog
+5 ;new free-text dose orders do not have a drug, all other free-text orders do
+6 SET DISPDRUGIEN=+$PIECE($GET(ARRAY("DRUG",1)),U,4)
+7 IF DISPDRUGIEN>0
IF $$EXMT^PSSDSAPI(DISPDRUGIEN)=1
QUIT
+8 ;if no ARRAY(DOSE) node set it to null to force free text evaluation
+9 NEW I
SET I=0
FOR
SET I=$ORDER(ARRAY("INSTR",I))
if 'I
QUIT
IF '$DATA(ARRAY("DOSE",I))
SET ARRAY("DOSE",I)=$PIECE(ARRAY("INSTR",I),U)_"^DOSE^"_I_"^"
+10 ;
+11 SET ADMIN=""
SET ADMIN("SAVE")=1
+12 SET NAME=""
FOR
SET NAME=$ORDER(ARRAY(NAME))
if NAME=""
QUIT
Begin DoDot:1
+13 SET SUB=$$GETSUB(NAME)
IF SUB=""
QUIT
+14 SET CNT=0
FOR
SET CNT=$ORDER(ARRAY(NAME,CNT))
if CNT'>0
QUIT
Begin DoDot:2
+15 SET NODE=$GET(ARRAY(NAME,CNT))
+16 ;
+17 ;get dose information and drug information from Dose Prompt
+18 IF SUB="DOSE"
Begin DoDot:3
+19 SET PACK=$PIECE(NODE,U)
+20 SET TYPE=$SELECT($PIECE(NODE,U)="PSO":"O",1:"I")
+21 SET DOSESTR=$PIECE(NODE,U,4)
+22 ;free text dose
+23 IF DOSESTR=""
Begin DoDot:4
+24 SET ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT
+25 IF DISPDRUGIEN>0
Begin DoDot:5
+26 SET ORPSARR(CNT,"DO")=$PIECE($GET(ARRAY("INSTR",CNT)),U,4)
+27 SET ORDRUG(CNT,"DRUG_IEN")=DISPDRUGIEN
+28 ;DRUGNAME
SET ORDRUG(CNT,"DRUG_NM")=$$GETPSNM^ORKPS(DISPDRUGIEN)
End DoDot:5
QUIT
+29 NEW ORTDOSE,ORTDNAME
+30 SET ARRAY("ORPSA",CNT)=$$OI2DD^ORKPS($PIECE(ARRAY("ORDERABLE",1),U,4),$EXTRACT($PIECE(ARRAY("ORDERABLE",1),U,1),3),2)
+31 if '$PIECE(ARRAY("ORPSA",CNT),";",1)
QUIT
+32 KILL ^TMP($JOB,"DRUGARR")
DO ZERO^PSS50($PIECE(ARRAY("ORPSA",CNT),";",1),,,,,"DRUGARR")
+33 NEW ORDRGNM
SET ORDRGNM=$GET(^TMP($JOB,"DRUGARR",$PIECE(ARRAY("ORPSA",CNT),";",1),.01))
+34 SET ORPSARR(CNT,"DO")=$$TRIM^ORBCMA32($PIECE($PIECE($GET(ARRAY("INSTR",CNT)),U,4),ORDRGNM))
+35 ;orderable only exists for first item (in complex order)
SET OIIEN=$PIECE($GET(ARRAY("ORDERABLE",1)),U,4)
+36 SET ORDRUG("OI")=+$PIECE($GET(^ORD(101.43,OIIEN,0)),U,2)
+37 SET ORDRUG("PACKAGE")=$SELECT(PACK="PSO":"O",PACK="PSH":"X",1:"I")
+38 SET PSNODE=$GET(^ORD(101.43,OIIEN,"PS"))
+39 SET ORDRUG("OI_USAGE")=$SELECT($PIECE(PSNODE,U,4)=1:"A",1:"")_$SELECT($PIECE(PSNODE,U,3)=1:"B",1:"")
+40 SET ORDRUG(CNT,"DRUG_NM")=$$TRIM^ORBCMA32($PIECE($GET(ARRAY("ORDERABLE",1)),U,5))
End DoDot:4
+41 ;
+42 ;check if enhanced order checks were done for this drug order and if so set ORDRUG(CNT,"ENH")=1
+43 IF $GET(^TMP($JOB,"ORENHCHK"))=1
IF ((DOSESTR=""&$DATA(ORDRUG))!(DOSESTR'=""))
SET ORDRUG(CNT,"ENH")=1
+44 if DOSESTR=""
QUIT
+45 SET DRUGIEN=$PIECE(DOSESTR,"&",6)
+46 KILL ^TMP($JOB,"DRUGARR")
+47 DO ZERO^PSS50(DRUGIEN,,,,,"DRUGARR")
+48 SET DRUGNAME=$GET(^TMP($JOB,"DRUGARR",DRUGIEN,.01))
+49 KILL ^TMP($JOB,"DRUGARR")
+50 ;
+51 ;Local Possible Dose
+52 IF $PIECE(DOSESTR,"&")=""
Begin DoDot:4
+53 SET ORPSARR(CNT,"DO")=$PIECE($GET(ARRAY("INSTR",CNT)),U,4)
+54 SET ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT
+55 SET ORDRUG(CNT,"DRUG_IEN")=DRUGIEN
+56 ;DRUGNAME
SET ORDRUG(CNT,"DRUG_NM")=$$GETPSNM^ORKPS(DRUGIEN)
End DoDot:4
QUIT
+57 ;
+58 ;Possible Dose
+59 SET ORPSARR(CNT,"DRG_AMT")=$PIECE(DOSESTR,"&")
+60 SET ORPSARR(CNT,"DRG_UNIT")=$PIECE(DOSESTR,"&",2)
+61 SET ORDRUG(CNT,"RX_NUM")=TYPE_";1;PROSPECTIVE;"_CNT
+62 SET ORDRUG(CNT,"DRUG_IEN")=DRUGIEN
+63 ;DRUGNAME
SET ORDRUG(CNT,"DRUG_NM")=$$GETPSNM^ORKPS(DRUGIEN)
End DoDot:3
+64 ;
+65 ;Additional Order Data
+66 IF SUB="DRATE"
Begin DoDot:3
+67 SET DUR=$PIECE($PIECE(NODE,U,4)," ")
+68 SET ORPSARR(CNT,SUB)=DUR_$$DRATESTR($PIECE($PIECE(NODE,U,4)," ",2))
End DoDot:3
QUIT
+69 IF SUB="CONJ"
IF $PIECE(NODE,U)="PSI"
IF ADMIN("SAVE")
Begin DoDot:3
+70 if $DATA(ARRAY("SCHEDULE",CNT))=1
SET ADMIN=ADMIN_";"_$PIECE(ARRAY("SCHEDULE",CNT),U,4)
+71 IF $PIECE($GET(ARRAY(SUB,CNT)),U,4)'="A"
SET ADMIN("SAVE")=0
End DoDot:3
+72 SET ORPSARR(CNT,SUB)=$PIECE(NODE,U,4)
End DoDot:2
End DoDot:1
+73 ;
+74 ;Get rid of any preceeding or trailing spaces on the dose
+75 NEW ORSPI
SET ORSPI=0
FOR
SET ORSPI=$ORDER(ORPSARR(ORSPI))
if 'ORSPI
QUIT
Begin DoDot:1
+76 IF $DATA(ORPSARR(ORSPI,"DO"))
SET ORPSARR(ORSPI,"DO")=$$TRIM^XLFSTR(ORPSARR(ORSPI,"DO"))
End DoDot:1
+77 ;
+78 IF ADMIN'=""
Begin DoDot:1
+79 NEW ORAT
+80 DO ADMIN^ORWDPS2(.ORAT,DFN,ADMIN,$PIECE($GET(ARRAY("ORDERABLE",1)),U,4),+ORL,$PIECE($GET(ARRAY("ADMIN",1)),U,4))
+81 IF $PIECE(ORAT,U,4)'=""
SET ORPSARR(1,"EFD")=$PIECE(ORAT,U,4)
End DoDot:1
+82 ;
+83 IF $DATA(ORDRUG)
Begin DoDot:1
+84 SET ORBASE(1)="ORDSGCHK1"
SET ORBASE(2)="ORDSGCHK2"
+85 SET ORPSARR("CONTEXT")="CPRS-UD"
+86 DO DOSE^PSSDSAPD(.ORBASE,DFN,.ORPSARR,.ORDRUG)
DO PARSEOUT
+87 KILL ^TMP($JOB,"ORDSGCHK1"),^TMP($JOB,"ORDSGCHK2")
End DoDot:1
+88 QUIT
+89 ;
PARSEOUT ;PARSE OUTPUT GLOBAL
+1 NEW ORNBP
SET ORNBP=""
+2 IF $DATA(^TMP($JOB,"ORDSGCHK2"))
Begin DoDot:1
+3 IF $PIECE($GET(^TMP($JOB,"ORDSGCHK2","OUT",0)),U)=-1
SET ORNBP=$$DSDWNMSG^ORDSGCHK
QUIT
+4 IF $DATA(^TMP($JOB,"ORDSGCHK2","OUT","ERROR"))
Begin DoDot:2
+5 NEW I
SET I=""
FOR
SET I=$ORDER(^TMP($JOB,"ORDSGCHK2","OUT","ERROR",I))
if '$LENGTH(I)
QUIT
Begin DoDot:3
+6 NEW J
SET J=""
FOR
SET J=$ORDER(^TMP($JOB,"ORDSGCHK2","OUT","ERROR",I,J))
if '$LENGTH(J)
QUIT
Begin DoDot:4
+7 NEW K
SET K=""
FOR
SET K=$ORDER(^TMP($JOB,"ORDSGCHK2","OUT","ERROR",I,J,K))
if '$LENGTH(K)
QUIT
Begin DoDot:5
+8 IF $LENGTH($GET(^TMP($JOB,"ORDSGCHK2","OUT","ERROR",I,J,K,"MSG")))
SET ORY=$GET(ORY)+1
SET ORY(ORY)="ERR^"_^TMP($JOB,"ORDSGCHK2","OUT","ERROR",I,J,K,"MSG")
Begin DoDot:6
+9 IF $LENGTH($GET(^TMP($JOB,"ORDSGCHK2","OUT","ERROR",I,J,K,"TEXT")))
SET ORY(ORY)=ORY(ORY)_" "_$GET(^TMP($JOB,"ORDSGCHK2","OUT","ERROR",I,J,K,"TEXT"))
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+10 IF $DATA(^TMP($JOB,"ORDSGCHK2","OUT","CHECK"))
Begin DoDot:2
End DoDot:2
+11 NEW ORI
SET ORI=0
FOR
SET ORI=$ORDER(^TMP($JOB,"ORDSGCHK2","OUT","CHECK",ORI))
if 'ORI
QUIT
Begin DoDot:2
+12 NEW ORJ
SET ORJ=""
FOR
SET ORJ=$ORDER(^TMP($JOB,"ORDSGCHK2","OUT","CHECK",ORI,ORJ))
if '$LENGTH(ORJ)
QUIT
Begin DoDot:3
+13 NEW ORK
SET ORK=0
FOR
SET ORK=$ORDER(^TMP($JOB,"ORDSGCHK2","OUT","CHECK",ORI,ORJ,ORK))
if 'ORK
QUIT
Begin DoDot:4
+14 NEW ORDGTYPE
SET ORDGTYPE="DS"
+15 NEW ORRTTYPE
SET ORRTTYPE=$PIECE($GET(^TMP($JOB,"ORDSGCHK2","OUT","CHECK",ORI,ORJ,ORK,"ATYPE")),U,2)
+16 IF ORRTTYPE="INFORMATIONAL"
SET ORDGTYPE="INFO"
+17 IF ORRTTYPE="GENERAL"
SET ORDGTYPE="INFO"
+18 IF ORRTTYPE="EXCEPTION"
SET ORDGTYPE="INFO"
+19 SET ORY=$GET(ORY)+1
SET ORY(ORY)=ORDGTYPE_U
+20 NEW ORL
SET ORL=0
FOR
SET ORL=$ORDER(^TMP($JOB,"ORDSGCHK2","OUT","CHECK",ORI,ORJ,ORK,"MSG",ORL))
if 'ORL
QUIT
Begin DoDot:5
+21 SET ORY(ORY)=ORY(ORY)_^TMP($JOB,"ORDSGCHK2","OUT","CHECK",ORI,ORJ,ORK,"MSG",ORL)_" "
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+22 IF $LENGTH(ORNBP)>1
SET ORY=$GET(ORY)+1
SET ORY(ORY)="ERR^"_ORNBP
SET ORNBP=""
+23 QUIT
+24 ;
GETSUB(NAME) ;
+1 IF NAME="DAYS"
QUIT "DRATE"
+2 IF NAME="ROUTE"
QUIT "MR_IEN"
+3 IF "^CONJ^DOSE^SCHEDULE^"[(U_NAME_U)
QUIT NAME
+4 QUIT ""
+5 ;
DRATESTR(ORIN) ;change the form of the DURATION
+1 ;DAYS=D,WEEKS=W,MONTHS=L,HOURS=H,MINUTES=M
+2 IF $$UP^XLFSTR(ORIN)="MONTHS"
QUIT "L"
+3 QUIT $EXTRACT($$UP^XLFSTR(ORIN))
+4 ;
DSDWNMSG() ;dosage down message (not displayed to user)
+1 QUIT "Drug Dosage checks were not able to be performed."
