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 Sep 23, 2025@20:07:30 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 ;
