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