- 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 Feb 18, 2025@23:56:35 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."