RORX009C ;HCIOFO/SG - PRESCRIPTION UTILIZ. (STORE) ;12/16/05 9:19am
;;1.5;CLINICAL CASE REGISTRIES;**21,31,39**;Feb 17, 2006;Build 4
;
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;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
;
;***** DRUGS
;
; SECTION IEN of the parent element
;
; SUBS
;
; NODE Closed root of the category section
; in the temporary global
;
; TBLNAME
;
; Return Values:
; <0 Error code
; 0 Ok
;
DRUGS(SECTION,SUBS,NODE,TBLNAME) ;
Q:$D(@NODE@(SUBS))<10 0
N IEN,ITEM,NAME,NRXNAME,NUM,RC,TMP
S TABLE=$$ADDVAL^RORTSK11(RORTSK,TBLNAME,,SECTION)
Q:TABLE<0 TABLE
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE",TBLNAME)
S NRXNAME=$E(SUBS,1,2)_"NRX"
;---
S NUM="",RC=0
F S NUM=$O(@NODE@(SUBS,"B",NUM),-1) Q:NUM="" D Q:RC
. S NAME=""
. F S NAME=$O(@NODE@(SUBS,"B",NUM,NAME)) Q:NAME="" D Q:RC
. . S IEN=""
. . F S IEN=$O(@NODE@(SUBS,"B",NUM,NAME,IEN)) Q:IEN="" D Q:RC
. . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,TABLE)
. . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
. . . S TMP=+$G(@NODE@(SUBS,IEN,"P"))
. . . D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
. . . D ADDVAL^RORTSK11(RORTSK,NRXNAME,NUM,ITEM,3)
. . . S TMP=$G(@NODE@(SUBS,IEN,"M"))
. . . D ADDVAL^RORTSK11(RORTSK,"MAXNRPP",+$P(TMP,U),ITEM,3)
. . . D ADDVAL^RORTSK11(RORTSK,"MAXNP",+$P(TMP,U,2),ITEM,3)
Q $S(RC<0:RC,1: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 RORSONLY ; Output summary only
;
N ECNT,NODE,RC,TMP
S RORSONLY=$$SMRYONLY^RORXU006(),(ECNT,RC)=0
S NODE=$NA(^TMP("RORX009",$J))
Q:$D(@NODE)<10 0
;--- Outpatient data
S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
S RC=$$STOREOP(REPORT,NODE)
I RC Q:RC<0 S ECNT=ECNT+1
;--- Inpatient data
S RC=$$LOOP^RORTSK01(.33) Q:RC<0 RC
S RC=$$STOREIP(REPORT,NODE)
I RC Q:RC<0 S ECNT=ECNT+1
;--- Highest utilization summary
S RC=$$LOOP^RORTSK01(.66) Q:RC<0 RC
S RC=$$STORESUM(REPORT,NODE)
I RC Q:RC<0 S ECNT=ECNT+1
;---
Q $S(RC<0:RC,1:ECNT)
;
;***** INPATIENT DATA
;
; PRNTELMT IEN of the parent element
;
; NODE Closed root of the category section
; in the temporary global
;
; Return Values:
; <0 Error code
; 0 Ok
;
STOREIP(PRNTELMT,NODE) ;
Q:$D(@NODE@("IP"))<10 0
N BUF,COUNT,DFN,ITEM,MAXUTNUM,NAME,NRX,RC,SECTION,TABLE,TMP,AGETYPE
S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
S SECTION=$$ADDVAL^RORTSK11(RORTSK,"INPATIENTS",,PRNTELMT)
Q:SECTION<0 SECTION
S RC=0
S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
;--- Number of doses
S TABLE=$$ADDVAL^RORTSK11(RORTSK,"DOSES",,SECTION)
Q:TABLE<0 TABLE
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","DOSES")
S NRX=""
F S NRX=$O(@NODE@("IPRX",NRX),-1) Q:NRX="" D
. S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
. D ADDVAL^RORTSK11(RORTSK,"NP",$P(@NODE@("IPRX",NRX),U),ITEM,3)
. D ADDVAL^RORTSK11(RORTSK,"IPNRX",NRX,ITEM,3)
;--- Drugs
S RC=$$DRUGS(SECTION,"IPD",NODE,"DRUGS_DOSES") Q:RC<0 RC
;--- Patients with highest utlization
I MAXUTNUM>0 D Q:RC<0 RC
. S TABLE=$$ADDVAL^RORTSK11(RORTSK,"HU_DOSES",,SECTION)
. I TABLE<0 S RC=TABLE Q
. D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","HU_DOSES")
. S NRX="",(COUNT,RC)=0
. F S NRX=$O(@NODE@("IPRX",NRX),-1) Q:NRX="" D Q:RC
. . S RC=$$LOOP^RORTSK01() Q:RC<0
. . S NAME=""
. . F S NAME=$O(@NODE@("IPRX",NRX,NAME)) Q:NAME="" D Q:RC
. . . S DFN=""
. . . F S DFN=$O(@NODE@("IPRX",NRX,NAME,DFN)) Q:DFN="" D Q:RC
. . . . S COUNT=COUNT+1 I COUNT>MAXUTNUM S RC=1 Q
. . . . S BUF=$G(@NODE@("IP",DFN)) S $P(BUF,U)="0000"
. . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
. . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
. . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(BUF,U),ITEM,2)
. . . . I AGETYPE'="ALL" 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,"IPNRX",NRX,ITEM,3)
. . . . D ADDVAL^RORTSK11(RORTSK,"ND",$P(BUF,U,5),ITEM,3)
. . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D
. . . . . D ADDVAL^RORTSK11(RORTSK,"ICN",$P(BUF,U,6),ITEM,1)
. . . . I $$PARAM^RORTSK01("PATIENTS","PACT") D
. . . . . D ADDVAL^RORTSK11(RORTSK,"PACT",$P(BUF,U,7),ITEM,1)
. . . . I $$PARAM^RORTSK01("PATIENTS","PCP") D
. . . . . D ADDVAL^RORTSK11(RORTSK,"PCP",$P(BUF,U,8),ITEM,1)
;--- Summary
D ADDVAL^RORTSK11(RORTSK,"NP",+$G(@NODE@("IP")),SECTION)
D ADDVAL^RORTSK11(RORTSK,"IPNRX",+$G(@NODE@("IPRX")),SECTION)
D ADDVAL^RORTSK11(RORTSK,"ND",+$G(@NODE@("IPD")),SECTION)
Q 0
;
;***** OUTPATIENT DATA
;
; PRNTELMT IEN of the parent element
;
; NODE Closed root of the category section
; in the temporary global
;
; Return Values:
; <0 Error code
; 0 Ok
;
STOREOP(PRNTELMT,NODE) ;
Q:$D(@NODE@("OP"))<10 0
N BUF,COUNT,DFN,ITEM,MAXUTNUM,NAME,NRX,RC,SECTION,TABLE,TMP,AGETYPE
S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
S SECTION=$$ADDVAL^RORTSK11(RORTSK,"OUTPATIENTS",,PRNTELMT)
Q:SECTION<0 SECTION
S RC=0
;--- Number of fills
S TABLE=$$ADDVAL^RORTSK11(RORTSK,"FILLS",,SECTION)
Q:TABLE<0 TABLE
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","FILLS")
S NRX=""
S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
F S NRX=$O(@NODE@("OPRX",NRX),-1) Q:NRX="" D
. S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
. D ADDVAL^RORTSK11(RORTSK,"NP",$P(@NODE@("OPRX",NRX),U),ITEM,3)
. D ADDVAL^RORTSK11(RORTSK,"OPNRX",NRX,ITEM,3)
;--- Drugs
S RC=$$DRUGS(SECTION,"OPD",NODE,"DRUGS_FILLS") Q:RC<0 RC
;--- Patients with highest utlization
I MAXUTNUM>0 D Q:RC<0 RC
. S TABLE=$$ADDVAL^RORTSK11(RORTSK,"HU_FILLS",,SECTION)
. I TABLE<0 S RC=TABLE Q
. D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","HU_FILLS")
. S NRX="",(COUNT,RC)=0
. F S NRX=$O(@NODE@("OPRX",NRX),-1) Q:NRX="" D Q:RC
. . S RC=$$LOOP^RORTSK01() Q:RC<0
. . S NAME=""
. . F S NAME=$O(@NODE@("OPRX",NRX,NAME)) Q:NAME="" D Q:RC
. . . S DFN=""
. . . F S DFN=$O(@NODE@("OPRX",NRX,NAME,DFN)) Q:DFN="" D Q:RC
. . . . S COUNT=COUNT+1 I COUNT>MAXUTNUM S RC=1 Q
. . . . S BUF=$G(@NODE@("OP",DFN)) S $P(BUF,U)="0000"
. . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
. . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
. . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(BUF,U),ITEM,2)
. . . . I AGETYPE'="ALL" 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,"OPNRX",NRX,ITEM,3)
. . . . D ADDVAL^RORTSK11(RORTSK,"ND",$P(BUF,U,5),ITEM,3)
. . . . I $$PARAM^RORTSK01("PATIENTS","ICN") D
. . . . . D ADDVAL^RORTSK11(RORTSK,"ICN",$P(BUF,U,6),ITEM,1)
. . . . I $$PARAM^RORTSK01("PATIENTS","PACT") D
. . . . . D ADDVAL^RORTSK11(RORTSK,"PACT",$P(BUF,U,7),ITEM,1)
. . . . I $$PARAM^RORTSK01("PATIENTS","PCP") D
. . . . . D ADDVAL^RORTSK11(RORTSK,"PCP",$P(BUF,U,8),ITEM,1)
;--- Summary
D ADDVAL^RORTSK11(RORTSK,"NP",+$G(@NODE@("OP")),SECTION)
D ADDVAL^RORTSK11(RORTSK,"OPNRX",+$G(@NODE@("OPRX")),SECTION)
D ADDVAL^RORTSK11(RORTSK,"ND",+$G(@NODE@("OPD")),SECTION)
Q 0
;
;***** SUMMARY DATA
;
; PRNTELMT IEN of the parent element
;
; NODE Closed root of the category section
; in the temporary global
;
; Return Values:
; <0 Error code
; 0 Ok
;
STORESUM(PRNTELMT,NODE) ;
N BUF,DFN,DOD,IPNRX,ITEM,LAST4,MAXUTNUM,NAME,NRX,OPNRX,RC,SECTION,TABLE,TMP,AGETYPE,PCP,PACT,ICN
S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
Q:($D(@NODE@("SUMRX"))<10)!(MAXUTNUM'>0) 0
;---
S SECTION=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,PRNTELMT)
Q:SECTION<0 SECTION
S RC=0
;--- Patients with highest utlization
S TABLE=$$ADDVAL^RORTSK11(RORTSK,"HU_NRX",,SECTION)
I TABLE<0 S RC=TABLE Q
D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","HU_NRX")
;---
S NRX="",RC=0
S AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
F S NRX=$O(@NODE@("SUMRX",NRX),-1) Q:NRX="" D Q:RC
. S RC=$$LOOP^RORTSK01() Q:RC<0
. S NAME=""
. F S NAME=$O(@NODE@("SUMRX",NRX,NAME)) Q:NAME="" D Q:RC
. . S DFN=""
. . F S DFN=$O(@NODE@("SUMRX",NRX,NAME,DFN)) Q:DFN="" D Q:RC
. . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
. . . S (IPNRX,OPNRX)=0
. . . S BUF=$G(@NODE@("OP",DFN)) S $P(BUF,U)="0000"
. . . S:BUF'="" LAST4=$P(BUF,U),DOD=$P(BUF,U,3),OPNRX=$P(BUF,U,4),ICN=$P(BUF,U,6),PACT=$P(BUF,U,7),PCP=$P(BUF,U,8),AGE=$P(BUF,U,9)
. . . S BUF=$G(@NODE@("IP",DFN))
. . . S:BUF'="" LAST4=$P(BUF,U),DOD=$P(BUF,U,3),IPNRX=$P(BUF,U,4),ICN=$P(BUF,U,6),PACT=$P(BUF,U,7),PCP=$P(BUF,U,8),AGE=$P(BUF,U,9)
. . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
. . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
. . . I AGETYPE'="ALL" D ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
. . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
. . . D ADDVAL^RORTSK11(RORTSK,"OPNRX",OPNRX,ITEM,3)
. . . D ADDVAL^RORTSK11(RORTSK,"IPNRX",IPNRX,ITEM,3)
. . . S TMP=+$G(@NODE@("SUMRX",NRX,NAME,DFN))
. . . D ADDVAL^RORTSK11(RORTSK,"ND",TMP,ITEM,3)
. . . I $$PARAM^RORTSK01("PATIENTS","ICN") D
. . . . D ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
. . . I $$PARAM^RORTSK01("PATIENTS","PACT") D
. . . . D ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
. . . I $$PARAM^RORTSK01("PATIENTS","PCP") D
. . . . D ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
;---
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORX009C 10259 printed Oct 16, 2024@17:45:24 Page 2
RORX009C ;HCIOFO/SG - PRESCRIPTION UTILIZ. (STORE) ;12/16/05 9:19am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**21,31,39**;Feb 17, 2006;Build 4
+2 ;
+3 ;******************************************************************************
+4 ; --- ROUTINE MODIFICATION LOG ---
+5 ;
+6 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+7 ;----------- ---------- ----------- ----------------------------------------
+8 ;ROR*1.5*21 SEP 2013 T KOPP Added ICN as last report column if
+9 ; additional identifier option selected
+10 ;ROR*1.5*31 MAY 2017 M FERRARESE Adding PACT, PCP, and AGE/DOB as additional
+11 ; identifiers.
+12 ;ROR*1.5*39 JUL 2021 M FERRARESE Setting SSN and LAST4 to zeros
+13 ;******************************************************************************
+14 ;
+15 QUIT
+16 ;
+17 ;***** DRUGS
+18 ;
+19 ; SECTION IEN of the parent element
+20 ;
+21 ; SUBS
+22 ;
+23 ; NODE Closed root of the category section
+24 ; in the temporary global
+25 ;
+26 ; TBLNAME
+27 ;
+28 ; Return Values:
+29 ; <0 Error code
+30 ; 0 Ok
+31 ;
DRUGS(SECTION,SUBS,NODE,TBLNAME) ;
+1 if $DATA(@NODE@(SUBS))<10
QUIT 0
+2 NEW IEN,ITEM,NAME,NRXNAME,NUM,RC,TMP
+3 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,TBLNAME,,SECTION)
+4 if TABLE<0
QUIT TABLE
+5 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE",TBLNAME)
+6 SET NRXNAME=$EXTRACT(SUBS,1,2)_"NRX"
+7 ;---
+8 SET NUM=""
SET RC=0
+9 FOR
SET NUM=$ORDER(@NODE@(SUBS,"B",NUM),-1)
if NUM=""
QUIT
Begin DoDot:1
+10 SET NAME=""
+11 FOR
SET NAME=$ORDER(@NODE@(SUBS,"B",NUM,NAME))
if NAME=""
QUIT
Begin DoDot:2
+12 SET IEN=""
+13 FOR
SET IEN=$ORDER(@NODE@(SUBS,"B",NUM,NAME,IEN))
if IEN=""
QUIT
Begin DoDot:3
+14 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,TABLE)
+15 DO ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
+16 SET TMP=+$GET(@NODE@(SUBS,IEN,"P"))
+17 DO ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
+18 DO ADDVAL^RORTSK11(RORTSK,NRXNAME,NUM,ITEM,3)
+19 SET TMP=$GET(@NODE@(SUBS,IEN,"M"))
+20 DO ADDVAL^RORTSK11(RORTSK,"MAXNRPP",+$PIECE(TMP,U),ITEM,3)
+21 DO ADDVAL^RORTSK11(RORTSK,"MAXNP",+$PIECE(TMP,U,2),ITEM,3)
End DoDot:3
if RC
QUIT
End DoDot:2
if RC
QUIT
End DoDot:1
if RC
QUIT
+22 QUIT $SELECT(RC<0:RC,1:0)
+23 ;
+24 ;***** STORES THE REPORT DATA
+25 ;
+26 ; REPORT IEN of the REPORT element
+27 ;
+28 ; Return Values:
+29 ; <0 Error code
+30 ; 0 Ok
+31 ; >0 Number of non-fatal errors
+32 ;
STORE(REPORT) ;
+1 ; Output summary only
NEW RORSONLY
+2 ;
+3 NEW ECNT,NODE,RC,TMP
+4 SET RORSONLY=$$SMRYONLY^RORXU006()
SET (ECNT,RC)=0
+5 SET NODE=$NAME(^TMP("RORX009",$JOB))
+6 if $DATA(@NODE)<10
QUIT 0
+7 ;--- Outpatient data
+8 SET RC=$$LOOP^RORTSK01(0)
if RC<0
QUIT RC
+9 SET RC=$$STOREOP(REPORT,NODE)
+10 IF RC
if RC<0
QUIT
SET ECNT=ECNT+1
+11 ;--- Inpatient data
+12 SET RC=$$LOOP^RORTSK01(.33)
if RC<0
QUIT RC
+13 SET RC=$$STOREIP(REPORT,NODE)
+14 IF RC
if RC<0
QUIT
SET ECNT=ECNT+1
+15 ;--- Highest utilization summary
+16 SET RC=$$LOOP^RORTSK01(.66)
if RC<0
QUIT RC
+17 SET RC=$$STORESUM(REPORT,NODE)
+18 IF RC
if RC<0
QUIT
SET ECNT=ECNT+1
+19 ;---
+20 QUIT $SELECT(RC<0:RC,1:ECNT)
+21 ;
+22 ;***** INPATIENT DATA
+23 ;
+24 ; PRNTELMT IEN of the parent element
+25 ;
+26 ; NODE Closed root of the category section
+27 ; in the temporary global
+28 ;
+29 ; Return Values:
+30 ; <0 Error code
+31 ; 0 Ok
+32 ;
STOREIP(PRNTELMT,NODE) ;
+1 if $DATA(@NODE@("IP"))<10
QUIT 0
+2 NEW BUF,COUNT,DFN,ITEM,MAXUTNUM,NAME,NRX,RC,SECTION,TABLE,TMP,AGETYPE
+3 SET MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
+4 SET SECTION=$$ADDVAL^RORTSK11(RORTSK,"INPATIENTS",,PRNTELMT)
+5 if SECTION<0
QUIT SECTION
+6 SET RC=0
+7 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
+8 ;--- Number of doses
+9 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"DOSES",,SECTION)
+10 if TABLE<0
QUIT TABLE
+11 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","DOSES")
+12 SET NRX=""
+13 FOR
SET NRX=$ORDER(@NODE@("IPRX",NRX),-1)
if NRX=""
QUIT
Begin DoDot:1
+14 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
+15 DO ADDVAL^RORTSK11(RORTSK,"NP",$PIECE(@NODE@("IPRX",NRX),U),ITEM,3)
+16 DO ADDVAL^RORTSK11(RORTSK,"IPNRX",NRX,ITEM,3)
End DoDot:1
+17 ;--- Drugs
+18 SET RC=$$DRUGS(SECTION,"IPD",NODE,"DRUGS_DOSES")
if RC<0
QUIT RC
+19 ;--- Patients with highest utlization
+20 IF MAXUTNUM>0
Begin DoDot:1
+21 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"HU_DOSES",,SECTION)
+22 IF TABLE<0
SET RC=TABLE
QUIT
+23 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","HU_DOSES")
+24 SET NRX=""
SET (COUNT,RC)=0
+25 FOR
SET NRX=$ORDER(@NODE@("IPRX",NRX),-1)
if NRX=""
QUIT
Begin DoDot:2
+26 SET RC=$$LOOP^RORTSK01()
if RC<0
QUIT
+27 SET NAME=""
+28 FOR
SET NAME=$ORDER(@NODE@("IPRX",NRX,NAME))
if NAME=""
QUIT
Begin DoDot:3
+29 SET DFN=""
+30 FOR
SET DFN=$ORDER(@NODE@("IPRX",NRX,NAME,DFN))
if DFN=""
QUIT
Begin DoDot:4
+31 SET COUNT=COUNT+1
IF COUNT>MAXUTNUM
SET RC=1
QUIT
+32 SET BUF=$GET(@NODE@("IP",DFN))
SET $PIECE(BUF,U)="0000"
+33 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
+34 DO ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
+35 DO ADDVAL^RORTSK11(RORTSK,"LAST4",$PIECE(BUF,U),ITEM,2)
+36 IF AGETYPE'="ALL"
DO ADDVAL^RORTSK11(RORTSK,AGETYPE,$PIECE(BUF,U,9),ITEM,1)
+37 DO ADDVAL^RORTSK11(RORTSK,"DOD",$PIECE(BUF,U,3),ITEM,1)
+38 DO ADDVAL^RORTSK11(RORTSK,"IPNRX",NRX,ITEM,3)
+39 DO ADDVAL^RORTSK11(RORTSK,"ND",$PIECE(BUF,U,5),ITEM,3)
+40 IF $$PARAM^RORTSK01("PATIENTS","ICN")
Begin DoDot:5
+41 DO ADDVAL^RORTSK11(RORTSK,"ICN",$PIECE(BUF,U,6),ITEM,1)
End DoDot:5
+42 IF $$PARAM^RORTSK01("PATIENTS","PACT")
Begin DoDot:5
+43 DO ADDVAL^RORTSK11(RORTSK,"PACT",$PIECE(BUF,U,7),ITEM,1)
End DoDot:5
+44 IF $$PARAM^RORTSK01("PATIENTS","PCP")
Begin DoDot:5
+45 DO ADDVAL^RORTSK11(RORTSK,"PCP",$PIECE(BUF,U,8),ITEM,1)
End DoDot:5
End DoDot:4
if RC
QUIT
End DoDot:3
if RC
QUIT
End DoDot:2
if RC
QUIT
End DoDot:1
if RC<0
QUIT RC
+46 ;--- Summary
+47 DO ADDVAL^RORTSK11(RORTSK,"NP",+$GET(@NODE@("IP")),SECTION)
+48 DO ADDVAL^RORTSK11(RORTSK,"IPNRX",+$GET(@NODE@("IPRX")),SECTION)
+49 DO ADDVAL^RORTSK11(RORTSK,"ND",+$GET(@NODE@("IPD")),SECTION)
+50 QUIT 0
+51 ;
+52 ;***** OUTPATIENT DATA
+53 ;
+54 ; PRNTELMT IEN of the parent element
+55 ;
+56 ; NODE Closed root of the category section
+57 ; in the temporary global
+58 ;
+59 ; Return Values:
+60 ; <0 Error code
+61 ; 0 Ok
+62 ;
STOREOP(PRNTELMT,NODE) ;
+1 if $DATA(@NODE@("OP"))<10
QUIT 0
+2 NEW BUF,COUNT,DFN,ITEM,MAXUTNUM,NAME,NRX,RC,SECTION,TABLE,TMP,AGETYPE
+3 SET MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
+4 SET SECTION=$$ADDVAL^RORTSK11(RORTSK,"OUTPATIENTS",,PRNTELMT)
+5 if SECTION<0
QUIT SECTION
+6 SET RC=0
+7 ;--- Number of fills
+8 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"FILLS",,SECTION)
+9 if TABLE<0
QUIT TABLE
+10 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","FILLS")
+11 SET NRX=""
+12 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
+13 FOR
SET NRX=$ORDER(@NODE@("OPRX",NRX),-1)
if NRX=""
QUIT
Begin DoDot:1
+14 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
+15 DO ADDVAL^RORTSK11(RORTSK,"NP",$PIECE(@NODE@("OPRX",NRX),U),ITEM,3)
+16 DO ADDVAL^RORTSK11(RORTSK,"OPNRX",NRX,ITEM,3)
End DoDot:1
+17 ;--- Drugs
+18 SET RC=$$DRUGS(SECTION,"OPD",NODE,"DRUGS_FILLS")
if RC<0
QUIT RC
+19 ;--- Patients with highest utlization
+20 IF MAXUTNUM>0
Begin DoDot:1
+21 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"HU_FILLS",,SECTION)
+22 IF TABLE<0
SET RC=TABLE
QUIT
+23 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","HU_FILLS")
+24 SET NRX=""
SET (COUNT,RC)=0
+25 FOR
SET NRX=$ORDER(@NODE@("OPRX",NRX),-1)
if NRX=""
QUIT
Begin DoDot:2
+26 SET RC=$$LOOP^RORTSK01()
if RC<0
QUIT
+27 SET NAME=""
+28 FOR
SET NAME=$ORDER(@NODE@("OPRX",NRX,NAME))
if NAME=""
QUIT
Begin DoDot:3
+29 SET DFN=""
+30 FOR
SET DFN=$ORDER(@NODE@("OPRX",NRX,NAME,DFN))
if DFN=""
QUIT
Begin DoDot:4
+31 SET COUNT=COUNT+1
IF COUNT>MAXUTNUM
SET RC=1
QUIT
+32 SET BUF=$GET(@NODE@("OP",DFN))
SET $PIECE(BUF,U)="0000"
+33 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
+34 DO ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
+35 DO ADDVAL^RORTSK11(RORTSK,"LAST4",$PIECE(BUF,U),ITEM,2)
+36 IF AGETYPE'="ALL"
DO ADDVAL^RORTSK11(RORTSK,AGETYPE,$PIECE(BUF,U,9),ITEM,1)
+37 DO ADDVAL^RORTSK11(RORTSK,"DOD",$PIECE(BUF,U,3),ITEM,1)
+38 DO ADDVAL^RORTSK11(RORTSK,"OPNRX",NRX,ITEM,3)
+39 DO ADDVAL^RORTSK11(RORTSK,"ND",$PIECE(BUF,U,5),ITEM,3)
+40 IF $$PARAM^RORTSK01("PATIENTS","ICN")
Begin DoDot:5
+41 DO ADDVAL^RORTSK11(RORTSK,"ICN",$PIECE(BUF,U,6),ITEM,1)
End DoDot:5
+42 IF $$PARAM^RORTSK01("PATIENTS","PACT")
Begin DoDot:5
+43 DO ADDVAL^RORTSK11(RORTSK,"PACT",$PIECE(BUF,U,7),ITEM,1)
End DoDot:5
+44 IF $$PARAM^RORTSK01("PATIENTS","PCP")
Begin DoDot:5
+45 DO ADDVAL^RORTSK11(RORTSK,"PCP",$PIECE(BUF,U,8),ITEM,1)
End DoDot:5
End DoDot:4
if RC
QUIT
End DoDot:3
if RC
QUIT
End DoDot:2
if RC
QUIT
End DoDot:1
if RC<0
QUIT RC
+46 ;--- Summary
+47 DO ADDVAL^RORTSK11(RORTSK,"NP",+$GET(@NODE@("OP")),SECTION)
+48 DO ADDVAL^RORTSK11(RORTSK,"OPNRX",+$GET(@NODE@("OPRX")),SECTION)
+49 DO ADDVAL^RORTSK11(RORTSK,"ND",+$GET(@NODE@("OPD")),SECTION)
+50 QUIT 0
+51 ;
+52 ;***** SUMMARY DATA
+53 ;
+54 ; PRNTELMT IEN of the parent element
+55 ;
+56 ; NODE Closed root of the category section
+57 ; in the temporary global
+58 ;
+59 ; Return Values:
+60 ; <0 Error code
+61 ; 0 Ok
+62 ;
STORESUM(PRNTELMT,NODE) ;
+1 NEW BUF,DFN,DOD,IPNRX,ITEM,LAST4,MAXUTNUM,NAME,NRX,OPNRX,RC,SECTION,TABLE,TMP,AGETYPE,PCP,PACT,ICN
+2 SET MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
+3 if ($DATA(@NODE@("SUMRX"))<10)!(MAXUTNUM'>0)
QUIT 0
+4 ;---
+5 SET SECTION=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,PRNTELMT)
+6 if SECTION<0
QUIT SECTION
+7 SET RC=0
+8 ;--- Patients with highest utlization
+9 SET TABLE=$$ADDVAL^RORTSK11(RORTSK,"HU_NRX",,SECTION)
+10 IF TABLE<0
SET RC=TABLE
QUIT
+11 DO ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","HU_NRX")
+12 ;---
+13 SET NRX=""
SET RC=0
+14 SET AGETYPE=$$PARAM^RORTSK01("AGE_RANGE","TYPE")
+15 FOR
SET NRX=$ORDER(@NODE@("SUMRX",NRX),-1)
if NRX=""
QUIT
Begin DoDot:1
+16 SET RC=$$LOOP^RORTSK01()
if RC<0
QUIT
+17 SET NAME=""
+18 FOR
SET NAME=$ORDER(@NODE@("SUMRX",NRX,NAME))
if NAME=""
QUIT
Begin DoDot:2
+19 SET DFN=""
+20 FOR
SET DFN=$ORDER(@NODE@("SUMRX",NRX,NAME,DFN))
if DFN=""
QUIT
Begin DoDot:3
+21 SET ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
+22 SET (IPNRX,OPNRX)=0
+23 SET BUF=$GET(@NODE@("OP",DFN))
SET $PIECE(BUF,U)="0000"
+24 if BUF'=""
SET LAST4=$PIECE(BUF,U)
SET DOD=$PIECE(BUF,U,3)
SET OPNRX=$PIECE(BUF,U,4)
SET ICN=$PIECE(BUF,U,6)
SET PACT=$PIECE(BUF,U,7)
SET PCP=$PIECE(BUF,U,8)
SET AGE=$PIECE(BUF,U,9)
+25 SET BUF=$GET(@NODE@("IP",DFN))
+26 if BUF'=""
SET LAST4=$PIECE(BUF,U)
SET DOD=$PIECE(BUF,U,3)
SET IPNRX=$PIECE(BUF,U,4)
SET ICN=$PIECE(BUF,U,6)
SET PACT=$PIECE(BUF,U,7)
SET PCP=$PIECE(BUF,U,8)
SET AGE=$PIECE(BUF,U,9)
+27 DO ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
+28 DO ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
+29 IF AGETYPE'="ALL"
DO ADDVAL^RORTSK11(RORTSK,AGETYPE,AGE,ITEM,1)
+30 DO ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
+31 DO ADDVAL^RORTSK11(RORTSK,"OPNRX",OPNRX,ITEM,3)
+32 DO ADDVAL^RORTSK11(RORTSK,"IPNRX",IPNRX,ITEM,3)
+33 SET TMP=+$GET(@NODE@("SUMRX",NRX,NAME,DFN))
+34 DO ADDVAL^RORTSK11(RORTSK,"ND",TMP,ITEM,3)
+35 IF $$PARAM^RORTSK01("PATIENTS","ICN")
Begin DoDot:4
+36 DO ADDVAL^RORTSK11(RORTSK,"ICN",ICN,ITEM,1)
End DoDot:4
+37 IF $$PARAM^RORTSK01("PATIENTS","PACT")
Begin DoDot:4
+38 DO ADDVAL^RORTSK11(RORTSK,"PACT",PACT,ITEM,1)
End DoDot:4
+39 IF $$PARAM^RORTSK01("PATIENTS","PCP")
Begin DoDot:4
+40 DO ADDVAL^RORTSK11(RORTSK,"PCP",PCP,ITEM,1)
End DoDot:4
End DoDot:3
if RC
QUIT
End DoDot:2
if RC
QUIT
End DoDot:1
if RC
QUIT
+41 ;---
+42 QUIT 0
