ORRHCQ ; SLC/KCM/JLI - CPRS Query Tools - Utilities ;2/1/03 11:10
;;3.0;ORDER ENTRY/RESULTS REPORTING;**153,174**;Dec 17, 1997
;
SETUP(ITR,QRY) ; Setup the query
; use ^TMP("ORRHCQ",$J,"QRY") for the query
; use ^TMP("ORRHCQ",$J,"COL") for the columns
; use ^TMP("ORRHCQD",$J) for the query data
D CLEAR(.OK)
N I,X,NAM,VAL,CID,ICOL,QROOT,DTRNG,CSLTGRP S ICOL=0,ITR=0,CSLTGRP=0
S I=0 F S I=$O(QRY(I)) Q:'I D
. S NAM=$P(QRY(I),"="),VAL=$P(QRY(I),"=",2,99)
. ; if time range, convert relative to actual fileman times
. S CID=+$O(^ORD(102.22,"B",NAM,0))
. I +CID S:$P(^ORD(102.22,CID,0),U,2)=2 VAL=$$RNG2FM^ORRHCU(VAL)
. I $L(VAL) S ^TMP("ORRHCQ",$J,"QRY",$P(NAM,"."),$P(NAM,".",2),VAL)=""
. I NAM="Report.Column" S ICOL=ICOL+1,^TMP("ORRHCQ",$J,"COL",ICOL)=VAL
; when looking for combination of items, create full list to pass to query
S QROOT="^TMP(""ORRHCQ"",$J,""QRY"")"
I $D(@QROOT@("Order","ItemCombo1"))>1 D
. M @QROOT@("Order","Orderable")=@QROOT@("Order","ItemCombo1")
. M @QROOT@("Order","Orderable")=@QROOT@("Order","ItemCombo2")
I $D(@QROOT@("Consult","ItemCombo1"))>1 D
. M @QROOT@("Consult","Orderable")=@QROOT@("Consult","ItemCombo1")
. M @QROOT@("Consult","Orderable")=@QROOT@("Consult","ItemCombo2")
I $D(@QROOT@("Consult","DisplayGroup"))>1 D
. S CSLTGRP=$O(^ORD(100.98,"B","CSLT",0))
. I CSLTGRP=$O(@QROOT@("Consult","DisplayGroup",0)) Q
. M @QROOT@("Consult","Orderable")=@QROOT@("Consult","DisplayGroup")
. K @QROOT@("Consult","DisplayGroup")
; set up actual dates for clinic list sources
S X=""
F S X=$O(@QROOT@("Patient","ListSource",X)) Q:X="" I $E(X)="c" D
. S DTRNG=$P(X,":",3,4),DTRNG=$$RNG2FM^ORRHCU(DTRNG)
. K @QROOT@("Patient","ListSource",X)
. S @QROOT@("Patient","ListSource",$P(X,":",1,2)_":"_DTRNG)=""
; set up date ranges for search items based on general date range
S DTRNG=$O(@QROOT@("Search","DateRange",0))
I $D(@QROOT@("Document")) S @QROOT@("Document","Reference",DTRNG)=""
I $D(@QROOT@("Order")) S @QROOT@("Order","TimeFrame",DTRNG)=""
I $D(@QROOT@("Consult")) S @QROOT@("Consult","TimeFrame",DTRNG)=""
I $D(@QROOT@("Visit")) S @QROOT@("Visit","TimeFrame",DTRNG)=""
S ^TMP("ORRHCQ",$J,"TOT")=0
S ITR=$$NXTITER("")
Q
ADDTO(IEN,CLINDT) ;Add active location to lst
N IEN42
S IEN42=0
I ($P($G(^SC(IEN,0)),U,3)="C"),$$ACTLOC^ORWU(IEN) D
. S @QROOT@("Patient","ListSource","c:"_IEN_":"_CLINDT)=""
I ($P($G(^SC(IEN,0)),U,3)="W"),$$ACTLOC^ORWU(IEN) D
. S IEN42=$G(^SC(IEN,42))
. S:IEN42 @QROOT@("Patient","ListSource","w:"_IEN42_":")=""
Q
WCFDIV(DIVLST) ;Get wards/clinics for division
N XXI,XXJ,NNN,CDTR
S (XXI,NNN)=0,CDTR=""
F S XXI=$O(DIVLST(XXI)) Q:'XXI D
. S CDTR=$P(DIVLST(XXI),":",2,3)
. S XXJ=0
. F S XXJ=$O(^SC(XXJ)) Q:'XXJ D
. . I $P(^SC(XXJ,0),U,4)=+DIVLST(XXI) D ADDTO(XXJ,CDTR)
Q
DODIV ; find Wards/Clinics for divisions
N XI,XJ,NN,WCLST,DIVLST,DIVPTR
S (XI,XJ,DIVLST)="",(NN,DIVPTR)=0
F S XI=$O(@QROOT@("Patient","ListSource",XI)) Q:XI="" I $E(XI)="d" D
. S NN=NN+1,DIVLST(NN)=$P(XI,":",2,4)
. K @QROOT@("Patient","ListSource",XI)
Q:$D(DIVLST)=1
S XI=""
F S XJ=$O(@QROOT@("Patient","ListSource",XJ)) Q:XJ="" I "cw"[$E(XJ) D
. S DIVPTR=$P($G(^SC($P(XJ,":",2),0)),U,4) Q:'DIVPTR
. F S XI=$O(DIVLST(XI)) Q:'XI D
. . I DIVPTR=+DIVLST(XI) K @QROOT@("Patient","ListSource",XJ)
D WCFDIV(.DIVLST)
Q
CLEAR(OK) ; Clear/Cancel the query
K ^TMP("ORRHCQ",$J),^TMP("ORRHCQD",$J) ;LW UNCOMMENT
K ^TMP("ORRHCQB",$J),^TMP("ORRHCQS",$J) ;LW UNCOMMENT
S OK=1
Q
NXTITER(X) ; Return the iterator for the next patient
; ITER=Subscript;DFN;Item#
N SUB,ITM,DFNITM
S SUB=$P(X,";",1),ITM=$P(X,";",3)
F D Q:+DFNITM Q:SUB="" ; loop until DFN or no subscripts
. S DFNITM=$$NXTDFN(SUB,ITM)
. Q:+DFNITM
. S SUB=$O(^TMP("ORRHCQ",$J,"QRY","Patient","ListSource",SUB))
. Q:SUB=""
. D SETPTS(SUB)
. S ITM=0
Q:+DFNITM=0 ""
Q SUB_";"_DFNITM
;
NXTDFN(SUB,ITM) ; Return the next patient^item within a subscript
Q:SUB="" 0
N DFN S DFN=""
I $E(SUB)="r" D
. N RC,ITR
. M ITR=^TMP("ORRHCQ",$J,"PTLST",SUB,"ITR")
. S RC=$$NEXTPAT^RORAPI01(.ITR)
. M ^TMP("ORRHCQ",$J,"PTLST",SUB,"ITR")=ITR
. S DFN=$P(RC,U),ITM=0
E D
. S ITM=$O(^TMP("ORRHCQ",$J,"PTLST",SUB,+ITM))
. I ITM S DFN=+^TMP("ORRHCQ",$J,"PTLST",SUB,ITM)
Q DFN_";"_ITM
;
SETPTS(SUB) ; Set up to iterate through a patient list
N LST
I $E(SUB)="c" D CLINPTS^ORQRY01(.LST,$P(SUB,":",2),$P(SUB,":",3),$P(SUB,":",4)) M:$D(@LST)>1 ^TMP("ORRHCQ",$J,"PTLST",SUB)=@LST Q
I $E(SUB)="w" D BYWARD^ORWPT(.LST,$P(SUB,":",2))
I $E(SUB)="t" D TEAMPTS^ORQPTQ1(.LST,$P(SUB,":",2))
I $E(SUB)="s" D SPECPTS^ORQPTQ2(.LST,$P(SUB,":",2))
I $E(SUB)="p" D PROVPTS^ORQPTQ2(.LST,$P(SUB,":",2))
I $D(LST)>1 M ^TMP("ORRHCQ",$J,"PTLST",SUB)=LST Q
;
N ITR
I ($E(SUB)="r"),'($$PATITER^RORAPI01(.ITR,$P(SUB,":",2),$P(SUB,":",3))) D
. M ^TMP("ORRHCQ",$J,"PTLST",SUB,"ITR")=ITR
Q
QRYITR(VAL,ORRITR) ; Do query for the current iterator
; VAL=PtSearched^RecordsFound^Iterator
S VAL=$$PTSCRN($P(ORRITR,";",2))
I VAL S $P(VAL,U,2)=$$QRYPT($P(ORRITR,";",2))
S $P(VAL,U,3)=$$NXTITER(ORRITR)
Q
;
PTSCRN(PATID) ; Return 1 if should continue with this patient
Q:$D(^TMP("ORRHCQ",$J,"DFN",PATID)) 0
N PRILST,LOCLST,DATRNG,CONT
M PRILST=^TMP("ORRHCQ",$J,"QRY","Patient","Primary")
M LOCLST=^TMP("ORRHCQ",$J,"QRY","Patient","Location")
S DATRNG=$O(^TMP("ORRHCQ",$J,"QRY","Patient","DateRange",0)),CONT=1
;
; check if pt has primary provider in the list
I $D(PRILST)>1 D
. N FND,IPP S FND=0,IPP=0
. F S IPP=$O(PRILST(IPP)) Q:'IPP S FND=$$PP^ORQRY(PATID,IPP) Q:FND
. I 'FND S CONT=0
Q:CONT=0 0
;
; check if pt has visit at during date range at optional location
I $L(DATRNG) D
. S:$D(LOCLST) CONT=$$ACT^ORQRY(PATID,$P(DATRNG,":"),$P(DATRNG,":",2),.LOCLST)
. S:'$D(LOCLST) CONT=$$ACT^ORQRY(PATID,$P(DATRNG,":"),$P(DATRNG,":",2))
I CONT S ^TMP("ORRHCQ",$J,"DFN",PATID)=""
Q CONT
;
QRYPT(PATID) ; Search for records and return the number found
N QRY,ROOT,CNT
K ^TMP("ORRHCQP",$J)
S ROOT="^TMP(""ORRHCQP"",$J)"
M QRY=^TMP("ORRHCQ",$J,"QRY")
D BYPT^ORQRY(ROOT,PATID,.QRY)
S CNT=$G(^TMP("ORRHCQP",$J,0,"Documents"))+$G(^("Orders"))+$G(^("Visits"))+$G(^("Consults"))
S ^TMP("ORRHCQ",$J,"TOT")=^TMP("ORRHCQ",$J,"TOT")+CNT
M ^TMP("ORRHCQD",$J)=^TMP("ORRHCQP",$J)
K ^TMP("ORRHCQP",$J)
Q CNT
SORTBY(SEQ,FNM,FWD) ; Sort by a particular field
N ID,KEY
K ^TMP("ORRHCQB",$J),^TMP("ORRHCQS",$J)
S SEQ=0 I 'FWD S SEQ=^TMP("ORRHCQ",$J,"TOT")+1
S ID=0 F S ID=$O(^TMP("ORRHCQD",$J,ID)) Q:ID="" D
. S KEY=$E($G(^TMP("ORRHCQD",$J,ID,FNM),"~~~~~~~~~~~~~~~~"),1,64)
. S KEY=$TR(KEY,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
. S:KEY="" KEY=" "
. S ^TMP("ORRHCQB",$J,KEY,ID)=""
S KEY="" F S KEY=$O(^TMP("ORRHCQB",$J,KEY)) Q:KEY="" D
. S ID="" F S ID=$O(^TMP("ORRHCQB",$J,KEY,ID)) Q:ID="" D
. . S:FWD SEQ=SEQ+1 S:'FWD SEQ=SEQ-1
. . S ^TMP("ORRHCQS",$J,SEQ)=ID
Q
SUBDTA(LST,FIRST,LAST) ; Return name-value pairs for subset of query data
N SEQ,COL,ID,ICOL,ILST S ILST=0
M COL=^TMP("ORRHCQ",$J,"COL")
F SEQ=FIRST:1:LAST D
. Q:'$D(^TMP("ORRHCQS",$J,SEQ))
. S ID=^TMP("ORRHCQS",$J,SEQ)
. S ILST=ILST+1,LST(ILST)="RowItemID="_ID
. S ICOL=0 F S ICOL=$O(COL(ICOL)) Q:'ICOL D
. . S ILST=ILST+1
. . S LST(ILST)=COL(ICOL)_"="_$G(^TMP("ORRHCQD",$J,ID,COL(ICOL)))
Q
DETAIL(REF,ID) ; Return results of order identified by ID
K ^TMP("ORXPND",$J)
N ORESULTS,ORVP,LCNT,ORID S ORESULTS=1,LCNT=0
I ID[":" S ID=$P(ID,":",2) ;strip off prefix
S ORVP=$P(^OR(100,+ID,0),U,2),ORID=ID
D ORDERS^ORCXPND1 S ID=ORID
D ORDERS^ORCXPND2
K ^TMP("ORXPND",$J,"VIDEO")
S REF=$NA(^TMP("ORXPND",$J))
Q
PTINFO(VAL,ID) ; Return patient info given an order, consult, or note
N DFN,X,X0,X1,X101
S VAL="",DFN=0,X=$P(ID,":")
I X="ORD"!(X="CST") S DFN=+$P(^OR(100,+$P(ID,":",2),0),U,2)
I X="DOC" S DFN=+$P(^TIU(8925,+$P(ID,":",2),0),U,2)
;I X="VST" visits too?
Q:'DFN
S X0=^DPT(DFN,0),X1=$G(^(.1)),X101=$G(^(.101))
S VAL=$P(X0,U)_U_$P(X0,U,9)_U_X1_" "_X101
Q
RNGFM(ORY,RNG) ;Return FM date range string
Q:'$L(RNG)
S ORY=$$RNG2FM^ORRHCU(RNG)
Q
ORRHCQ ; SLC/KCM/JLI - CPRS Query Tools - Utilities ;2/1/03 11:10
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**153,174**;Dec 17, 1997
+2 ;
SETUP(ITR,QRY) ; Setup the query
+1 ; use ^TMP("ORRHCQ",$J,"QRY") for the query
+2 ; use ^TMP("ORRHCQ",$J,"COL") for the columns
+3 ; use ^TMP("ORRHCQD",$J) for the query data
+4 DO CLEAR(.OK)
+5 NEW I,X,NAM,VAL,CID,ICOL,QROOT,DTRNG,CSLTGRP
SET ICOL=0
SET ITR=0
SET CSLTGRP=0
+6 SET I=0
FOR
SET I=$ORDER(QRY(I))
IF 'I
QUIT
Begin DoDot:1
+7 SET NAM=$PIECE(QRY(I),"=")
SET VAL=$PIECE(QRY(I),"=",2,99)
+8 ; if time range, convert relative to actual fileman times
+9 SET CID=+$ORDER(^ORD(102.22,"B",NAM,0))
+10 IF +CID
IF $PIECE(^ORD(102.22,CID,0),U,2)=2
SET VAL=$$RNG2FM^ORRHCU(VAL)
+11 IF $LENGTH(VAL)
SET ^TMP("ORRHCQ",$JOB,"QRY",$PIECE(NAM,"."),$PIECE(NAM,".",2),VAL)=""
+12 IF NAM="Report.Column"
SET ICOL=ICOL+1
SET ^TMP("ORRHCQ",$JOB,"COL",ICOL)=VAL
End DoDot:1
+13 ; when looking for combination of items, create full list to pass to query
+14 SET QROOT="^TMP(""ORRHCQ"",$J,""QRY"")"
+15 IF $DATA(@QROOT@("Order","ItemCombo1"))>1
Begin DoDot:1
+16 MERGE @QROOT@("Order","Orderable")=@QROOT@("Order","ItemCombo1")
+17 MERGE @QROOT@("Order","Orderable")=@QROOT@("Order","ItemCombo2")
End DoDot:1
+18 IF $DATA(@QROOT@("Consult","ItemCombo1"))>1
Begin DoDot:1
+19 MERGE @QROOT@("Consult","Orderable")=@QROOT@("Consult","ItemCombo1")
+20 MERGE @QROOT@("Consult","Orderable")=@QROOT@("Consult","ItemCombo2")
End DoDot:1
+21 IF $DATA(@QROOT@("Consult","DisplayGroup"))>1
Begin DoDot:1
+22 SET CSLTGRP=$ORDER(^ORD(100.98,"B","CSLT",0))
+23 IF CSLTGRP=$ORDER(@QROOT@("Consult","DisplayGroup",0))
QUIT
+24 MERGE @QROOT@("Consult","Orderable")=@QROOT@("Consult","DisplayGroup")
+25 KILL @QROOT@("Consult","DisplayGroup")
End DoDot:1
+26 ; set up actual dates for clinic list sources
+27 SET X=""
+28 FOR
SET X=$ORDER(@QROOT@("Patient","ListSource",X))
IF X=""
QUIT
IF $EXTRACT(X)="c"
Begin DoDot:1
+29 SET DTRNG=$PIECE(X,":",3,4)
SET DTRNG=$$RNG2FM^ORRHCU(DTRNG)
+30 KILL @QROOT@("Patient","ListSource",X)
+31 SET @QROOT@("Patient","ListSource",$PIECE(X,":",1,2)_":"_DTRNG)=""
End DoDot:1
+32 ; set up date ranges for search items based on general date range
+33 SET DTRNG=$ORDER(@QROOT@("Search","DateRange",0))
+34 IF $DATA(@QROOT@("Document"))
SET @QROOT@("Document","Reference",DTRNG)=""
+35 IF $DATA(@QROOT@("Order"))
SET @QROOT@("Order","TimeFrame",DTRNG)=""
+36 IF $DATA(@QROOT@("Consult"))
SET @QROOT@("Consult","TimeFrame",DTRNG)=""
+37 IF $DATA(@QROOT@("Visit"))
SET @QROOT@("Visit","TimeFrame",DTRNG)=""
+38 SET ^TMP("ORRHCQ",$JOB,"TOT")=0
+39 SET ITR=$$NXTITER("")
+40 QUIT
ADDTO(IEN,CLINDT) ;Add active location to lst
+1 NEW IEN42
+2 SET IEN42=0
+3 IF ($PIECE($GET(^SC(IEN,0)),U,3)="C")
IF $$ACTLOC^ORWU(IEN)
Begin DoDot:1
+4 SET @QROOT@("Patient","ListSource","c:"_IEN_":"_CLINDT)=""
End DoDot:1
+5 IF ($PIECE($GET(^SC(IEN,0)),U,3)="W")
IF $$ACTLOC^ORWU(IEN)
Begin DoDot:1
+6 SET IEN42=$GET(^SC(IEN,42))
+7 IF IEN42
SET @QROOT@("Patient","ListSource","w:"_IEN42_":")=""
End DoDot:1
+8 QUIT
WCFDIV(DIVLST) ;Get wards/clinics for division
+1 NEW XXI,XXJ,NNN,CDTR
+2 SET (XXI,NNN)=0
SET CDTR=""
+3 FOR
SET XXI=$ORDER(DIVLST(XXI))
IF 'XXI
QUIT
Begin DoDot:1
+4 SET CDTR=$PIECE(DIVLST(XXI),":",2,3)
+5 SET XXJ=0
+6 FOR
SET XXJ=$ORDER(^SC(XXJ))
IF 'XXJ
QUIT
Begin DoDot:2
+7 IF $PIECE(^SC(XXJ,0),U,4)=+DIVLST(XXI)
DO ADDTO(XXJ,CDTR)
End DoDot:2
End DoDot:1
+8 QUIT
DODIV ; find Wards/Clinics for divisions
+1 NEW XI,XJ,NN,WCLST,DIVLST,DIVPTR
+2 SET (XI,XJ,DIVLST)=""
SET (NN,DIVPTR)=0
+3 FOR
SET XI=$ORDER(@QROOT@("Patient","ListSource",XI))
IF XI=""
QUIT
IF $EXTRACT(XI)="d"
Begin DoDot:1
+4 SET NN=NN+1
SET DIVLST(NN)=$PIECE(XI,":",2,4)
+5 KILL @QROOT@("Patient","ListSource",XI)
End DoDot:1
+6 IF $DATA(DIVLST)=1
QUIT
+7 SET XI=""
+8 FOR
SET XJ=$ORDER(@QROOT@("Patient","ListSource",XJ))
IF XJ=""
QUIT
IF "cw"[$EXTRACT(XJ)
Begin DoDot:1
+9 SET DIVPTR=$PIECE($GET(^SC($PIECE(XJ,":",2),0)),U,4)
IF 'DIVPTR
QUIT
+10 FOR
SET XI=$ORDER(DIVLST(XI))
IF 'XI
QUIT
Begin DoDot:2
+11 IF DIVPTR=+DIVLST(XI)
KILL @QROOT@("Patient","ListSource",XJ)
End DoDot:2
End DoDot:1
+12 DO WCFDIV(.DIVLST)
+13 QUIT
CLEAR(OK) ; Clear/Cancel the query
+1 ;LW UNCOMMENT
KILL ^TMP("ORRHCQ",$JOB),^TMP("ORRHCQD",$JOB)
+2 ;LW UNCOMMENT
KILL ^TMP("ORRHCQB",$JOB),^TMP("ORRHCQS",$JOB)
+3 SET OK=1
+4 QUIT
NXTITER(X) ; Return the iterator for the next patient
+1 ; ITER=Subscript;DFN;Item#
+2 NEW SUB,ITM,DFNITM
+3 SET SUB=$PIECE(X,";",1)
SET ITM=$PIECE(X,";",3)
+4 ; loop until DFN or no subscripts
FOR
Begin DoDot:1
+5 SET DFNITM=$$NXTDFN(SUB,ITM)
+6 IF +DFNITM
QUIT
+7 SET SUB=$ORDER(^TMP("ORRHCQ",$JOB,"QRY","Patient","ListSource",SUB))
+8 IF SUB=""
QUIT
+9 DO SETPTS(SUB)
+10 SET ITM=0
End DoDot:1
IF +DFNITM
QUIT
IF SUB=""
QUIT
+11 IF +DFNITM=0
QUIT ""
+12 QUIT SUB_";"_DFNITM
+13 ;
NXTDFN(SUB,ITM) ; Return the next patient^item within a subscript
+1 IF SUB=""
QUIT 0
+2 NEW DFN
SET DFN=""
+3 IF $EXTRACT(SUB)="r"
Begin DoDot:1
+4 NEW RC,ITR
+5 MERGE ITR=^TMP("ORRHCQ",$JOB,"PTLST",SUB,"ITR")
+6 SET RC=$$NEXTPAT^RORAPI01(.ITR)
+7 MERGE ^TMP("ORRHCQ",$JOB,"PTLST",SUB,"ITR")=ITR
+8 SET DFN=$PIECE(RC,U)
SET ITM=0
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 SET ITM=$ORDER(^TMP("ORRHCQ",$JOB,"PTLST",SUB,+ITM))
+11 IF ITM
SET DFN=+^TMP("ORRHCQ",$JOB,"PTLST",SUB,ITM)
End DoDot:1
+12 QUIT DFN_";"_ITM
+13 ;
SETPTS(SUB) ; Set up to iterate through a patient list
+1 NEW LST
+2 IF $EXTRACT(SUB)="c"
DO CLINPTS^ORQRY01(.LST,$PIECE(SUB,":",2),$PIECE(SUB,":",3),$PIECE(SUB,":",4))
IF $DATA(@LST)>1
MERGE ^TMP("ORRHCQ",$JOB,"PTLST",SUB)=@LST
QUIT
+3 IF $EXTRACT(SUB)="w"
DO BYWARD^ORWPT(.LST,$PIECE(SUB,":",2))
+4 IF $EXTRACT(SUB)="t"
DO TEAMPTS^ORQPTQ1(.LST,$PIECE(SUB,":",2))
+5 IF $EXTRACT(SUB)="s"
DO SPECPTS^ORQPTQ2(.LST,$PIECE(SUB,":",2))
+6 IF $EXTRACT(SUB)="p"
DO PROVPTS^ORQPTQ2(.LST,$PIECE(SUB,":",2))
+7 IF $DATA(LST)>1
MERGE ^TMP("ORRHCQ",$JOB,"PTLST",SUB)=LST
QUIT
+8 ;
+9 NEW ITR
+10 IF ($EXTRACT(SUB)="r")
IF '($$PATITER^RORAPI01(.ITR,$PIECE(SUB,":",2),$PIECE(SUB,":",3)))
Begin DoDot:1
+11 MERGE ^TMP("ORRHCQ",$JOB,"PTLST",SUB,"ITR")=ITR
End DoDot:1
+12 QUIT
QRYITR(VAL,ORRITR) ; Do query for the current iterator
+1 ; VAL=PtSearched^RecordsFound^Iterator
+2 SET VAL=$$PTSCRN($PIECE(ORRITR,";",2))
+3 IF VAL
SET $PIECE(VAL,U,2)=$$QRYPT($PIECE(ORRITR,";",2))
+4 SET $PIECE(VAL,U,3)=$$NXTITER(ORRITR)
+5 QUIT
+6 ;
PTSCRN(PATID) ; Return 1 if should continue with this patient
+1 IF $DATA(^TMP("ORRHCQ",$JOB,"DFN",PATID))
QUIT 0
+2 NEW PRILST,LOCLST,DATRNG,CONT
+3 MERGE PRILST=^TMP("ORRHCQ",$JOB,"QRY","Patient","Primary")
+4 MERGE LOCLST=^TMP("ORRHCQ",$JOB,"QRY","Patient","Location")
+5 SET DATRNG=$ORDER(^TMP("ORRHCQ",$JOB,"QRY","Patient","DateRange",0))
SET CONT=1
+6 ;
+7 ; check if pt has primary provider in the list
+8 IF $DATA(PRILST)>1
Begin DoDot:1
+9 NEW FND,IPP
SET FND=0
SET IPP=0
+10 FOR
SET IPP=$ORDER(PRILST(IPP))
IF 'IPP
QUIT
SET FND=$$PP^ORQRY(PATID,IPP)
IF FND
QUIT
+11 IF 'FND
SET CONT=0
End DoDot:1
+12 IF CONT=0
QUIT 0
+13 ;
+14 ; check if pt has visit at during date range at optional location
+15 IF $LENGTH(DATRNG)
Begin DoDot:1
+16 IF $DATA(LOCLST)
SET CONT=$$ACT^ORQRY(PATID,$PIECE(DATRNG,":"),$PIECE(DATRNG,":",2),.LOCLST)
+17 IF '$DATA(LOCLST)
SET CONT=$$ACT^ORQRY(PATID,$PIECE(DATRNG,":"),$PIECE(DATRNG,":",2))
End DoDot:1
+18 IF CONT
SET ^TMP("ORRHCQ",$JOB,"DFN",PATID)=""
+19 QUIT CONT
+20 ;
QRYPT(PATID) ; Search for records and return the number found
+1 NEW QRY,ROOT,CNT
+2 KILL ^TMP("ORRHCQP",$JOB)
+3 SET ROOT="^TMP(""ORRHCQP"",$J)"
+4 MERGE QRY=^TMP("ORRHCQ",$JOB,"QRY")
+5 DO BYPT^ORQRY(ROOT,PATID,.QRY)
+6 SET CNT=$GET(^TMP("ORRHCQP",$JOB,0,"Documents"))+$GET(^("Orders"))+$GET(^("Visits"))+$GET(^("Consults"))
+7 SET ^TMP("ORRHCQ",$JOB,"TOT")=^TMP("ORRHCQ",$JOB,"TOT")+CNT
+8 MERGE ^TMP("ORRHCQD",$JOB)=^TMP("ORRHCQP",$JOB)
+9 KILL ^TMP("ORRHCQP",$JOB)
+10 QUIT CNT
SORTBY(SEQ,FNM,FWD) ; Sort by a particular field
+1 NEW ID,KEY
+2 KILL ^TMP("ORRHCQB",$JOB),^TMP("ORRHCQS",$JOB)
+3 SET SEQ=0
IF 'FWD
SET SEQ=^TMP("ORRHCQ",$JOB,"TOT")+1
+4 SET ID=0
FOR
SET ID=$ORDER(^TMP("ORRHCQD",$JOB,ID))
IF ID=""
QUIT
Begin DoDot:1
+5 SET KEY=$EXTRACT($GET(^TMP("ORRHCQD",$JOB,ID,FNM),"~~~~~~~~~~~~~~~~"),1,64)
+6 SET KEY=$TRANSLATE(KEY,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+7 IF KEY=""
SET KEY=" "
+8 SET ^TMP("ORRHCQB",$JOB,KEY,ID)=""
End DoDot:1
+9 SET KEY=""
FOR
SET KEY=$ORDER(^TMP("ORRHCQB",$JOB,KEY))
IF KEY=""
QUIT
Begin DoDot:1
+10 SET ID=""
FOR
SET ID=$ORDER(^TMP("ORRHCQB",$JOB,KEY,ID))
IF ID=""
QUIT
Begin DoDot:2
+11 IF FWD
SET SEQ=SEQ+1
IF 'FWD
SET SEQ=SEQ-1
+12 SET ^TMP("ORRHCQS",$JOB,SEQ)=ID
End DoDot:2
End DoDot:1
+13 QUIT
SUBDTA(LST,FIRST,LAST) ; Return name-value pairs for subset of query data
+1 NEW SEQ,COL,ID,ICOL,ILST
SET ILST=0
+2 MERGE COL=^TMP("ORRHCQ",$JOB,"COL")
+3 FOR SEQ=FIRST:1:LAST
Begin DoDot:1
+4 IF '$DATA(^TMP("ORRHCQS",$JOB,SEQ))
QUIT
+5 SET ID=^TMP("ORRHCQS",$JOB,SEQ)
+6 SET ILST=ILST+1
SET LST(ILST)="RowItemID="_ID
+7 SET ICOL=0
FOR
SET ICOL=$ORDER(COL(ICOL))
IF 'ICOL
QUIT
Begin DoDot:2
+8 SET ILST=ILST+1
+9 SET LST(ILST)=COL(ICOL)_"="_$GET(^TMP("ORRHCQD",$JOB,ID,COL(ICOL)))
End DoDot:2
End DoDot:1
+10 QUIT
DETAIL(REF,ID) ; Return results of order identified by ID
+1 KILL ^TMP("ORXPND",$JOB)
+2 NEW ORESULTS,ORVP,LCNT,ORID
SET ORESULTS=1
SET LCNT=0
+3 ;strip off prefix
IF ID[":"
SET ID=$PIECE(ID,":",2)
+4 SET ORVP=$PIECE(^OR(100,+ID,0),U,2)
SET ORID=ID
+5 DO ORDERS^ORCXPND1
SET ID=ORID
+6 DO ORDERS^ORCXPND2
+7 KILL ^TMP("ORXPND",$JOB,"VIDEO")
+8 SET REF=$NAME(^TMP("ORXPND",$JOB))
+9 QUIT
PTINFO(VAL,ID) ; Return patient info given an order, consult, or note
+1 NEW DFN,X,X0,X1,X101
+2 SET VAL=""
SET DFN=0
SET X=$PIECE(ID,":")
+3 IF X="ORD"!(X="CST")
SET DFN=+$PIECE(^OR(100,+$PIECE(ID,":",2),0),U,2)
+4 IF X="DOC"
SET DFN=+$PIECE(^TIU(8925,+$PIECE(ID,":",2),0),U,2)
+5 ;I X="VST" visits too?
+6 IF 'DFN
QUIT
+7 SET X0=^DPT(DFN,0)
SET X1=$GET(^(.1))
SET X101=$GET(^(.101))
+8 SET VAL=$PIECE(X0,U)_U_$PIECE(X0,U,9)_U_X1_" "_X101
+9 QUIT
RNGFM(ORY,RNG) ;Return FM date range string
+1 IF '$LENGTH(RNG)
QUIT
+2 SET ORY=$$RNG2FM^ORRHCU(RNG)
+3 QUIT
