RORUTL20 ;ALBFO/TK - INPATIENT PROCEDURES UTILITIES ;1/29/07 9:53am
;;1.5;CLINICAL CASE REGISTRIES;**26**;Feb 17, 2006;Build 53
;
; This routine uses the following IAs:
;
; #6130 PTFICD^DGPTFUT
; #4205 CPTINFO^DGAPI
; PTFINFO^DGAPI
; #2056 GETS^DIQ
; #1995 CODEC^ICPTCOD
; #5747 CODEC^ICDEX
; #2055 ROOT^DILFD
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;
;ROR*1.5*26 APR 2015 T KOPP Added routine for all PTF procedures
; extract utility (INPROC)
;
;******************************************************************************
;******************************************************************************
Q
; Input:
; DE = the code representing the type of procedure to extract (C=CPT,I=ICD)
; IENS: the iens variable for the entry in file 45 (example: "10,")
; RORUPD: array passed by reference to accommodate use of the RORUPD("DSBEG")
; and RORUPD("ROREND") pre-set values.
; Output:
; Sets up RORVALS array for other procedure, surgical procedure and CPT multiples in file 45
;
SETPROC(DE,IENS,RORUPD,RORVALS) ;
N RORBUF,RORTYPE
S DE=$G(DE,"B")
S RORTYPE=$S(DE=152:"I",DE="153":"C",1:DE)
D INPROC(IENS,RORTYPE,.RORBUF,$G(RORUPD("DSBEG"),2850101),$G(RORUPD("DSEND"),9999999))
I $G(RORBUF(0))>0 D
. I RORTYPE="I"!(RORTYPE="B") D
. . N S1,S2,SCT
. . S S1="ICD",S2="",SCT=0
. . F S S2=$O(RORBUF(S1,S2)) Q:S2="" D
. . . S SCT=SCT+1,RORVALS("PPTF","I",SCT,"I")=$P(RORBUF(S1,S2),U,2)
. I RORTYPE="C"!(RORTYPE="B") D
. . N S1,S2,SCT
. . S S1="CPT",S2="",SCT=0
. . F S S2=$O(RORBUF(S1,S2)) Q:S2="" D
. . . S SCT=SCT+1,RORVALS("PPTF","C",SCT,"I")=$P(RORBUF(S1,S2),U,2)
Q
;
; Returns all inpatient ICD and/or CPT procedure codes for a patient
;
; Input:
; PTIEN : DFN of patient
; RORTYPE : Code to indicate the type of procedure to return
; I = ICD only C = CPT only B = both (default)
; RORIBUF : the array, passed by reference where the data will be returned
; RORSDT : start date to consider (optional)
; ROREDT : end date to consider (optional)
;
; Output:
; Returns array RORIBUF("ICD-401,"file 45.01 ien,file 45 ien")=ICD DATE^internal icd code
; RORIBUF("ICD-601,"file 45.05 ien,file 45 ien")=ICD DATE^internal icd code
; RORIBUF("CPT","file 45.06 ien,file 45 ien")=CPT DATE^internal cpt code
; RORIBUF(0)=-1 if error or 0 if success
;
INPROC(IEN45,RORTYPE,RORIBUF,RORSDT,ROREDT) ; Get all inpatient procedures from PTF
N RORDATE,DATE,RORIEN,IEN,IENS,NODE,RORBUF,RORMSG,FLD,RC,PTIEN
N C,RORCPT,RORCPTCT,RORPTF,RORCD,REF401,ROR401,REF601,ROR601,Z
I '$D(RORTYPE) S RORTYPE="B"
K RORIBUF
K ^TMP("PTF",$J),^TMP("RORPTF",$J)
S IEN45=","_IEN45
;--- Surgical procedures
S RORIBUF(0)=0,RC=0
I RORTYPE="I"!(RORTYPE="B") D ; 'I'CD only or 'B'OTH ICD and CPT
. S ROR401=$$ROOT^DILFD(45.01,IEN45,1),REF401=$NA(@ROR401)
. S RORIEN=0 F S RORIEN=$O(@REF401@(RORIEN)) Q:RORIEN'>0 D
. . K RORBUF,RORMSG
. . S IENS=+RORIEN_IEN45
. . D GETS^DIQ(45.01,IENS,".01;","I","RORBUF","RORMSG")
. . I $G(RORMSG) S RC=$$ERROR^RORERR(-57,,,,RORMSG(0),"GETS^DIQ;401"),RORIBUF(0)=-1 Q
. . S RORDATE=$G(RORBUF(45.01,IENS,.01,"I"))
. . Q:'RORDATE
. . I $G(RORSDT)!($G(ROREDT)) Q:'$$CHKDT(RORDATE\1,$G(RORSDT,0),$G(ROREDT,9999999))
. . K ROR ;D PTFICD^DGPTFUT(401,IEN45,RORIEN,.ROR)
. . S FLD="" F S FLD=$O(ROR(FLD)) Q:FLD="" I $G(ROR(FLD)) D
. . . S RORIBUF("ICD-401",RORIEN_IEN45_FLD)=RORDATE_U_+ROR(FLD),RORIBUF(0)=$G(RORIBUF(0))+1
. ;--- Other procedures
. S ROR601=$$ROOT^DILFD(45.05,IEN45,1),REF601=$NA(@ROR601)
. S IEN=0 F S IEN=$O(@REF601@(IEN)) Q:IEN'>0 D
. . K RORBUF,RORMSG
. . S IENS=IEN_","_IEN45_","
. . D GETS^DIQ(45.05,IENS,"","I","RORBUF","RORMSG")
. . I $G(RORMSG) S RC=$$ERROR^RORERR(-57,,,,RORMSG(0),"GETS^DIQ;601"),RORIBUF(0)=-1 Q
. . S RORDATE=$G(RORBUF(45.05,IENS,.01,"I"))
. . Q:'RORDATE
. . I $G(RORSDT)!($G(ROREDT)) Q:'$$CHKDT(RORDATE\1,$G(RORSDT,0),$G(ROREDT,9999999))
. . K ROR ;D PTFICD^DGPTFUT(601,IEN45,IEN,.ROR)
. . S FLD="" F S FLD=$O(ROR(FLD)) Q:FLD="" I $G(ROR(FLD)) D
. . . S RORIBUF("ICD-601",IEN_","_IEN45)=RORDATE_U_+ROR(FLD),RORIBUF(0)=$G(RORIBUF(0))+1
;--- CPT codes
I RORTYPE="C"!(RORTYPE="B") D ; 'C'PT only or 'B'OTH ICD and CPT
. K ^TMP("PTF",$J),RORBUF,RORMSG
. S IEN45=$E(IEN45,2,$L(IEN45))
. D GETS^DIQ(45,IEN45,".01;","I","RORBUF","RORMSG")
. I $G(RORMSG) S RC=$$ERROR^RORERR(-57,,,,RORMSG(0),"GETS^DIQ;CPT"),RORIBUF(0)=-1 Q
. S PTIEN=+$G(RORBUF(45,IEN45,.01,"I"))
. D PTFINFOR^DGAPI(PTIEN,+IEN45) ;List of CPT code records in PTF
. K ^TMP("RORPTF",$J) M ^TMP("RORPTF",$J)=^TMP("PTF",$J)
. S RORPTF=0,RORCPTCT=0
. S Z=0 F S Z=$O(^TMP("RORPTF",$J,Z)) Q:'Z D
. . S RORDATE=+$G(^TMP("RORPTF",$J,Z))
. . D CPTINFO^DGAPI(PTIEN,+IEN45,+^TMP("RORPTF",$J,Z)) ; Pulls CPT code nodes from file 46
. . I $G(RORSDT)!($G(ROREDT)) Q:'$$CHKDT(RORDATE\1,$G(RORSDT,0),$G(ROREDT,9999999))
. . S RORCPT=0 F S RORCPT=$O(^TMP("PTF",$J,46,RORCPT)) Q:'RORCPT D
. . . S IEN=+$G(^TMP("PTF",$J,46,RORCPT)),RORCD=$P($G(^(RORCPT)),U,2)
. . . I RORCD S RORCPTCT=RORCPTCT+1,RORIBUF("CPT",IEN_IEN45_RORCPTCT)=RORDATE_U_RORCD,RORIBUF(0)=$G(RORIBUF(0))+1
. K ^TMP("PTF",$J),^TMP("RORPTF",$J)
;
Q
;
CHKDT(DATE,SDATE,EDATE) ; Check dates - returns 1 if DATE is within SDATE-EDATE range
I (DATE<SDATE)!(DATE'<EDATE) Q 0
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUTL20 5884 printed Sep 23, 2025@19:20:10 Page 2
RORUTL20 ;ALBFO/TK - INPATIENT PROCEDURES UTILITIES ;1/29/07 9:53am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**26**;Feb 17, 2006;Build 53
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #6130 PTFICD^DGPTFUT
+6 ; #4205 CPTINFO^DGAPI
+7 ; PTFINFO^DGAPI
+8 ; #2056 GETS^DIQ
+9 ; #1995 CODEC^ICPTCOD
+10 ; #5747 CODEC^ICDEX
+11 ; #2055 ROOT^DILFD
+12 ;
+13 ;******************************************************************************
+14 ;******************************************************************************
+15 ; --- ROUTINE MODIFICATION LOG ---
+16 ;
+17 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+18 ;----------- ---------- ----------- ----------------------------------------
+19 ;
+20 ;ROR*1.5*26 APR 2015 T KOPP Added routine for all PTF procedures
+21 ; extract utility (INPROC)
+22 ;
+23 ;******************************************************************************
+24 ;******************************************************************************
+25 QUIT
+26 ; Input:
+27 ; DE = the code representing the type of procedure to extract (C=CPT,I=ICD)
+28 ; IENS: the iens variable for the entry in file 45 (example: "10,")
+29 ; RORUPD: array passed by reference to accommodate use of the RORUPD("DSBEG")
+30 ; and RORUPD("ROREND") pre-set values.
+31 ; Output:
+32 ; Sets up RORVALS array for other procedure, surgical procedure and CPT multiples in file 45
+33 ;
SETPROC(DE,IENS,RORUPD,RORVALS) ;
+1 NEW RORBUF,RORTYPE
+2 SET DE=$GET(DE,"B")
+3 SET RORTYPE=$SELECT(DE=152:"I",DE="153":"C",1:DE)
+4 DO INPROC(IENS,RORTYPE,.RORBUF,$GET(RORUPD("DSBEG"),2850101),$GET(RORUPD("DSEND"),9999999))
+5 IF $GET(RORBUF(0))>0
Begin DoDot:1
+6 IF RORTYPE="I"!(RORTYPE="B")
Begin DoDot:2
+7 NEW S1,S2,SCT
+8 SET S1="ICD"
SET S2=""
SET SCT=0
+9 FOR
SET S2=$ORDER(RORBUF(S1,S2))
if S2=""
QUIT
Begin DoDot:3
+10 SET SCT=SCT+1
SET RORVALS("PPTF","I",SCT,"I")=$PIECE(RORBUF(S1,S2),U,2)
End DoDot:3
End DoDot:2
+11 IF RORTYPE="C"!(RORTYPE="B")
Begin DoDot:2
+12 NEW S1,S2,SCT
+13 SET S1="CPT"
SET S2=""
SET SCT=0
+14 FOR
SET S2=$ORDER(RORBUF(S1,S2))
if S2=""
QUIT
Begin DoDot:3
+15 SET SCT=SCT+1
SET RORVALS("PPTF","C",SCT,"I")=$PIECE(RORBUF(S1,S2),U,2)
End DoDot:3
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
+18 ; Returns all inpatient ICD and/or CPT procedure codes for a patient
+19 ;
+20 ; Input:
+21 ; PTIEN : DFN of patient
+22 ; RORTYPE : Code to indicate the type of procedure to return
+23 ; I = ICD only C = CPT only B = both (default)
+24 ; RORIBUF : the array, passed by reference where the data will be returned
+25 ; RORSDT : start date to consider (optional)
+26 ; ROREDT : end date to consider (optional)
+27 ;
+28 ; Output:
+29 ; Returns array RORIBUF("ICD-401,"file 45.01 ien,file 45 ien")=ICD DATE^internal icd code
+30 ; RORIBUF("ICD-601,"file 45.05 ien,file 45 ien")=ICD DATE^internal icd code
+31 ; RORIBUF("CPT","file 45.06 ien,file 45 ien")=CPT DATE^internal cpt code
+32 ; RORIBUF(0)=-1 if error or 0 if success
+33 ;
INPROC(IEN45,RORTYPE,RORIBUF,RORSDT,ROREDT) ; Get all inpatient procedures from PTF
+1 NEW RORDATE,DATE,RORIEN,IEN,IENS,NODE,RORBUF,RORMSG,FLD,RC,PTIEN
+2 NEW C,RORCPT,RORCPTCT,RORPTF,RORCD,REF401,ROR401,REF601,ROR601,Z
+3 IF '$DATA(RORTYPE)
SET RORTYPE="B"
+4 KILL RORIBUF
+5 KILL ^TMP("PTF",$JOB),^TMP("RORPTF",$JOB)
+6 SET IEN45=","_IEN45
+7 ;--- Surgical procedures
+8 SET RORIBUF(0)=0
SET RC=0
+9 ; 'I'CD only or 'B'OTH ICD and CPT
IF RORTYPE="I"!(RORTYPE="B")
Begin DoDot:1
+10 SET ROR401=$$ROOT^DILFD(45.01,IEN45,1)
SET REF401=$NAME(@ROR401)
+11 SET RORIEN=0
FOR
SET RORIEN=$ORDER(@REF401@(RORIEN))
if RORIEN'>0
QUIT
Begin DoDot:2
+12 KILL RORBUF,RORMSG
+13 SET IENS=+RORIEN_IEN45
+14 DO GETS^DIQ(45.01,IENS,".01;","I","RORBUF","RORMSG")
+15 IF $GET(RORMSG)
SET RC=$$ERROR^RORERR(-57,,,,RORMSG(0),"GETS^DIQ;401")
SET RORIBUF(0)=-1
QUIT
+16 SET RORDATE=$GET(RORBUF(45.01,IENS,.01,"I"))
+17 if 'RORDATE
QUIT
+18 IF $GET(RORSDT)!($GET(ROREDT))
if '$$CHKDT(RORDATE\1,$GET(RORSDT,0),$GET(ROREDT,9999999))
QUIT
+19 ;D PTFICD^DGPTFUT(401,IEN45,RORIEN,.ROR)
KILL ROR
+20 SET FLD=""
FOR
SET FLD=$ORDER(ROR(FLD))
if FLD=""
QUIT
IF $GET(ROR(FLD))
Begin DoDot:3
+21 SET RORIBUF("ICD-401",RORIEN_IEN45_FLD)=RORDATE_U_+ROR(FLD)
SET RORIBUF(0)=$GET(RORIBUF(0))+1
End DoDot:3
End DoDot:2
+22 ;--- Other procedures
+23 SET ROR601=$$ROOT^DILFD(45.05,IEN45,1)
SET REF601=$NAME(@ROR601)
+24 SET IEN=0
FOR
SET IEN=$ORDER(@REF601@(IEN))
if IEN'>0
QUIT
Begin DoDot:2
+25 KILL RORBUF,RORMSG
+26 SET IENS=IEN_","_IEN45_","
+27 DO GETS^DIQ(45.05,IENS,"","I","RORBUF","RORMSG")
+28 IF $GET(RORMSG)
SET RC=$$ERROR^RORERR(-57,,,,RORMSG(0),"GETS^DIQ;601")
SET RORIBUF(0)=-1
QUIT
+29 SET RORDATE=$GET(RORBUF(45.05,IENS,.01,"I"))
+30 if 'RORDATE
QUIT
+31 IF $GET(RORSDT)!($GET(ROREDT))
if '$$CHKDT(RORDATE\1,$GET(RORSDT,0),$GET(ROREDT,9999999))
QUIT
+32 ;D PTFICD^DGPTFUT(601,IEN45,IEN,.ROR)
KILL ROR
+33 SET FLD=""
FOR
SET FLD=$ORDER(ROR(FLD))
if FLD=""
QUIT
IF $GET(ROR(FLD))
Begin DoDot:3
+34 SET RORIBUF("ICD-601",IEN_","_IEN45)=RORDATE_U_+ROR(FLD)
SET RORIBUF(0)=$GET(RORIBUF(0))+1
End DoDot:3
End DoDot:2
End DoDot:1
+35 ;--- CPT codes
+36 ; 'C'PT only or 'B'OTH ICD and CPT
IF RORTYPE="C"!(RORTYPE="B")
Begin DoDot:1
+37 KILL ^TMP("PTF",$JOB),RORBUF,RORMSG
+38 SET IEN45=$EXTRACT(IEN45,2,$LENGTH(IEN45))
+39 DO GETS^DIQ(45,IEN45,".01;","I","RORBUF","RORMSG")
+40 IF $GET(RORMSG)
SET RC=$$ERROR^RORERR(-57,,,,RORMSG(0),"GETS^DIQ;CPT")
SET RORIBUF(0)=-1
QUIT
+41 SET PTIEN=+$GET(RORBUF(45,IEN45,.01,"I"))
+42 ;List of CPT code records in PTF
DO PTFINFOR^DGAPI(PTIEN,+IEN45)
+43 KILL ^TMP("RORPTF",$JOB)
MERGE ^TMP("RORPTF",$JOB)=^TMP("PTF",$JOB)
+44 SET RORPTF=0
SET RORCPTCT=0
+45 SET Z=0
FOR
SET Z=$ORDER(^TMP("RORPTF",$JOB,Z))
if 'Z
QUIT
Begin DoDot:2
+46 SET RORDATE=+$GET(^TMP("RORPTF",$JOB,Z))
+47 ; Pulls CPT code nodes from file 46
DO CPTINFO^DGAPI(PTIEN,+IEN45,+^TMP("RORPTF",$JOB,Z))
+48 IF $GET(RORSDT)!($GET(ROREDT))
if '$$CHKDT(RORDATE\1,$GET(RORSDT,0),$GET(ROREDT,9999999))
QUIT
+49 SET RORCPT=0
FOR
SET RORCPT=$ORDER(^TMP("PTF",$JOB,46,RORCPT))
if 'RORCPT
QUIT
Begin DoDot:3
+50 SET IEN=+$GET(^TMP("PTF",$JOB,46,RORCPT))
SET RORCD=$PIECE($GET(^(RORCPT)),U,2)
+51 IF RORCD
SET RORCPTCT=RORCPTCT+1
SET RORIBUF("CPT",IEN_IEN45_RORCPTCT)=RORDATE_U_RORCD
SET RORIBUF(0)=$GET(RORIBUF(0))+1
End DoDot:3
End DoDot:2
+52 KILL ^TMP("PTF",$JOB),^TMP("RORPTF",$JOB)
End DoDot:1
+53 ;
+54 QUIT
+55 ;
CHKDT(DATE,SDATE,EDATE) ; Check dates - returns 1 if DATE is within SDATE-EDATE range
+1 IF (DATE<SDATE)!(DATE'<EDATE)
QUIT 0
+2 QUIT 1
+3 ;
