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

ORQRY.m

Go to the documentation of this file.
  1. ORQRY ; SLC/MKB/JDL - Order Query utilities ;3/17/03 14:45
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153,174**;Dec 17, 1997
  1. ;
  1. ;
  1. PP(DFN,PROV) ; -- Returns 1 or 0, if PROV is prim prov for DFN
  1. N X,Y I '$G(DFN)!'$G(PROV) Q ""
  1. S X=$$OUTPTPR^SDUTL3(+DFN),Y=$S(+X=+PROV:1,1:0)
  1. Q Y
  1. ;
  1. ACT(DFN,BEG,END,LOC) ; -- Returns 1 or 0, if recent activity for DFN
  1. ; BEG = beginning date [default = DT-1yr]
  1. ; END = ending date [default = DT]
  1. ; LOC(IEN) = list of clinic IENs from #44 [default = all]
  1. N X,YY,VASD,VAERR,IDT,DA
  1. N VSTH,IX,JX
  1. S DFN=+$G(DFN),YY=0 I '$G(DFN) Q ""
  1. S BEG=$G(BEG,DT-10000),END=$G(END,DT) ;default=last year
  1. I END<BEG S X=END,END=BEG,BEG=X
  1. I '$D(LOC) D G:YY ACTQ ;check inpatient, Rx data
  1. . ;curr inpt
  1. . I $G(^DPT(DFN,.105)) S YY=1 Q
  1. . S X=+$O(^DGPM("APRD",DFN,BEG))
  1. . ; admission
  1. . I X,X'>END S YY=1 Q
  1. . ;Rx
  1. . D OCL^PSOORRL(DFN,BEG,END) I $O(^TMP("PS",$J,0)) S YY=1 Q
  1. S VSTH="",(IX,JX)=0
  1. D VST^ORWCV(.VSTH,DFN,BEG,END)
  1. F S IX=$O(VSTH(IX)) Q:'IX D
  1. . F S JX=$O(LOC(JX)) Q:'JX D
  1. . . I +$P($G(VSTH(IX)),";",3)=JX S YY=1 Q
  1. I YY=1 G ACTQ
  1. S IDT=BEG-.0001 F S IDT=$O(^SCE("ADFN",DFN,IDT)) Q:IDT<1!(IDT>END) D Q:YY ;IA #2065
  1. . I '$D(LOC) S YY=1 Q
  1. . S DA=0 F S DA=+$O(^SCE("ADFN",DFN,IDT,DA)) Q:DA<1 I $D(LOC(+$P($G(^SCE(DA,0)),U,4))) S YY=1 Q
  1. ACTQ K ^UTILITY("VASD",$J),^TMP("PS",$J)
  1. Q YY
  1. ;
  1. BYPT(ORY,DFN,QRY) ; -- Returns report data in @ORY based on QRY parameters
  1. Q:'$G(DFN) N PAT,ORYPAT,VA,VADM,VAIN,VAERR ;M ^XTMP("ORQRY",$G(DUZ)_";"_$H)=QRY
  1. S ORY=$G(ORY,"^TMP($J)"),DFN=+DFN D OERR^VADPT
  1. S ORYPAT("Patient.DFN")=DFN,PAT=DFN_";DPT("
  1. S ORYPAT("Patient.Age")=VADM(4),ORYPAT("Patient.Name")=VADM(1)
  1. S ORYPAT("Patient.Last4")=$E(VADM(1))_VA("BID")
  1. S ORYPAT("Patient.Ward")=$S(VAIN(4):$P(VAIN(4),U,2)_" "_VAIN(5),1:"")
  1. I $D(QRY("Document")) D DOCMTS
  1. I $D(QRY("Order")) D ORDERS
  1. I $D(QRY("Consult")) D CSLTS
  1. I $D(QRY("Visit")) D VISITS
  1. Q
  1. ;
  1. DOCMTS ; -- Find documents
  1. N DOCMT
  1. M DOCMT=QRY("Document")
  1. D DOCDT^ORQRY01(.DOCMT)
  1. D QUERY^TIUQRY(ORY,.DOCMT,.ORYPAT)
  1. I $D(DOCMT("NegativeSearch")) D NEGATE("Documents")
  1. Q
  1. ;
  1. CSLTS ; -- Find consults (treats consults as special case of orders)
  1. N ORDER,ORGRP,SDATE,EDATE,ORCNT,X,CSLTMODE
  1. M ORDER=QRY("Consult") S ORCNT=0,CSLTMODE=1
  1. I '$D(ORDER("DisplayGroup")) D
  1. . S ORDER("DisplayGroup",$O(^ORD(100.98,"B","CSLT",0)))=""
  1. G ORDERS1
  1. ;
  1. ORDERS ; -- Find orders
  1. N ORDER,ORGRP,SDATE,EDATE,ORCNT,I
  1. M ORDER=QRY("Order") S ORCNT=0
  1. ORDERS1 N ORCBO I $D(ORDER("ItemCombo1"))>1 S (ORCBO(1),ORCBO(2))=-1
  1. I $D(ORDER("DisplayGroup"))>1 S I=0 F S I=$O(ORDER("DisplayGroup",I)) Q:'I D GRP(I)
  1. D DATES,@$S($D(ORDER("Abnormal")):"ARSX",1:"ACTX") ;$G(ORDER("View")):"AVWX"
  1. ; if looking for a combination and both not there, remove the orders
  1. I $D(ORCBO),((ORCBO(1)=-1)!(ORCBO(2)=-1)) D
  1. . D RMOV($S($G(CSLTMODE):"CST",1:"ORD"))
  1. . S ORCNT=0
  1. S:'$D(CSLTMODE) @ORY@(0,"Orders")=ORCNT
  1. S:$D(CSLTMODE) @ORY@(0,"Consults")=ORCNT
  1. I $D(ORDER("NegativeSearch")) D NEGATE($S($G(CSLTMODE):"Consults",1:"Orders"))
  1. Q
  1. ;
  1. GRP(DG) ; -- Setup display group DG in ORGRP()
  1. N STK,MEM
  1. S ORGRP(DG)="",STK=1,STK(STK)=DG_"^0",STK(0)=0,MEM=0
  1. F S MEM=$O(^ORD(100.98,+STK(STK),1,MEM)) D @$S(+MEM'>0:"POP",1:"PROC") Q:STK<1
  1. Q
  1. POP S STK=STK-1,MEM=$P(STK(STK),"^",2)
  1. Q
  1. PROC S $P(STK(STK),"^",2)=MEM,DG=$P(^ORD(100.98,+STK(STK),1,MEM,0),"^",1)
  1. S ORGRP(DG)="",STK=STK+1,STK(STK)=DG_"^0",MEM=0
  1. Q
  1. ;
  1. DATES ; -- Return SDATE and EDATE from TimeFrame
  1. ; [Inverted for rev-chron search]
  1. N X S X=$O(ORDER("TimeFrame","")),SDATE=$P(X,":"),EDATE=$P(X,":",2)
  1. I EDATE S EDATE=$S($L(EDATE,".")=2:EDATE+.0001,1:EDATE+1)
  1. I SDATE S SDATE=$S($L(SDATE,".")=2:SDATE-.0001,1:SDATE)
  1. S SDATE=9999999-$S(SDATE:SDATE,1:0),EDATE=9999999-$S(EDATE:EDATE,1:9999998)
  1. S X=EDATE,EDATE=SDATE,SDATE=X
  1. Q
  1. ;
  1. AVWX ; -- use ORQ1 for order view
  1. N X,DG,MULT,ORLIST,ORI,IFN,ACT
  1. S X=$O(ORDER("TimeFrame","")),SDATE=$P(X,":"),EDATE=$P(X,":",2)
  1. S DG=+$O(^ORD(100.98,"B","ALL",0)),X=$G(ORDER("View"))
  1. S MULT=$S("^1^6^8^9^10^11^13^14^20^22^"[(U_X_U):1,1:0)
  1. D EN^ORQ1(PAT,,X,,SDATE,EDATE,,MULT)
  1. S ORI=0 F S ORI=$O(^TMP("ORR",$J,ORLIST,ORI)) Q:ORI'>0 S IFN=$G(^(ORI)),ACT=$P(IFN,";",2) D CONT
  1. K ^TMP("ORR",$J,ORLIST)
  1. Q
  1. ;
  1. ARSX ; -- loop on ARS xref
  1. N IDX,IFN
  1. S IDX="^OR(100,""ARS"",PAT,SDATE)"
  1. F S IDX=$Q(@IDX) Q:$P(IDX,"""",4)'=PAT Q:$P(IDX,",",4)>EDATE D
  1. . S IFN=+$P(IDX,",",5) D CONT
  1. Q
  1. ACTX ; -- loop on "ACT" xref
  1. N IDX,IFN,ACT
  1. S IDX="^OR(100,""ACT"",PAT,SDATE)"
  1. F S IDX=$Q(@IDX) Q:$P(IDX,"""",4)'=PAT Q:$P(IDX,",",4)>EDATE D
  1. . S IFN=+$P(IDX,",",6),ACT=+$P(IDX,",",7)
  1. . I $P($G(^OR(100,IFN,8,ACT,0)),U,2)="NW"!$D(ORDER("SignStatus")) D CONT
  1. Q
  1. CONT ; -- Proceed with checking order ORDER() & IFN [from ARS,ACT]
  1. N X,X0,X3,X7,X8,ACTN
  1. S X0=$G(^OR(100,IFN,0)),X3=$G(^(3)),X7=$G(^(7))
  1. Q:$P(X3,U,8) I $P(X3,U,9),'$P($G(^OR(100,+$P(X3,U,9),3)),U,8) Q
  1. ;I $L($P(X0,U,17)),"^10^11^"[(U_STS_U) S X=$$LAPSED^OREVNTX($P(X0,U,17))
  1. I $D(ORGRP) Q:'$D(ORGRP(+$P(X0,U,11)))
  1. I $D(ORDER("Requestor")) Q:'$D(ORDER("Requestor",+$P(X0,U,4))) ;X8?
  1. I $D(ORDER("Status")) Q:'$D(ORDER("Status",+$P(X3,U,3)))
  1. I $D(ORDER("Abnormal")) Q:'$P(X7,U,2)
  1. I $D(ORDER("Orderable")) Q:'$$OI(IFN)
  1. S ACTN=$S($G(ACT):ACT,1:$$LAST(IFN)),X8=$G(^OR(100,IFN,8,ACTN,0))
  1. S TXT=+$P(X8,U,14) I $D(ORDER("Text")) Q:'$$TEXT(IFN,TXT)
  1. I $D(ORDER("SignStatus")) Q:'$L($P(X8,U,4)) Q:'$D(ORDER("SignStatus",+$P(X8,U,4)))
  1. ;I $D(ORDER("Requestor")) Q:'$D(ORDER("Requestor",+$P(X8,U,3)))
  1. D SAVEORD
  1. Q
  1. ;
  1. LAST(IFN) ; -- Returns DA of current/latest action for order IFN
  1. ; (Only NW or XX actions?)
  1. N Y S Y=+$P($G(^OR(100,IFN,3)),U,7)
  1. I Y<1 S Y=+$O(^OR(100,IFN,8,"?"),-1)
  1. Q Y
  1. ;
  1. OI(IFN) ; -- Return 1 or 0, if IFN contains any requested OI's
  1. N ITM,Y S Y=0
  1. S ITM=0 F S ITM=$O(ORDER("Orderable",ITM)) Q:ITM<1 I $D(^OR(100,IFN,.1,"B",ITM)) S Y=1 Q
  1. Q Y
  1. ;
  1. TEXT(IFN,TXT) ; -- Return 1 or 0, if IFN;TXT text contains requested string
  1. N X,Y,I S Y=0
  1. S X="" F S X=$O(ORDER("Text",X)) Q:X="" S I=0 D
  1. . F S I=+$O(^OR(100,IFN,8,TXT,.1,I)) Q:I<1 I $$UP^XLFSTR($G(^(I,0)))[$$UP^XLFSTR(X) S Y=1 Q
  1. Q Y
  1. ;
  1. SAVEORD ; -- Save order number in @ORY@("ORD:IFN;ACTN")
  1. ; Called from CONT: also uses X0,X3,X8,TXT,ORYPAT
  1. N ID,X
  1. S ID=$S($D(CSLTMODE):"CST:",1:"ORD:")_IFN_";"_ACTN,ORCNT=ORCNT+1
  1. S @ORY@(ID,"Order.Datetime")=$S($P(X0,U,8):$P(X0,U,8),1:$P(X8,U,16))
  1. S @ORY@(ID,"Order.DisplayGroup")=$P($G(^ORD(100.98,+$P(X0,U,11),0)),U)
  1. S @ORY@(ID,"Order.Provider")=$P($G(^VA(200,+$P(X0,U,4),0)),U)
  1. S X=$P(X8,U,4),@ORY@(ID,"Order.Signature")=$S(X=0!(X=4):"on chart",X=1:"electronically signed",X=2:"unsigned",X=3:"not required",X=5:"cancelled",X=6:"service correction",X=7:"digitally signed",1:"")
  1. S @ORY@(ID,"Order.Status")=$$LOW^XLFSTR($P($G(^ORD(100.01,+$P(X3,U,3),0)),U))
  1. S @ORY@(ID,"Order.Abnormal")=$S($P(X7,U,2):"YES",X7:"NO",1:"")
  1. S @ORY@(ID,"Order.Finding")=$P(X7,U,3)
  1. S @ORY@(ID,"Order.Text")=$$BLDTXT(IFN,TXT)
  1. M @ORY@(ID)=ORYPAT
  1. I $D(ORCBO) D SETCBO(IFN)
  1. Q
  1. BLDTXT(IFN,TXT) ; -- Return concatenated order text up to 245 chars
  1. N I,ALL,PART,MAX S ALL="",MAX=0
  1. S I=0 F S I=$O(^OR(100,IFN,8,TXT,.1,I)) Q:'I D Q:MAX
  1. . S PART=$G(^OR(100,IFN,8,TXT,.1,I,0))
  1. . I ($L(ALL)+$L(PART))<245 S ALL=ALL_$S($L(ALL):" ",1:"")_PART
  1. . E S MAX=1
  1. I MAX S ALL=ALL_"..."
  1. Q ALL
  1. ;
  1. SETCBO(IFN) ; -- Set flags when looking for combinations of orderable items
  1. N I,OI
  1. S I=0 F S I=$O(^OR(100,IFN,.1,I)) Q:'I D
  1. . S OI=+^OR(100,IFN,.1,I,0)
  1. . I $D(ORDER("ItemCombo1",OI)) S ORCBO(1)=1
  1. . I $D(ORDER("ItemCombo2",OI)) S ORCBO(2)=1
  1. Q
  1. ;
  1. VISITS ; -- Find clinic visits
  1. ; Save in @ORY@("VST:TYPE;DT;LOC")
  1. N VISIT,X,SDATE,EDATE,ORV,ORCNT,I,ID,VTYPE
  1. M VISIT=QRY("Visit")
  1. S X=$O(VISIT("TimeFrame","")),SDATE=$P(X,":"),EDATE=$P(X,":",2)
  1. S SDATE=SDATE-.0001 S:$L(EDATE,".")<2 EDATE=EDATE+.9999
  1. D VST^ORWCV(.ORV,DFN,SDATE,EDATE,1) S ORCNT=0
  1. S I=0 F S I=+$O(ORV(I)) Q:I<1 D
  1. . S X=ORV(I) Q:'$$ISVALID(X)
  1. . Q:$P(X,";",2)>(EDATE+1)
  1. . S VTYPE=$P(ORV(I),";")
  1. . S ID="VST:"_$P(X,U),ORCNT=ORCNT+1
  1. . S @ORY@(ID,"Visit.Datetime")=$P(ID,";",2)
  1. . S @ORY@(ID,"Visit.Location")=$P(X,U,3)
  1. . S @ORY@(ID,"Visit.NoShow")=$S($E(X)'="A":"",$$UP^XLFSTR($P(X,U,4))["NO-SHOW":"YES",1:"NO")
  1. . S:VTYPE'="I" @ORY@(ID,"Visit.Status")=$P(X,U,4)
  1. . M @ORY@(ID)=ORYPAT
  1. S @ORY@(0,"Visits")=ORCNT
  1. I $D(VISIT("NegativeSearch")) D NEGATE("Visits")
  1. Q
  1. ;
  1. ISVALID(VST) ; -- True: valid visit data
  1. N IX,VSTID,ISVAL
  1. S VSTID=+$P(VST,";",3)
  1. S (IX,ISVAL)=0
  1. F S IX=$O(VISIT("Location",IX)) Q:'IX D
  1. . I IX=VSTID S ISVAL=1 Q
  1. S:'$D(VISIT("Location")) ISVAL=1
  1. Q ISVAL
  1. ;
  1. NEGATE(SRCHITM) ; -- set report to return nodes only when nothing found
  1. N ID,RTNCNT,PRE
  1. I SRCHITM="Consults" S ID="PTC:"_DFN,PRE="CST"
  1. I SRCHITM="Orders" S ID="PTO:"_DFN,PRE="ORD"
  1. I SRCHITM="Documents" S ID="PTD:"_DFN,PRE="DOC"
  1. I SRCHITM="Visits" S ID="PTV:"_DFN,PRE="VST"
  1. S RTNCNT=@ORY@(0,SRCHITM)
  1. I RTNCNT=0 D
  1. . M @ORY@(ID)=ORYPAT
  1. . S @ORY@(ID,"Patient.NoneFound")=SRCHITM
  1. . S @ORY@(0,SRCHITM)=1
  1. E D
  1. . D RMOV(PRE)
  1. . S @ORY@(0,SRCHITM)=0
  1. Q
  1. ;
  1. RMOV(PRE) ; -- Remove nodes based on ID prefix
  1. N ID
  1. S ID="" F S ID=$O(@ORY@(ID)) Q:ID="" I $P(ID,":")=PRE K @ORY@(ID)
  1. Q