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