RORXU003 ;HCIOFO/BH,SG - REPORT BUILDER UTILITIES ; 7/19/06 12:34pm
;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
;
; This routine uses the following IAs:
;
; #1894 ENCEVENT^PXKENC (controlled)
;
Q
;
;***** SEARCHES FOR UTLIZATION
;
; STDT Start date for search (FileMan)
; ENDT End date for search (FileMan)
;
; RORDFN Patient IEN in the PATIENT file (#2)
;
; CHK Reference to a local array that identifies the
; packages files that need to be checked i.e. CHK("O"):
; A Allergy
; C Cytopathology
; I Inpatients
; IP Inpatient Pharmacy
; IV IV Medications
; L Laboratory
; M Microbiology
; O Outpatient
; OP Outpatient Pharmacy
; R Radiology
; SP Surgical Pathology
;
; If set to "ALL", Outpatients, Inpatients, Radiology,
; Allergy, Pharmacy, Microbiology, Surgical Pathology,
; Cytopathology, and Lab data will be checked.
;
; Return Values:
; 0 No utilization has been found
; 1 The patient has had utilization. The subsequent "^"-pieces
; will indicate the utilization areas (the same codes as
; those for the CHK parameter)
;
; For example, if a patient had utilization for Inpatients,
; Outpatient, Pharmacy, and Lab the string would look as
; follows: 1^O^I^OP^L
;
UTIL(STDT,ENDT,RORDFN,CHK) ;
N IEN,LRDFN,RES,RORMSG,RORVAL
S RORVAL=""
;
;--- Outpatient data
I $D(CHK("ALL"))!$D(CHK("O")) D
. S RES=$$OUTPAT(STDT,ENDT,RORDFN)
. S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
;
;--- Inpatient data
I $D(CHK("ALL"))!$D(CHK("I")) D
. S RES=$$INPAT(STDT,ENDT,RORDFN)
. S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
;
;--- Radiology data
I $D(CHK("ALL"))!$D(CHK("R")) D
. S RES=$$RAD(STDT,ENDT,RORDFN)
. S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
;
;--- Allergy data
I $D(CHK("ALL"))!$D(CHK("A")) D
. S RES=$$ALLERGY(STDT,ENDT,RORDFN)
. S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
;
;--- Pharmacy data
I $D(CHK("ALL"))!$D(CHK("IP"))!$D(CHK("OP"))!$D(CHK("IV")) D
. S RES=$$PHARM(STDT,ENDT,RORDFN,.CHK)
. S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
;
S LRDFN=+$$LABREF^RORUTL18(RORDFN)
;
I LRDFN>0 D
. ;--- Microbiology
. I $D(CHK("ALL"))!$D(CHK("M")) D
. . S RES=$$MICRO(STDT,ENDT,LRDFN)
. . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
. ;--- Surgical Pathology
. I $D(CHK("ALL"))!$D(CHK("SP")) D
. . S RES=$$SURGP(STDT,ENDT,LRDFN)
. . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
. ;--- Cytopathology
. I $D(CHK("ALL"))!$D(CHK("C")) D
. . S RES=$$CYTO(STDT,ENDT,LRDFN)
. . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
;
;--- Lab data
I $D(CHK("ALL"))!$D(CHK("L")) D
. S RES=$$LAB(STDT,ENDT,RORDFN)
. S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
;
S $P(RORVAL,U)=(RORVAL'="")
Q RORVAL
;
;***** CHECKS ALLERGY DATA
ALLERGY(STDT,ENDT,RORDFN) ;
N DTE,IEN,RC
S RC=0
S DTE=$O(^GMR(120.8,"AODT",STDT),-1)
S ENDT=ENDT_".999999"
F S DTE=$O(^GMR(120.8,"AODT",DTE)) Q:'DTE!(DTE'<ENDT) D Q:RC
. S IEN=0
. F S IEN=$O(^GMR(120.8,"AODT",DTE,IEN)) Q:'IEN D Q:RC
. . S:$D(^GMR(120.8,"B",RORDFN,IEN)) RC="1^A"
Q RC
;
;***** CHECKS CYTOPATHOLOGY DATA
CYTO(STDT,ENDT,LRDFN) ;
N IDT
S IDT=$O(^LR(LRDFN,"CY",9999999-STDT))
S IDT=$O(^LR(LRDFN,"CY",IDT),-1)
Q $S(IDT&(IDT>(9999999-ENDT)):"1^C",1:0)
;
;***** CHECKS INPATIENT DATA
INPAT(STDT,ENDT,DFN) ;
N ADMDT,DATE,DISDT,IEN,QUIT,RC,VAIP
S STDT=STDT\1
;--- Check for an admission date inside the time frame
S QUIT=0,DATE=(ENDT\1)_".999999"
F S DATE=$O(^DGPT("AAD",DFN,DATE),-1) Q:'DATE!(DATE<STDT) D Q:QUIT
. S IEN=""
. F S IEN=$O(^DGPT("AAD",DFN,DATE,IEN),-1) Q:'IEN D Q:QUIT
. . S:'$$PTF^RORXU001(IEN,"FP") QUIT=1
Q:QUIT=1 "1^I"
;--- Check for an earlier admission that overlaps the date range
S QUIT=0,VAIP("D")=STDT
F D Q:QUIT
. D IN5^VADPT
. S VAIP("D")=+$G(VAIP(13,1))
. I VAIP("D")'>0 S QUIT=2 Q
. S VAIP("D")=$$FMADD^XLFDT(VAIP("D"),,,,-1)
. S IEN=+$G(VAIP(12)) Q:IEN'>0
. S RC=$$PTF^RORXU001(IEN,"FP",,.DISDT)
. S QUIT=$S(RC:0,$G(DISDT)'>0:1,DISDT>STDT:1,1:2)
Q $S(QUIT=1:"1^I",1:0)
;
;***** CHECKS LAB DATA
LAB(STDT,ENDT,RORDFN) ;
N PTID,RC,RORMSG,RORTMP
S PTID=$$PTID^RORUTL02(RORDFN) Q:PTID<0 0
S RORTMP=$$ALLOC^RORTMP()
;--- Get the Lab data
S ENDT=(ENDT\1+1)_"^CD",STDT=STDT_"^CD"
S RC=$$GCPR^LA7QRY(PTID,STDT,ENDT,"CH","*",.RORMSG,RORTMP)
S RC=$S(($D(RORMSG)>1)&(RC=""):0,$D(@RORTMP)>1:"1^L",1:0)
;--- Cleanup
D FREE^RORTMP(RORTMP)
Q RC
;
;***** CHECKS MICROBIOLOGY DATA
MICRO(STDT,ENDT,LRDFN) ;
N RC,RORTMP
S RC=0,RORTMP=$$ALLOC^RORTMP()
D:$$GETDATA^LA7UTL1A(LRDFN,STDT,ENDT,"CD",RORTMP)'<0
. S:$D(@RORTMP@(LRDFN)) RC="1^M"
D FREE^RORTMP(RORTMP)
Q RC
;
;***** CHECKS OUTPATIENT DATA
OUTPAT(STDT,ENDT,RORDFN) ;
S STDT=$P(STDT,".",1),STDT=STDT-1,STDT=STDT+.9999
S ENDT=$P(ENDT,".",1),ENDT=ENDT+1
N QUERY,RORDST,RORECNT
S RORECNT=0
S RORDST=$NA(^TMP("RORXU003",$J,"OUT"))
D OPEN^SDQ(.QUERY)
D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
D PAT^SDQ(.QUERY,RORDFN,"SET")
D DATE^SDQ(.QUERY,STDT,ENDT,"SET")
D SCANCB^SDQ(.QUERY,"D SCAN^RORXU003()","SET")
D ACTIVE^SDQ(.QUERY,"TRUE","SET")
D SCAN^SDQ(.QUERY,"FORWARD")
D CLOSE^SDQ(.QUERY)
Q $S(RORECNT:"1^O",1:0)
;
;***** CHECKS PHARMACY DATA
PHARM(STDT,ENDT,RORDFN,CHK) ;
N BUF,II,IP,IV,OP,ORD,RC,RORLST,SKIP,TMP,TYPE
S ENDT=$$FMADD^XLFDT(ENDT\1,1)
I '$D(CHK("ALL")) D
. S IP='$D(CHK("IP"))
. S IV='$D(CHK("IV"))
. S OP='$D(CHK("OP"))
E S (OP,IP,IV)=0
;=== Get the list of orders
K ^TMP("PS",$J)
D OCL^PSOORRL(RORDFN,STDT,ENDT)
Q:$D(^TMP("PS",$J))<10 0
S RORLST=$$ALLOC^RORTMP()
;=== Preselect the orders
S II=0
F S II=$O(^TMP("PS",$J,II)) Q:'II D
. S BUF=$G(^TMP("PS",$J,II,0)),ORD=$P(BUF,U) Q:ORD'>0
. S TMP=$L(ORD),TYPE=$E(ORD,TMP-2,TMP)
. S TYPE=$S(TYPE="R;O":"R",TYPE="U;I":"U",TYPE="V;I":"V",1:"")
. ;--- Check if this kind of orders should be processed
. Q:$S(TYPE="R":OP,TYPE="U":IP,TYPE="V":IV,1:1)
. ;--- Check the dates
. I "UV"[TYPE S TMP=$P(BUF,U,15) Q:(TMP<STDT)!(TMP'<ENDT)
. I TYPE="R" S TMP=$P(BUF,U,10) Q:TMP<STDT
. ;--- Add the order to the list
. S @RORLST@(II)=TYPE,@RORLST@(II,0)=BUF
;=== Process the preselected orders
S II=0,RC=""
F S II=$O(@RORLST@(II)) Q:'II D Q:OP&IP&IV
. S TYPE=@RORLST@(II),ORD=$P(@RORLST@(II,0),U)
. ;--- Outpatient
. I TYPE="R" Q:OP D S:'SKIP OP=1,RC=RC_U_"OP" Q
. . ;--- Double-check the Rx date(s)
. . K ^TMP("PS",$J)
. . D OEL^PSOORRL(RORDFN,ORD)
. . I $D(^TMP("PS",$J))<10 S SKIP=1 Q
. . S SKIP=$$DTCHECK^RORUTL15(STDT,ENDT)
. ;--- Inpatient
. I TYPE="U" Q:IP S IP=1,RC=RC_U_"IP" Q
. ;--- IV
. I TYPE="V" Q:IV S IV=1,RC=RC_U_"IV" Q
;===
D FREE^RORTMP(RORLST)
K ^TMP("PS",$J)
S $P(RC,U)=(RC'="")
Q RC
;
;***** CHECKS RADIOLOGY DATA
RAD(STDT,ENDT,RORDFN) ;
N RC
K ^TMP($J,"RAE1")
D EN1^RAO7PC1(RORDFN,STDT,ENDT,999999999)
S RC=$S($D(^TMP($J,"RAE1",RORDFN))>1:"1^R",1:0)
K ^TMP($J,"RAE1")
Q RC
;
;*****
SCAN() ;
S RORECNT=1
Q
;
;***** CHECKS SURGICAL PATHOLOGY DATA
SURGP(STDT,ENDT,LRDFN) ;
N IDT
S IDT=$O(^LR(LRDFN,"SP",9999999-STDT))
S IDT=$O(^LR(LRDFN,"SP",IDT),-1)
Q $S(IDT&(IDT>(9999999-ENDT)):"1^SP",1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORXU003 7581 printed Apr 09, 2024@20:49:55 Page 2
RORXU003 ;HCIOFO/BH,SG - REPORT BUILDER UTILITIES ; 7/19/06 12:34pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #1894 ENCEVENT^PXKENC (controlled)
+6 ;
+7 QUIT
+8 ;
+9 ;***** SEARCHES FOR UTLIZATION
+10 ;
+11 ; STDT Start date for search (FileMan)
+12 ; ENDT End date for search (FileMan)
+13 ;
+14 ; RORDFN Patient IEN in the PATIENT file (#2)
+15 ;
+16 ; CHK Reference to a local array that identifies the
+17 ; packages files that need to be checked i.e. CHK("O"):
+18 ; A Allergy
+19 ; C Cytopathology
+20 ; I Inpatients
+21 ; IP Inpatient Pharmacy
+22 ; IV IV Medications
+23 ; L Laboratory
+24 ; M Microbiology
+25 ; O Outpatient
+26 ; OP Outpatient Pharmacy
+27 ; R Radiology
+28 ; SP Surgical Pathology
+29 ;
+30 ; If set to "ALL", Outpatients, Inpatients, Radiology,
+31 ; Allergy, Pharmacy, Microbiology, Surgical Pathology,
+32 ; Cytopathology, and Lab data will be checked.
+33 ;
+34 ; Return Values:
+35 ; 0 No utilization has been found
+36 ; 1 The patient has had utilization. The subsequent "^"-pieces
+37 ; will indicate the utilization areas (the same codes as
+38 ; those for the CHK parameter)
+39 ;
+40 ; For example, if a patient had utilization for Inpatients,
+41 ; Outpatient, Pharmacy, and Lab the string would look as
+42 ; follows: 1^O^I^OP^L
+43 ;
UTIL(STDT,ENDT,RORDFN,CHK) ;
+1 NEW IEN,LRDFN,RES,RORMSG,RORVAL
+2 SET RORVAL=""
+3 ;
+4 ;--- Outpatient data
+5 IF $DATA(CHK("ALL"))!$DATA(CHK("O"))
Begin DoDot:1
+6 SET RES=$$OUTPAT(STDT,ENDT,RORDFN)
+7 if RES
SET RORVAL=RORVAL_U_$PIECE(RES,U,2,999)
End DoDot:1
+8 ;
+9 ;--- Inpatient data
+10 IF $DATA(CHK("ALL"))!$DATA(CHK("I"))
Begin DoDot:1
+11 SET RES=$$INPAT(STDT,ENDT,RORDFN)
+12 if RES
SET RORVAL=RORVAL_U_$PIECE(RES,U,2,999)
End DoDot:1
+13 ;
+14 ;--- Radiology data
+15 IF $DATA(CHK("ALL"))!$DATA(CHK("R"))
Begin DoDot:1
+16 SET RES=$$RAD(STDT,ENDT,RORDFN)
+17 if RES
SET RORVAL=RORVAL_U_$PIECE(RES,U,2,999)
End DoDot:1
+18 ;
+19 ;--- Allergy data
+20 IF $DATA(CHK("ALL"))!$DATA(CHK("A"))
Begin DoDot:1
+21 SET RES=$$ALLERGY(STDT,ENDT,RORDFN)
+22 if RES
SET RORVAL=RORVAL_U_$PIECE(RES,U,2,999)
End DoDot:1
+23 ;
+24 ;--- Pharmacy data
+25 IF $DATA(CHK("ALL"))!$DATA(CHK("IP"))!$DATA(CHK("OP"))!$DATA(CHK("IV"))
Begin DoDot:1
+26 SET RES=$$PHARM(STDT,ENDT,RORDFN,.CHK)
+27 if RES
SET RORVAL=RORVAL_U_$PIECE(RES,U,2,999)
End DoDot:1
+28 ;
+29 SET LRDFN=+$$LABREF^RORUTL18(RORDFN)
+30 ;
+31 IF LRDFN>0
Begin DoDot:1
+32 ;--- Microbiology
+33 IF $DATA(CHK("ALL"))!$DATA(CHK("M"))
Begin DoDot:2
+34 SET RES=$$MICRO(STDT,ENDT,LRDFN)
+35 if RES
SET RORVAL=RORVAL_U_$PIECE(RES,U,2,999)
End DoDot:2
+36 ;--- Surgical Pathology
+37 IF $DATA(CHK("ALL"))!$DATA(CHK("SP"))
Begin DoDot:2
+38 SET RES=$$SURGP(STDT,ENDT,LRDFN)
+39 if RES
SET RORVAL=RORVAL_U_$PIECE(RES,U,2,999)
End DoDot:2
+40 ;--- Cytopathology
+41 IF $DATA(CHK("ALL"))!$DATA(CHK("C"))
Begin DoDot:2
+42 SET RES=$$CYTO(STDT,ENDT,LRDFN)
+43 if RES
SET RORVAL=RORVAL_U_$PIECE(RES,U,2,999)
End DoDot:2
End DoDot:1
+44 ;
+45 ;--- Lab data
+46 IF $DATA(CHK("ALL"))!$DATA(CHK("L"))
Begin DoDot:1
+47 SET RES=$$LAB(STDT,ENDT,RORDFN)
+48 if RES
SET RORVAL=RORVAL_U_$PIECE(RES,U,2,999)
End DoDot:1
+49 ;
+50 SET $PIECE(RORVAL,U)=(RORVAL'="")
+51 QUIT RORVAL
+52 ;
+53 ;***** CHECKS ALLERGY DATA
ALLERGY(STDT,ENDT,RORDFN) ;
+1 NEW DTE,IEN,RC
+2 SET RC=0
+3 SET DTE=$ORDER(^GMR(120.8,"AODT",STDT),-1)
+4 SET ENDT=ENDT_".999999"
+5 FOR
SET DTE=$ORDER(^GMR(120.8,"AODT",DTE))
if 'DTE!(DTE'<ENDT)
QUIT
Begin DoDot:1
+6 SET IEN=0
+7 FOR
SET IEN=$ORDER(^GMR(120.8,"AODT",DTE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+8 if $DATA(^GMR(120.8,"B",RORDFN,IEN))
SET RC="1^A"
End DoDot:2
if RC
QUIT
End DoDot:1
if RC
QUIT
+9 QUIT RC
+10 ;
+11 ;***** CHECKS CYTOPATHOLOGY DATA
CYTO(STDT,ENDT,LRDFN) ;
+1 NEW IDT
+2 SET IDT=$ORDER(^LR(LRDFN,"CY",9999999-STDT))
+3 SET IDT=$ORDER(^LR(LRDFN,"CY",IDT),-1)
+4 QUIT $SELECT(IDT&(IDT>(9999999-ENDT)):"1^C",1:0)
+5 ;
+6 ;***** CHECKS INPATIENT DATA
INPAT(STDT,ENDT,DFN) ;
+1 NEW ADMDT,DATE,DISDT,IEN,QUIT,RC,VAIP
+2 SET STDT=STDT\1
+3 ;--- Check for an admission date inside the time frame
+4 SET QUIT=0
SET DATE=(ENDT\1)_".999999"
+5 FOR
SET DATE=$ORDER(^DGPT("AAD",DFN,DATE),-1)
if 'DATE!(DATE<STDT)
QUIT
Begin DoDot:1
+6 SET IEN=""
+7 FOR
SET IEN=$ORDER(^DGPT("AAD",DFN,DATE,IEN),-1)
if 'IEN
QUIT
Begin DoDot:2
+8 if '$$PTF^RORXU001(IEN,"FP")
SET QUIT=1
End DoDot:2
if QUIT
QUIT
End DoDot:1
if QUIT
QUIT
+9 if QUIT=1
QUIT "1^I"
+10 ;--- Check for an earlier admission that overlaps the date range
+11 SET QUIT=0
SET VAIP("D")=STDT
+12 FOR
Begin DoDot:1
+13 DO IN5^VADPT
+14 SET VAIP("D")=+$GET(VAIP(13,1))
+15 IF VAIP("D")'>0
SET QUIT=2
QUIT
+16 SET VAIP("D")=$$FMADD^XLFDT(VAIP("D"),,,,-1)
+17 SET IEN=+$GET(VAIP(12))
if IEN'>0
QUIT
+18 SET RC=$$PTF^RORXU001(IEN,"FP",,.DISDT)
+19 SET QUIT=$SELECT(RC:0,$GET(DISDT)'>0:1,DISDT>STDT:1,1:2)
End DoDot:1
if QUIT
QUIT
+20 QUIT $SELECT(QUIT=1:"1^I",1:0)
+21 ;
+22 ;***** CHECKS LAB DATA
LAB(STDT,ENDT,RORDFN) ;
+1 NEW PTID,RC,RORMSG,RORTMP
+2 SET PTID=$$PTID^RORUTL02(RORDFN)
if PTID<0
QUIT 0
+3 SET RORTMP=$$ALLOC^RORTMP()
+4 ;--- Get the Lab data
+5 SET ENDT=(ENDT\1+1)_"^CD"
SET STDT=STDT_"^CD"
+6 SET RC=$$GCPR^LA7QRY(PTID,STDT,ENDT,"CH","*",.RORMSG,RORTMP)
+7 SET RC=$SELECT(($DATA(RORMSG)>1)&(RC=""):0,$DATA(@RORTMP)>1:"1^L",1:0)
+8 ;--- Cleanup
+9 DO FREE^RORTMP(RORTMP)
+10 QUIT RC
+11 ;
+12 ;***** CHECKS MICROBIOLOGY DATA
MICRO(STDT,ENDT,LRDFN) ;
+1 NEW RC,RORTMP
+2 SET RC=0
SET RORTMP=$$ALLOC^RORTMP()
+3 if $$GETDATA^LA7UTL1A(LRDFN,STDT,ENDT,"CD",RORTMP)'<0
Begin DoDot:1
+4 if $DATA(@RORTMP@(LRDFN))
SET RC="1^M"
End DoDot:1
+5 DO FREE^RORTMP(RORTMP)
+6 QUIT RC
+7 ;
+8 ;***** CHECKS OUTPATIENT DATA
OUTPAT(STDT,ENDT,RORDFN) ;
+1 SET STDT=$PIECE(STDT,".",1)
SET STDT=STDT-1
SET STDT=STDT+.9999
+2 SET ENDT=$PIECE(ENDT,".",1)
SET ENDT=ENDT+1
+3 NEW QUERY,RORDST,RORECNT
+4 SET RORECNT=0
+5 SET RORDST=$NAME(^TMP("RORXU003",$JOB,"OUT"))
+6 DO OPEN^SDQ(.QUERY)
+7 DO INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
+8 DO PAT^SDQ(.QUERY,RORDFN,"SET")
+9 DO DATE^SDQ(.QUERY,STDT,ENDT,"SET")
+10 DO SCANCB^SDQ(.QUERY,"D SCAN^RORXU003()","SET")
+11 DO ACTIVE^SDQ(.QUERY,"TRUE","SET")
+12 DO SCAN^SDQ(.QUERY,"FORWARD")
+13 DO CLOSE^SDQ(.QUERY)
+14 QUIT $SELECT(RORECNT:"1^O",1:0)
+15 ;
+16 ;***** CHECKS PHARMACY DATA
PHARM(STDT,ENDT,RORDFN,CHK) ;
+1 NEW BUF,II,IP,IV,OP,ORD,RC,RORLST,SKIP,TMP,TYPE
+2 SET ENDT=$$FMADD^XLFDT(ENDT\1,1)
+3 IF '$DATA(CHK("ALL"))
Begin DoDot:1
+4 SET IP='$DATA(CHK("IP"))
+5 SET IV='$DATA(CHK("IV"))
+6 SET OP='$DATA(CHK("OP"))
End DoDot:1
+7 IF '$TEST
SET (OP,IP,IV)=0
+8 ;=== Get the list of orders
+9 KILL ^TMP("PS",$JOB)
+10 DO OCL^PSOORRL(RORDFN,STDT,ENDT)
+11 if $DATA(^TMP("PS",$JOB))<10
QUIT 0
+12 SET RORLST=$$ALLOC^RORTMP()
+13 ;=== Preselect the orders
+14 SET II=0
+15 FOR
SET II=$ORDER(^TMP("PS",$JOB,II))
if 'II
QUIT
Begin DoDot:1
+16 SET BUF=$GET(^TMP("PS",$JOB,II,0))
SET ORD=$PIECE(BUF,U)
if ORD'>0
QUIT
+17 SET TMP=$LENGTH(ORD)
SET TYPE=$EXTRACT(ORD,TMP-2,TMP)
+18 SET TYPE=$SELECT(TYPE="R;O":"R",TYPE="U;I":"U",TYPE="V;I":"V",1:"")
+19 ;--- Check if this kind of orders should be processed
+20 if $SELECT(TYPE="R"
QUIT
+21 ;--- Check the dates
+22 IF "UV"[TYPE
SET TMP=$PIECE(BUF,U,15)
if (TMP<STDT)!(TMP'<ENDT)
QUIT
+23 IF TYPE="R"
SET TMP=$PIECE(BUF,U,10)
if TMP<STDT
QUIT
+24 ;--- Add the order to the list
+25 SET @RORLST@(II)=TYPE
SET @RORLST@(II,0)=BUF
End DoDot:1
+26 ;=== Process the preselected orders
+27 SET II=0
SET RC=""
+28 FOR
SET II=$ORDER(@RORLST@(II))
if 'II
QUIT
Begin DoDot:1
+29 SET TYPE=@RORLST@(II)
SET ORD=$PIECE(@RORLST@(II,0),U)
+30 ;--- Outpatient
+31 IF TYPE="R"
if OP
QUIT
Begin DoDot:2
+32 ;--- Double-check the Rx date(s)
+33 KILL ^TMP("PS",$JOB)
+34 DO OEL^PSOORRL(RORDFN,ORD)
+35 IF $DATA(^TMP("PS",$JOB))<10
SET SKIP=1
QUIT
+36 SET SKIP=$$DTCHECK^RORUTL15(STDT,ENDT)
End DoDot:2
if 'SKIP
SET OP=1
SET RC=RC_U_"OP"
QUIT
+37 ;--- Inpatient
+38 IF TYPE="U"
if IP
QUIT
SET IP=1
SET RC=RC_U_"IP"
QUIT
+39 ;--- IV
+40 IF TYPE="V"
if IV
QUIT
SET IV=1
SET RC=RC_U_"IV"
QUIT
End DoDot:1
if OP&IP&IV
QUIT
+41 ;===
+42 DO FREE^RORTMP(RORLST)
+43 KILL ^TMP("PS",$JOB)
+44 SET $PIECE(RC,U)=(RC'="")
+45 QUIT RC
+46 ;
+47 ;***** CHECKS RADIOLOGY DATA
RAD(STDT,ENDT,RORDFN) ;
+1 NEW RC
+2 KILL ^TMP($JOB,"RAE1")
+3 DO EN1^RAO7PC1(RORDFN,STDT,ENDT,999999999)
+4 SET RC=$SELECT($DATA(^TMP($JOB,"RAE1",RORDFN))>1:"1^R",1:0)
+5 KILL ^TMP($JOB,"RAE1")
+6 QUIT RC
+7 ;
+8 ;*****
SCAN() ;
+1 SET RORECNT=1
+2 QUIT
+3 ;
+4 ;***** CHECKS SURGICAL PATHOLOGY DATA
SURGP(STDT,ENDT,LRDFN) ;
+1 NEW IDT
+2 SET IDT=$ORDER(^LR(LRDFN,"SP",9999999-STDT))
+3 SET IDT=$ORDER(^LR(LRDFN,"SP",IDT),-1)
+4 QUIT $SELECT(IDT&(IDT>(9999999-ENDT)):"1^SP",1:0)
