RORX008A ;HOIFO/BH,SG,VAC - VERA REIMBURSEMENT REPORT ;4/7/09 2:08pm
;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,21,31,39**;Feb 17, 2006;Build 4
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
; 'include' or 'exclude'.
;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
; clinics, or divisions for the report.
;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
; additional identifier option selected
;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
; identifiers.
;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
;******************************************************************************
;******************************************************************************
Q
;
;***** QUERIES THE REGISTRY
;
; FLAGS Flags for the $$SKIP^RORXU005
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
QUERY(FLAGS) ;
N RORPTN ; Number of patients in the registry
N RORCDLIST ; Flag to indicate whether a clinic or division list exists
N RORCDSTDT ; Start date for clinic/division utilization search
N RORCDENDT ; End date for clinic/division utilization search
;
N CLINAIDS,CMPXCARE,CNT,CNTARV,CNTBASIC,CNTCMPX,ECNT,FLAG,IEN,NAME,PATIEN,RC,RCC,RORIEN,RORXDST,TMP,UTLCHK,VA,VADM,VAERR,XREFNODE
N AGE,AGETYPE
;
S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
S (CNT,CNTARV,CNTBASIC,CNTCMPX,ECNT,RC)=0
S UTLCHK("ALL")=""
;
;--- Prepare parameters for the pharmacy search API
S RORXDST("RORCB")="$$RXSCB^RORX008A"
S TMP=$$PARAM^RORTSK01("OPTIONS","REGMEDSMRY")
S RORXDST("SINGLE")='TMP!'$$PARAM^RORTSK01("PATIENTS","COMPLEX")
;
;=== Set up Clinic/Division list parameters
S RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
;
;--- Browse through the registry records
S RORIEN=0
S FLAG=$G(RORTSK("PARAMS","ICDFILT","A","FILTER"))
F S RORIEN=$O(@XREFNODE@(RORIEN)) Q:RORIEN'>0 D Q:RC<0
. ;--- Start progress counter
. S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
. S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
. S CNT=CNT+1
. ;--- Get patient DFN
. S PATIEN=$$PTIEN^RORUTL01(RORIEN) Q:PATIEN'>0
. ;check for patient list and quit if not on list
. I $D(RORTSK("PARAMS","PATIENTS","C")),'$D(RORTSK("PARAMS","PATIENTS","C",PATIEN)) Q
. ;--- Check if the patient should be skipped
. Q:$$SKIP^RORXU005(RORIEN,FLAGS,RORSDT,ROREDT)
. ;--- Check patient against ICD list
. S RCC=0
. I FLAG'="ALL" D
. . S RCC=$$ICD^RORXU010(PATIEN)
. I (FLAG="INCLUDE")&(RCC=0) Q
. I (FLAG="EXCLUDE")&(RCC=1) Q
. ; End of check of ICD list
. ;
. ;--- Check for Clinic or Division list and quit if not in list
. I RORCDLIST,'$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT) Q
. ;
. ;--- Skip Clinical AIDS if Complex Care was not requested
. S CMPXCARE=0
. S CLINAIDS=$S($$CLINAIDS^RORHIVUT(RORIEN,ROREDT):1,1:0)
. I CLINAIDS Q:'$$PARAM^RORTSK01("PATIENTS","COMPLEX") S CMPXCARE=1
. ;
. ;--- Skip a patient without utlilization
. Q:'$$UTIL^RORXU003(RORSDT,ROREDT,PATIEN,.UTLCHK)
. ;
. ;--- Search for pharmacy data
. K RORXDST("ARV")
. S TMP=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV",RORSDT,ROREDT1)
. I TMP<0 S ECNT=ECNT+1 Q
. I $D(RORXDST("ARV")) Q:'$$PARAM^RORTSK01("PATIENTS","COMPLEX") D
. . S IEN=0
. . F S IEN=$O(RORXDST("ARV",IEN)) Q:IEN'>0 D
. . . D:'$D(^TMP("RORX008",$J,"DRG",IEN))
. . . . S ^TMP("RORX008",$J,"DRG",IEN)=RORXDST("ARV",IEN)
. . . S ^(CLINAIDS)=$G(^TMP("RORX008",$J,"DRG",IEN,CLINAIDS))+1 ;naked reference: ^TMP("RORX008",$J,"DRG",IEN,CLINAIDS)
. . S CMPXCARE=1,CNTARV=CNTARV+1
. ;
. ;--- Skip Basic Care if it was not requested
. I CMPXCARE S CNTCMPX=CNTCMPX+1
. E Q:'$$PARAM^RORTSK01("PATIENTS","BASIC") S CNTBASIC=CNTBASIC+1
. ;
. D:$$PARAM^RORTSK01("OPTIONS","PTLIST")
. . D VADEM^RORUTL05(PATIEN,1)
. . S TMP=$$DATE^RORXU002(VADM(6)\1)
. . S TMP=TMP_U_($D(RORXDST("ARV"))>0)_U_CMPXCARE_U_CLINAIDS
. . S ^TMP("RORX008",$J,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_TMP
. . S $P(^TMP("RORX008",$J,"PAT",PATIEN),U,6)=$S($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
. . S $P(^TMP("RORX008",$J,"PAT",PATIEN),U,7)=$S($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
. . S $P(^TMP("RORX008",$J,"PAT",PATIEN),U,8)=$S($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
. . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") D
. . . S AGE=$S(AGETYPE="AGE":$P(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($P(VADM(3),U)\1),1:"")
. . S $P(^TMP("RORX008",$J,"PAT",PATIEN),U,9)=AGE
;
;--- Totals
S ^TMP("RORX008",$J,"PAT")=CNTBASIC_U_CNTCMPX_U_CNTARV
;---
Q $S(RC<0:RC,1:ECNT)
;
;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
RXSCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
N CA,IEN,NAME
S IEN=+ROR8DST("RORXGEN"),NAME=$P(ROR8DST("RORXGEN"),U,2)
Q:(IEN'>0)!(NAME="") 1
;---
S ROR8DST("ARV")="" Q:ROR8DST("SINGLE") 2
;---
S ROR8DST("ARV",IEN)=NAME
Q 0
;
;***** STORES THE REPORT DATA
;
; REPORT IEN of the REPORT element
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Number of non-fatal errors
;
STORE(REPORT) ;
N BUF,CNT,ITEM,IEN,NODE,NPAIDS,NPHIV,RC,TABLE,TMP
S NODE=$NA(^TMP("RORX008",$J)),RC=0
;
;--- List of ARV drugs
S TMP=$$PARAM^RORTSK01("OPTIONS","REGMEDSMRY")
I TMP,$$PARAM^RORTSK01("PATIENTS","COMPLEX") D Q:RC<0 RC
. S TABLE=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,REPORT)
. I TABLE<0 S RC=TABLE Q
. D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","DRUGS")
. S IEN=0
. F S IEN=$O(@NODE@("DRG",IEN)) Q:IEN'>0 D
. . S BUF=@NODE@("DRG",IEN)
. . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,TABLE)
. . D ADDVAL^RORTSK11(RORTSK,"NAME",$P(@NODE@("DRG",IEN),U),ITEM,1)
. . S NPHIV=+$G(@NODE@("DRG",IEN,0))
. . S NPAIDS=+$G(@NODE@("DRG",IEN,1))
. . D ADDVAL^RORTSK11(RORTSK,"NP",NPHIV+NPAIDS,ITEM,3)
. . D ADDVAL^RORTSK11(RORTSK,"NPHIV",NPHIV,ITEM,3)
. . D ADDVAL^RORTSK11(RORTSK,"NPAIDS",NPAIDS,ITEM,3)
;
;--- List of patients
I $$PARAM^RORTSK01("OPTIONS","PTLIST") D Q:RC<0 RC
. S TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
. I TABLE<0 S RC=TABLE Q
. D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
. S IEN=0
. F S IEN=$O(@NODE@("PAT",IEN)) Q:IEN'>0 D
. . S BUF=@NODE@("PAT",IEN) S $P(BUF,U)="0000"
. . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE,,IEN)
. . D ADDVAL^RORTSK11(RORTSK,"NAME",$P(BUF,U,2),ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(BUF,U),ITEM,2)
. . S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE") I AGETYPE'="ALL" D
. . . D ADDVAL^RORTSK11(RORTSK,AGETYPE,$P(BUF,U,9),ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(BUF,U,3),ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"AIDSTAT",+$P(BUF,U,6),ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"ARV",+$P(BUF,U,4),ITEM,1)
. . D ADDVAL^RORTSK11(RORTSK,"COMPLEX",+$P(BUF,U,5),ITEM,1)
. . I $$PARAM^RORTSK01("PATIENTS","ICN") D ADDVAL^RORTSK11(RORTSK,"ICN",$P(BUF,U,6),ITEM,1)
. . I $$PARAM^RORTSK01("PATIENTS","PACT") D ADDVAL^RORTSK11(RORTSK,"PACT",$P(BUF,U,7),ITEM,1)
. . I $$PARAM^RORTSK01("PATIENTS","PCP") D ADDVAL^RORTSK11(RORTSK,"PCP",$P(BUF,U,8),ITEM,1)
;
;--- Summary
S BUF=@NODE@("PAT")
S ITEM=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
D ADDVAL^RORTSK11(RORTSK,"NP",$P(BUF,U)+$P(BUF,U,2),ITEM)
D ADDVAL^RORTSK11(RORTSK,"NPBASIC",+$P(BUF,U,1),ITEM)
D ADDVAL^RORTSK11(RORTSK,"NPCOMPLEX",+$P(BUF,U,2),ITEM)
D ADDVAL^RORTSK11(RORTSK,"NPARV",+$P(BUF,U,3),ITEM)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX008A 8327 printed Sep 23, 2025@19:20:29 Page 2
RORX008A ;HOIFO/BH,SG,VAC - VERA REIMBURSEMENT REPORT ;4/7/09 2:08pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**8,13,19,21,31,39**;Feb 17, 2006;Build 4
+2 ;
+3 ;******************************************************************************
+4 ;******************************************************************************
+5 ; --- ROUTINE MODIFICATION LOG ---
+6 ;
+7 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+8 ;----------- ---------- ----------- ----------------------------------------
+9 ;ROR*1.5*8 MAR 2010 V CARR Modified to handle ICD9 filter for
+10 ; 'include' or 'exclude'.
+11 ;ROR*1.5*13 DEC 2010 A SAUNDERS User can select specific patients,
+12 ; clinics, or divisions for the report.
+13 ;ROR*1.5*19 FEB 2012 K GUPTA Support for ICD-10 Coding System
+14 ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
+15 ; additional identifier option selected
+16 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
+17 ; identifiers.
+18 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
+19 ;******************************************************************************
+20 ;******************************************************************************
+21 QUIT
+22 ;
+23 ;***** QUERIES THE REGISTRY
+24 ;
+25 ; FLAGS Flags for the $$SKIP^RORXU005
+26 ;
+27 ; Return Values:
+28 ; <0 Error code
+29 ; 0 Ok
+30 ; >0 Number of non-fatal errors
+31 ;
QUERY(FLAGS) ;
+1 ; Number of patients in the registry
NEW RORPTN
+2 ; Flag to indicate whether a clinic or division list exists
NEW RORCDLIST
+3 ; Start date for clinic/division utilization search
NEW RORCDSTDT
+4 ; End date for clinic/division utilization search
NEW RORCDENDT
+5 ;
+6 NEW CLINAIDS,CMPXCARE,CNT,CNTARV,CNTBASIC,CNTCMPX,ECNT,FLAG,IEN,NAME,PATIEN,RC,RCC,RORIEN,RORXDST,TMP,UTLCHK,VA,VADM,VAERR,XREFNODE
+7 NEW AGE,AGETYPE
+8 ;
+9 SET XREFNODE=$NAME(^RORDATA(798,"AC",+RORREG))
+10 SET RORPTN=$$REGSIZE^RORUTL02(+RORREG)
if RORPTN<0
SET RORPTN=0
+11 SET (CNT,CNTARV,CNTBASIC,CNTCMPX,ECNT,RC)=0
+12 SET UTLCHK("ALL")=""
+13 ;
+14 ;--- Prepare parameters for the pharmacy search API
+15 SET RORXDST("RORCB")="$$RXSCB^RORX008A"
+16 SET TMP=$$PARAM^RORTSK01("OPTIONS","REGMEDSMRY")
+17 SET RORXDST("SINGLE")='TMP!'$$PARAM^RORTSK01("PATIENTS","COMPLEX")
+18 ;
+19 ;=== Set up Clinic/Division list parameters
+20 SET RORCDLIST=$$CDPARMS^RORXU001(.RORTSK,.RORCDSTDT,.RORCDENDT)
+21 ;
+22 ;--- Browse through the registry records
+23 SET RORIEN=0
+24 SET FLAG=$GET(RORTSK("PARAMS","ICDFILT","A","FILTER"))
+25 FOR
SET RORIEN=$ORDER(@XREFNODE@(RORIEN))
if RORIEN'>0
QUIT
Begin DoDot:1
+26 ;--- Start progress counter
+27 SET TMP=$SELECT(RORPTN>0:CNT/RORPTN,1:"")
+28 SET RC=$$LOOP^RORTSK01(TMP)
if RC<0
QUIT
+29 SET CNT=CNT+1
+30 ;--- Get patient DFN
+31 SET PATIEN=$$PTIEN^RORUTL01(RORIEN)
if PATIEN'>0
QUIT
+32 ;check for patient list and quit if not on list
+33 IF $DATA(RORTSK("PARAMS","PATIENTS","C"))
IF '$DATA(RORTSK("PARAMS","PATIENTS","C",PATIEN))
QUIT
+34 ;--- Check if the patient should be skipped
+35 if $$SKIP^RORXU005(RORIEN,FLAGS,RORSDT,ROREDT)
QUIT
+36 ;--- Check patient against ICD list
+37 SET RCC=0
+38 IF FLAG'="ALL"
Begin DoDot:2
+39 SET RCC=$$ICD^RORXU010(PATIEN)
End DoDot:2
+40 IF (FLAG="INCLUDE")&(RCC=0)
QUIT
+41 IF (FLAG="EXCLUDE")&(RCC=1)
QUIT
+42 ; End of check of ICD list
+43 ;
+44 ;--- Check for Clinic or Division list and quit if not in list
+45 IF RORCDLIST
IF '$$CDUTIL^RORXU001(.RORTSK,PATIEN,RORCDSTDT,RORCDENDT)
QUIT
+46 ;
+47 ;--- Skip Clinical AIDS if Complex Care was not requested
+48 SET CMPXCARE=0
+49 SET CLINAIDS=$SELECT($$CLINAIDS^RORHIVUT(RORIEN,ROREDT):1,1:0)
+50 IF CLINAIDS
if '$$PARAM^RORTSK01("PATIENTS","COMPLEX")
QUIT
SET CMPXCARE=1
+51 ;
+52 ;--- Skip a patient without utlilization
+53 if '$$UTIL^RORXU003(RORSDT,ROREDT,PATIEN,.UTLCHK)
QUIT
+54 ;
+55 ;--- Search for pharmacy data
+56 KILL RORXDST("ARV")
+57 SET TMP=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV",RORSDT,ROREDT1)
+58 IF TMP<0
SET ECNT=ECNT+1
QUIT
+59 IF $DATA(RORXDST("ARV"))
if '$$PARAM^RORTSK01("PATIENTS","COMPLEX")
QUIT
Begin DoDot:2
+60 SET IEN=0
+61 FOR
SET IEN=$ORDER(RORXDST("ARV",IEN))
if IEN'>0
QUIT
Begin DoDot:3
+62 if '$DATA(^TMP("RORX008",$JOB,"DRG",IEN))
Begin DoDot:4
+63 SET ^TMP("RORX008",$JOB,"DRG",IEN)=RORXDST("ARV",IEN)
End DoDot:4
+64 ;naked reference: ^TMP("RORX008",$J,"DRG",IEN,CLINAIDS)
SET ^(CLINAIDS)=$GET(^TMP("RORX008",$JOB,"DRG",IEN,CLINAIDS))+1
End DoDot:3
+65 SET CMPXCARE=1
SET CNTARV=CNTARV+1
End DoDot:2
+66 ;
+67 ;--- Skip Basic Care if it was not requested
+68 IF CMPXCARE
SET CNTCMPX=CNTCMPX+1
+69 IF '$TEST
if '$$PARAM^RORTSK01("PATIENTS","BASIC")
QUIT
SET CNTBASIC=CNTBASIC+1
+70 ;
+71 if $$PARAM^RORTSK01("OPTIONS","PTLIST")
Begin DoDot:2
+72 DO VADEM^RORUTL05(PATIEN,1)
+73 SET TMP=$$DATE^RORXU002(VADM(6)\1)
+74 SET TMP=TMP_U_($DATA(RORXDST("ARV"))>0)_U_CMPXCARE_U_CLINAIDS
+75 SET ^TMP("RORX008",$JOB,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_TMP
+76 SET $PIECE(^TMP("RORX008",$JOB,"PAT",PATIEN),U,6)=$SELECT($$PARAM^RORTSK01("PATIENTS","ICN"):$$ICN^RORUTL02(PATIEN),1:"")
+77 SET $PIECE(^TMP("RORX008",$JOB,"PAT",PATIEN),U,7)=$SELECT($$PARAM^RORTSK01("PATIENTS","PACT"):$$PACT^RORUTL02(PATIEN),1:"")
+78 SET $PIECE(^TMP("RORX008",$JOB,"PAT",PATIEN),U,8)=$SELECT($$PARAM^RORTSK01("PATIENTS","PCP"):$$PCP^RORUTL02(PATIEN),1:"")
+79 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
Begin DoDot:3
+80 SET AGE=$SELECT(AGETYPE="AGE":$PIECE(VADM(4),U),AGETYPE="DOB":$$DATE^RORXU002($PIECE(VADM(3),U)\1),1:"")
End DoDot:3
+81 SET $PIECE(^TMP("RORX008",$JOB,"PAT",PATIEN),U,9)=AGE
End DoDot:2
End DoDot:1
if RC<0
QUIT
+82 ;
+83 ;--- Totals
+84 SET ^TMP("RORX008",$JOB,"PAT")=CNTBASIC_U_CNTCMPX_U_CNTARV
+85 ;---
+86 QUIT $SELECT(RC<0:RC,1:ECNT)
+87 ;
+88 ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
RXSCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
+1 NEW CA,IEN,NAME
+2 SET IEN=+ROR8DST("RORXGEN")
SET NAME=$PIECE(ROR8DST("RORXGEN"),U,2)
+3 if (IEN'>0)!(NAME="")
QUIT 1
+4 ;---
+5 SET ROR8DST("ARV")=""
if ROR8DST("SINGLE")
QUIT 2
+6 ;---
+7 SET ROR8DST("ARV",IEN)=NAME
+8 QUIT 0
+9 ;
+10 ;***** STORES THE REPORT DATA
+11 ;
+12 ; REPORT IEN of the REPORT element
+13 ;
+14 ; Return Values:
+15 ; <0 Error code
+16 ; 0 Ok
+17 ; >0 Number of non-fatal errors
+18 ;
STORE(REPORT) ;
+1 NEW BUF,CNT,ITEM,IEN,NODE,NPAIDS,NPHIV,RC,TABLE,TMP
+2 SET NODE=$NAME(^TMP("RORX008",$JOB))
SET RC=0
+3 ;
+4 ;--- List of ARV drugs
+5 SET TMP=$$PARAM^RORTSK01("OPTIONS","REGMEDSMRY")
+6 IF TMP
IF $$PARAM^RORTSK01("PATIENTS","COMPLEX")
Begin DoDot:1
+7 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,REPORT)
+8 IF TABLE<0
SET RC=TABLE
QUIT
+9 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","DRUGS")
+10 SET IEN=0
+11 FOR
SET IEN=$ORDER(@NODE@("DRG",IEN))
if IEN'>0
QUIT
Begin DoDot:2
+12 SET BUF=@NODE@("DRG",IEN)
+13 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,TABLE)
+14 DO ADDVAL^RORTSK11(RORTSK,"NAME",$PIECE(@NODE@("DRG",IEN),U),ITEM,1)
+15 SET NPHIV=+$GET(@NODE@("DRG",IEN,0))
+16 SET NPAIDS=+$GET(@NODE@("DRG",IEN,1))
+17 DO ADDVAL^RORTSK11(RORTSK,"NP",NPHIV+NPAIDS,ITEM,3)
+18 DO ADDVAL^RORTSK11(RORTSK,"NPHIV",NPHIV,ITEM,3)
+19 DO ADDVAL^RORTSK11(RORTSK,"NPAIDS",NPAIDS,ITEM,3)
End DoDot:2
End DoDot:1
if RC<0
QUIT RC
+20 ;
+21 ;--- List of patients
+22 IF $$PARAM^RORTSK01("OPTIONS","PTLIST")
Begin DoDot:1
+23 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
+24 IF TABLE<0
SET RC=TABLE
QUIT
+25 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","PATIENTS")
+26 SET IEN=0
+27 FOR
SET IEN=$ORDER(@NODE@("PAT",IEN))
if IEN'>0
QUIT
Begin DoDot:2
+28 SET BUF=@NODE@("PAT",IEN)
SET $PIECE(BUF,U)="0000"
+29 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE,,IEN)
+30 DO ADDVAL^RORTSK11(RORTSK,"NAME",$PIECE(BUF,U,2),ITEM,1)
+31 DO ADDVAL^RORTSK11(RORTSK,"LAST4",$PIECE(BUF,U),ITEM,2)
+32 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
IF AGETYPE'="ALL"
Begin DoDot:3
+33 DO ADDVAL^RORTSK11(RORTSK,AGETYPE,$PIECE(BUF,U,9),ITEM,1)
End DoDot:3
+34 DO ADDVAL^RORTSK11(RORTSK,"DOD",$PIECE(BUF,U,3),ITEM,1)
+35 DO ADDVAL^RORTSK11(RORTSK,"AIDSTAT",+$PIECE(BUF,U,6),ITEM,1)
+36 DO ADDVAL^RORTSK11(RORTSK,"ARV",+$PIECE(BUF,U,4),ITEM,1)
+37 DO ADDVAL^RORTSK11(RORTSK,"COMPLEX",+$PIECE(BUF,U,5),ITEM,1)
+38 IF $$PARAM^RORTSK01("PATIENTS","ICN")
DO ADDVAL^RORTSK11(RORTSK,"ICN",$PIECE(BUF,U,6),ITEM,1)
+39 IF $$PARAM^RORTSK01("PATIENTS","PACT")
DO ADDVAL^RORTSK11(RORTSK,"PACT",$PIECE(BUF,U,7),ITEM,1)
+40 IF $$PARAM^RORTSK01("PATIENTS","PCP")
DO ADDVAL^RORTSK11(RORTSK,"PCP",$PIECE(BUF,U,8),ITEM,1)
End DoDot:2
End DoDot:1
if RC<0
QUIT RC
+41 ;
+42 ;--- Summary
+43 SET BUF=@NODE@("PAT")
+44 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,REPORT)
+45 DO ADDVAL^RORTSK11(RORTSK,"NP",$PIECE(BUF,U)+$PIECE(BUF,U,2),ITEM)
+46 DO ADDVAL^RORTSK11(RORTSK,"NPBASIC",+$PIECE(BUF,U,1),ITEM)
+47 DO ADDVAL^RORTSK11(RORTSK,"NPCOMPLEX",+$PIECE(BUF,U,2),ITEM)
+48 DO ADDVAL^RORTSK11(RORTSK,"NPARV",+$PIECE(BUF,U,3),ITEM)
+49 QUIT 0
