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

RORUTL20.m

Go to the documentation of this file. 
  1. RORUTL20 ;ALBFO/TK - INPATIENT PROCEDURES UTILITIES ;1/29/07 9:53am
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**26**;Feb 17, 2006;Build 53
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #6130         PTFICD^DGPTFUT
  1.  ; #4205         CPTINFO^DGAPI
  1.  ;               PTFINFO^DGAPI
  1.  ; #2056         GETS^DIQ
  1.  ; #1995         CODEC^ICPTCOD
  1.  ; #5747         CODEC^ICDEX
  1.  ; #2055         ROOT^DILFD
  1.  ;
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;                 --- ROUTINE MODIFICATION LOG ---
  1.  ;        
  1.  ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
  1.  ;-----------  ----------  -----------  ----------------------------------------
  1.  ;
  1.  ;ROR*1.5*26   APR  2015   T KOPP       Added routine for all PTF procedures
  1.  ;                                      extract utility (INPROC)
  1.  ;
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  Q
  1.  ; Input:
  1.  ;  DE = the code representing the type of procedure to extract (C=CPT,I=ICD)
  1.  ;  IENS: the iens variable for the entry in file 45 (example: "10,")
  1.  ;  RORUPD: array passed by reference to accommodate use of the RORUPD("DSBEG")
  1.  ;          and RORUPD("ROREND") pre-set values.  
  1.  ; Output:
  1.  ;    Sets up RORVALS array for other procedure, surgical procedure and CPT multiples in file 45
  1.  ;
  1. SETPROC(DE,IENS,RORUPD,RORVALS) ;
  1.  N RORBUF,RORTYPE
  1.  S DE=$G(DE,"B")
  1.  S RORTYPE=$S(DE=152:"I",DE="153":"C",1:DE)
  1.  D INPROC(IENS,RORTYPE,.RORBUF,$G(RORUPD("DSBEG"),2850101),$G(RORUPD("DSEND"),9999999))
  1.  I $G(RORBUF(0))>0 D
  1.  . I RORTYPE="I"!(RORTYPE="B") D
  1.  . . N S1,S2,SCT
  1.  . . S S1="ICD",S2="",SCT=0
  1.  . . F  S S2=$O(RORBUF(S1,S2)) Q:S2=""  D
  1.  . . . S SCT=SCT+1,RORVALS("PPTF","I",SCT,"I")=$P(RORBUF(S1,S2),U,2)
  1.  . I RORTYPE="C"!(RORTYPE="B") D
  1.  . . N S1,S2,SCT
  1.  . . S S1="CPT",S2="",SCT=0
  1.  . . F  S S2=$O(RORBUF(S1,S2)) Q:S2=""  D
  1.  . . . S SCT=SCT+1,RORVALS("PPTF","C",SCT,"I")=$P(RORBUF(S1,S2),U,2)
  1.  Q
  1.  ;
  1.  ; Returns all inpatient ICD and/or CPT procedure codes for a patient
  1.  ;
  1.  ; Input:
  1.  ;   PTIEN    : DFN of patient
  1.  ;   RORTYPE  : Code to indicate the type of procedure to return
  1.  ;                I = ICD only  C = CPT only  B = both (default)
  1.  ;   RORIBUF  : the array, passed by reference where the data will be returned
  1.  ;   RORSDT   : start date to consider (optional)
  1.  ;   ROREDT   : end date to consider (optional)
  1.  ;
  1.  ; Output:
  1.  ; Returns array RORIBUF("ICD-401,"file 45.01 ien,file 45 ien")=ICD DATE^internal icd code
  1.  ;               RORIBUF("ICD-601,"file 45.05 ien,file 45 ien")=ICD DATE^internal icd code
  1.  ;               RORIBUF("CPT","file 45.06 ien,file 45 ien")=CPT DATE^internal cpt code
  1.  ; RORIBUF(0)=-1 if error or 0 if success
  1.  ;
  1. INPROC(IEN45,RORTYPE,RORIBUF,RORSDT,ROREDT) ;  Get all inpatient procedures from PTF
  1.  N RORDATE,DATE,RORIEN,IEN,IENS,NODE,RORBUF,RORMSG,FLD,RC,PTIEN
  1.  N C,RORCPT,RORCPTCT,RORPTF,RORCD,REF401,ROR401,REF601,ROR601,Z
  1.  I '$D(RORTYPE) S RORTYPE="B"
  1.  K RORIBUF
  1.  K ^TMP("PTF",$J),^TMP("RORPTF",$J)
  1.  S IEN45=","_IEN45
  1.  ;--- Surgical procedures
  1.  S RORIBUF(0)=0,RC=0
  1.  I RORTYPE="I"!(RORTYPE="B") D  ; 'I'CD only or 'B'OTH ICD and CPT
  1.  . S ROR401=$$ROOT^DILFD(45.01,IEN45,1),REF401=$NA(@ROR401)
  1.  . S RORIEN=0 F  S RORIEN=$O(@REF401@(RORIEN)) Q:RORIEN'>0  D
  1.  . . K RORBUF,RORMSG
  1.  . . S IENS=+RORIEN_IEN45
  1.  . . D GETS^DIQ(45.01,IENS,".01;","I","RORBUF","RORMSG")
  1.  . . I $G(RORMSG) S RC=$$ERROR^RORERR(-57,,,,RORMSG(0),"GETS^DIQ;401"),RORIBUF(0)=-1 Q
  1.  . . S RORDATE=$G(RORBUF(45.01,IENS,.01,"I"))
  1.  . . Q:'RORDATE
  1.  . . I $G(RORSDT)!($G(ROREDT)) Q:'$$CHKDT(RORDATE\1,$G(RORSDT,0),$G(ROREDT,9999999))
  1.  . . K ROR ;D PTFICD^DGPTFUT(401,IEN45,RORIEN,.ROR)
  1.  . . S FLD="" F  S FLD=$O(ROR(FLD)) Q:FLD=""  I $G(ROR(FLD)) D
  1.  . . . S RORIBUF("ICD-401",RORIEN_IEN45_FLD)=RORDATE_U_+ROR(FLD),RORIBUF(0)=$G(RORIBUF(0))+1
  1.  . ;--- Other procedures
  1.  . S ROR601=$$ROOT^DILFD(45.05,IEN45,1),REF601=$NA(@ROR601)
  1.  . S IEN=0 F  S IEN=$O(@REF601@(IEN)) Q:IEN'>0  D
  1.  . . K RORBUF,RORMSG
  1.  . . S IENS=IEN_","_IEN45_","
  1.  . . D GETS^DIQ(45.05,IENS,"","I","RORBUF","RORMSG")
  1.  . . I $G(RORMSG) S RC=$$ERROR^RORERR(-57,,,,RORMSG(0),"GETS^DIQ;601"),RORIBUF(0)=-1 Q
  1.  . . S RORDATE=$G(RORBUF(45.05,IENS,.01,"I"))
  1.  . . Q:'RORDATE
  1.  . . I $G(RORSDT)!($G(ROREDT)) Q:'$$CHKDT(RORDATE\1,$G(RORSDT,0),$G(ROREDT,9999999))
  1.  . . K ROR ;D PTFICD^DGPTFUT(601,IEN45,IEN,.ROR)
  1.  . . S FLD="" F  S FLD=$O(ROR(FLD)) Q:FLD=""  I $G(ROR(FLD)) D
  1.  . . . S RORIBUF("ICD-601",IEN_","_IEN45)=RORDATE_U_+ROR(FLD),RORIBUF(0)=$G(RORIBUF(0))+1
  1.  ;--- CPT codes
  1.  I RORTYPE="C"!(RORTYPE="B") D  ; 'C'PT only or 'B'OTH ICD and CPT
  1.  . K ^TMP("PTF",$J),RORBUF,RORMSG
  1.  . S IEN45=$E(IEN45,2,$L(IEN45))
  1.  . D GETS^DIQ(45,IEN45,".01;","I","RORBUF","RORMSG")
  1.  . I $G(RORMSG) S RC=$$ERROR^RORERR(-57,,,,RORMSG(0),"GETS^DIQ;CPT"),RORIBUF(0)=-1 Q
  1.  . S PTIEN=+$G(RORBUF(45,IEN45,.01,"I"))
  1.  . D PTFINFOR^DGAPI(PTIEN,+IEN45) ;List of CPT code records in PTF
  1.  . K ^TMP("RORPTF",$J) M ^TMP("RORPTF",$J)=^TMP("PTF",$J)
  1.  . S RORPTF=0,RORCPTCT=0
  1.  . S Z=0 F  S Z=$O(^TMP("RORPTF",$J,Z)) Q:'Z  D
  1.  . . S RORDATE=+$G(^TMP("RORPTF",$J,Z))
  1.  . . D CPTINFO^DGAPI(PTIEN,+IEN45,+^TMP("RORPTF",$J,Z))  ; Pulls CPT code nodes from file 46
  1.  . . I $G(RORSDT)!($G(ROREDT)) Q:'$$CHKDT(RORDATE\1,$G(RORSDT,0),$G(ROREDT,9999999))
  1.  . . S RORCPT=0 F  S RORCPT=$O(^TMP("PTF",$J,46,RORCPT)) Q:'RORCPT  D
  1.  . . . S IEN=+$G(^TMP("PTF",$J,46,RORCPT)),RORCD=$P($G(^(RORCPT)),U,2)
  1.  . . . I RORCD S RORCPTCT=RORCPTCT+1,RORIBUF("CPT",IEN_IEN45_RORCPTCT)=RORDATE_U_RORCD,RORIBUF(0)=$G(RORIBUF(0))+1
  1.  . K ^TMP("PTF",$J),^TMP("RORPTF",$J)
  1.  ;
  1.  Q
  1.  ;
  1. CHKDT(DATE,SDATE,EDATE) ; Check dates - returns 1 if DATE is within SDATE-EDATE range
  1.  I (DATE<SDATE)!(DATE'<EDATE) Q 0
  1.  Q 1
  1.  ;