- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORRHCQ 8244 printed Feb 19, 2025@00:00:30 Page 2
- 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
