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

RORXU003.m

Go to the documentation of this file.
  1. RORXU003 ;HCIOFO/BH,SG - REPORT BUILDER UTILITIES ; 7/19/06 12:34pm
  1. ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #1894 ENCEVENT^PXKENC (controlled)
  1. ;
  1. Q
  1. ;
  1. ;***** SEARCHES FOR UTLIZATION
  1. ;
  1. ; STDT Start date for search (FileMan)
  1. ; ENDT End date for search (FileMan)
  1. ;
  1. ; RORDFN Patient IEN in the PATIENT file (#2)
  1. ;
  1. ; CHK Reference to a local array that identifies the
  1. ; packages files that need to be checked i.e. CHK("O"):
  1. ; A Allergy
  1. ; C Cytopathology
  1. ; I Inpatients
  1. ; IP Inpatient Pharmacy
  1. ; IV IV Medications
  1. ; L Laboratory
  1. ; M Microbiology
  1. ; O Outpatient
  1. ; OP Outpatient Pharmacy
  1. ; R Radiology
  1. ; SP Surgical Pathology
  1. ;
  1. ; If set to "ALL", Outpatients, Inpatients, Radiology,
  1. ; Allergy, Pharmacy, Microbiology, Surgical Pathology,
  1. ; Cytopathology, and Lab data will be checked.
  1. ;
  1. ; Return Values:
  1. ; 0 No utilization has been found
  1. ; 1 The patient has had utilization. The subsequent "^"-pieces
  1. ; will indicate the utilization areas (the same codes as
  1. ; those for the CHK parameter)
  1. ;
  1. ; For example, if a patient had utilization for Inpatients,
  1. ; Outpatient, Pharmacy, and Lab the string would look as
  1. ; follows: 1^O^I^OP^L
  1. ;
  1. UTIL(STDT,ENDT,RORDFN,CHK) ;
  1. N IEN,LRDFN,RES,RORMSG,RORVAL
  1. S RORVAL=""
  1. ;
  1. ;--- Outpatient data
  1. I $D(CHK("ALL"))!$D(CHK("O")) D
  1. . S RES=$$OUTPAT(STDT,ENDT,RORDFN)
  1. . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
  1. ;
  1. ;--- Inpatient data
  1. I $D(CHK("ALL"))!$D(CHK("I")) D
  1. . S RES=$$INPAT(STDT,ENDT,RORDFN)
  1. . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
  1. ;
  1. ;--- Radiology data
  1. I $D(CHK("ALL"))!$D(CHK("R")) D
  1. . S RES=$$RAD(STDT,ENDT,RORDFN)
  1. . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
  1. ;
  1. ;--- Allergy data
  1. I $D(CHK("ALL"))!$D(CHK("A")) D
  1. . S RES=$$ALLERGY(STDT,ENDT,RORDFN)
  1. . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
  1. ;
  1. ;--- Pharmacy data
  1. I $D(CHK("ALL"))!$D(CHK("IP"))!$D(CHK("OP"))!$D(CHK("IV")) D
  1. . S RES=$$PHARM(STDT,ENDT,RORDFN,.CHK)
  1. . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
  1. ;
  1. S LRDFN=+$$LABREF^RORUTL18(RORDFN)
  1. ;
  1. I LRDFN>0 D
  1. . ;--- Microbiology
  1. . I $D(CHK("ALL"))!$D(CHK("M")) D
  1. . . S RES=$$MICRO(STDT,ENDT,LRDFN)
  1. . . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
  1. . ;--- Surgical Pathology
  1. . I $D(CHK("ALL"))!$D(CHK("SP")) D
  1. . . S RES=$$SURGP(STDT,ENDT,LRDFN)
  1. . . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
  1. . ;--- Cytopathology
  1. . I $D(CHK("ALL"))!$D(CHK("C")) D
  1. . . S RES=$$CYTO(STDT,ENDT,LRDFN)
  1. . . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
  1. ;
  1. ;--- Lab data
  1. I $D(CHK("ALL"))!$D(CHK("L")) D
  1. . S RES=$$LAB(STDT,ENDT,RORDFN)
  1. . S:RES RORVAL=RORVAL_U_$P(RES,U,2,999)
  1. ;
  1. S $P(RORVAL,U)=(RORVAL'="")
  1. Q RORVAL
  1. ;
  1. ;***** CHECKS ALLERGY DATA
  1. ALLERGY(STDT,ENDT,RORDFN) ;
  1. N DTE,IEN,RC
  1. S RC=0
  1. S DTE=$O(^GMR(120.8,"AODT",STDT),-1)
  1. S ENDT=ENDT_".999999"
  1. F S DTE=$O(^GMR(120.8,"AODT",DTE)) Q:'DTE!(DTE'<ENDT) D Q:RC
  1. . S IEN=0
  1. . F S IEN=$O(^GMR(120.8,"AODT",DTE,IEN)) Q:'IEN D Q:RC
  1. . . S:$D(^GMR(120.8,"B",RORDFN,IEN)) RC="1^A"
  1. Q RC
  1. ;
  1. ;***** CHECKS CYTOPATHOLOGY DATA
  1. CYTO(STDT,ENDT,LRDFN) ;
  1. N IDT
  1. S IDT=$O(^LR(LRDFN,"CY",9999999-STDT))
  1. S IDT=$O(^LR(LRDFN,"CY",IDT),-1)
  1. Q $S(IDT&(IDT>(9999999-ENDT)):"1^C",1:0)
  1. ;
  1. ;***** CHECKS INPATIENT DATA
  1. INPAT(STDT,ENDT,DFN) ;
  1. N ADMDT,DATE,DISDT,IEN,QUIT,RC,VAIP
  1. S STDT=STDT\1
  1. ;--- Check for an admission date inside the time frame
  1. S QUIT=0,DATE=(ENDT\1)_".999999"
  1. F S DATE=$O(^DGPT("AAD",DFN,DATE),-1) Q:'DATE!(DATE<STDT) D Q:QUIT
  1. . S IEN=""
  1. . F S IEN=$O(^DGPT("AAD",DFN,DATE,IEN),-1) Q:'IEN D Q:QUIT
  1. . . S:'$$PTF^RORXU001(IEN,"FP") QUIT=1
  1. Q:QUIT=1 "1^I"
  1. ;--- Check for an earlier admission that overlaps the date range
  1. S QUIT=0,VAIP("D")=STDT
  1. F D Q:QUIT
  1. . D IN5^VADPT
  1. . S VAIP("D")=+$G(VAIP(13,1))
  1. . I VAIP("D")'>0 S QUIT=2 Q
  1. . S VAIP("D")=$$FMADD^XLFDT(VAIP("D"),,,,-1)
  1. . S IEN=+$G(VAIP(12)) Q:IEN'>0
  1. . S RC=$$PTF^RORXU001(IEN,"FP",,.DISDT)
  1. . S QUIT=$S(RC:0,$G(DISDT)'>0:1,DISDT>STDT:1,1:2)
  1. Q $S(QUIT=1:"1^I",1:0)
  1. ;
  1. ;***** CHECKS LAB DATA
  1. LAB(STDT,ENDT,RORDFN) ;
  1. N PTID,RC,RORMSG,RORTMP
  1. S PTID=$$PTID^RORUTL02(RORDFN) Q:PTID<0 0
  1. S RORTMP=$$ALLOC^RORTMP()
  1. ;--- Get the Lab data
  1. S ENDT=(ENDT\1+1)_"^CD",STDT=STDT_"^CD"
  1. S RC=$$GCPR^LA7QRY(PTID,STDT,ENDT,"CH","*",.RORMSG,RORTMP)
  1. S RC=$S(($D(RORMSG)>1)&(RC=""):0,$D(@RORTMP)>1:"1^L",1:0)
  1. ;--- Cleanup
  1. D FREE^RORTMP(RORTMP)
  1. Q RC
  1. ;
  1. ;***** CHECKS MICROBIOLOGY DATA
  1. MICRO(STDT,ENDT,LRDFN) ;
  1. N RC,RORTMP
  1. S RC=0,RORTMP=$$ALLOC^RORTMP()
  1. D:$$GETDATA^LA7UTL1A(LRDFN,STDT,ENDT,"CD",RORTMP)'<0
  1. . S:$D(@RORTMP@(LRDFN)) RC="1^M"
  1. D FREE^RORTMP(RORTMP)
  1. Q RC
  1. ;
  1. ;***** CHECKS OUTPATIENT DATA
  1. OUTPAT(STDT,ENDT,RORDFN) ;
  1. S STDT=$P(STDT,".",1),STDT=STDT-1,STDT=STDT+.9999
  1. S ENDT=$P(ENDT,".",1),ENDT=ENDT+1
  1. N QUERY,RORDST,RORECNT
  1. S RORECNT=0
  1. S RORDST=$NA(^TMP("RORXU003",$J,"OUT"))
  1. D OPEN^SDQ(.QUERY)
  1. D INDEX^SDQ(.QUERY,"PATIENT/DATE","SET")
  1. D PAT^SDQ(.QUERY,RORDFN,"SET")
  1. D DATE^SDQ(.QUERY,STDT,ENDT,"SET")
  1. D SCANCB^SDQ(.QUERY,"D SCAN^RORXU003()","SET")
  1. D ACTIVE^SDQ(.QUERY,"TRUE","SET")
  1. D SCAN^SDQ(.QUERY,"FORWARD")
  1. D CLOSE^SDQ(.QUERY)
  1. Q $S(RORECNT:"1^O",1:0)
  1. ;
  1. ;***** CHECKS PHARMACY DATA
  1. PHARM(STDT,ENDT,RORDFN,CHK) ;
  1. N BUF,II,IP,IV,OP,ORD,RC,RORLST,SKIP,TMP,TYPE
  1. S ENDT=$$FMADD^XLFDT(ENDT\1,1)
  1. I '$D(CHK("ALL")) D
  1. . S IP='$D(CHK("IP"))
  1. . S IV='$D(CHK("IV"))
  1. . S OP='$D(CHK("OP"))
  1. E S (OP,IP,IV)=0
  1. ;=== Get the list of orders
  1. K ^TMP("PS",$J)
  1. D OCL^PSOORRL(RORDFN,STDT,ENDT)
  1. Q:$D(^TMP("PS",$J))<10 0
  1. S RORLST=$$ALLOC^RORTMP()
  1. ;=== Preselect the orders
  1. S II=0
  1. F S II=$O(^TMP("PS",$J,II)) Q:'II D
  1. . S BUF=$G(^TMP("PS",$J,II,0)),ORD=$P(BUF,U) Q:ORD'>0
  1. . S TMP=$L(ORD),TYPE=$E(ORD,TMP-2,TMP)
  1. . S TYPE=$S(TYPE="R;O":"R",TYPE="U;I":"U",TYPE="V;I":"V",1:"")
  1. . ;--- Check if this kind of orders should be processed
  1. . Q:$S(TYPE="R":OP,TYPE="U":IP,TYPE="V":IV,1:1)
  1. . ;--- Check the dates
  1. . I "UV"[TYPE S TMP=$P(BUF,U,15) Q:(TMP<STDT)!(TMP'<ENDT)
  1. . I TYPE="R" S TMP=$P(BUF,U,10) Q:TMP<STDT
  1. . ;--- Add the order to the list
  1. . S @RORLST@(II)=TYPE,@RORLST@(II,0)=BUF
  1. ;=== Process the preselected orders
  1. S II=0,RC=""
  1. F S II=$O(@RORLST@(II)) Q:'II D Q:OP&IP&IV
  1. . S TYPE=@RORLST@(II),ORD=$P(@RORLST@(II,0),U)
  1. . ;--- Outpatient
  1. . I TYPE="R" Q:OP D S:'SKIP OP=1,RC=RC_U_"OP" Q
  1. . . ;--- Double-check the Rx date(s)
  1. . . K ^TMP("PS",$J)
  1. . . D OEL^PSOORRL(RORDFN,ORD)
  1. . . I $D(^TMP("PS",$J))<10 S SKIP=1 Q
  1. . . S SKIP=$$DTCHECK^RORUTL15(STDT,ENDT)
  1. . ;--- Inpatient
  1. . I TYPE="U" Q:IP S IP=1,RC=RC_U_"IP" Q
  1. . ;--- IV
  1. . I TYPE="V" Q:IV S IV=1,RC=RC_U_"IV" Q
  1. ;===
  1. D FREE^RORTMP(RORLST)
  1. K ^TMP("PS",$J)
  1. S $P(RC,U)=(RC'="")
  1. Q RC
  1. ;
  1. ;***** CHECKS RADIOLOGY DATA
  1. RAD(STDT,ENDT,RORDFN) ;
  1. N RC
  1. K ^TMP($J,"RAE1")
  1. D EN1^RAO7PC1(RORDFN,STDT,ENDT,999999999)
  1. S RC=$S($D(^TMP($J,"RAE1",RORDFN))>1:"1^R",1:0)
  1. K ^TMP($J,"RAE1")
  1. Q RC
  1. ;
  1. ;*****
  1. SCAN() ;
  1. S RORECNT=1
  1. Q
  1. ;
  1. ;***** CHECKS SURGICAL PATHOLOGY DATA
  1. SURGP(STDT,ENDT,LRDFN) ;
  1. N IDT
  1. S IDT=$O(^LR(LRDFN,"SP",9999999-STDT))
  1. S IDT=$O(^LR(LRDFN,"SP",IDT),-1)
  1. Q $S(IDT&(IDT>(9999999-ENDT)):"1^SP",1:0)