PXRRFDSD ;ISL/PKR - Go through the encounters attaching a diagnosis and then sort based on the diagnosis. ;06/08/98
;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,31,54**;Aug 12, 1996
SORT ;
N BUSY,COUNT,DIAGTOT,DCIEN,ENCTOT,ICD9IEN,INFOTYPE,FACILITY,HLOC
N POV,POVIEN,PNAME,PRIMARY,STOIND,VACODE,VIEN
;
;The ^XTMP array created in PXRRFDSE can have four possible structures.
;If the encounters were sorted by location then the structure will be:
; ^XTMP(PXRRXTMP,FACILITY,1,1,HLOC,VIEN).
;If the encounters were sorted by person class then the structure will be:
; ^XTMP(PXRRXTMP,FACILITY,1,VACODE,1,VIEN).
;If the encounters were sorted by provider then the structure will be:
; ^XTMP(PXRRXTMP,FACILITY,PNAME,1,1,VIEN).
;If none of the above screens were used then the structure will be:
; ^XTMP(PXRRXTMP,FACILITY,1,1,1,VIEN).
;
I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)
;
;Allow the task to be cleaned up on successful completion.
S ZTREQ="@"
;
I $P(PXRRFDDC,U,1)="P" S PRIMARY=1
E S PRIMARY=0
;
S DIAGTOT=0
;Initialize the storage index.
S STOIND=0
;
S FACILITY=""
FAC S FACILITY=$O(^XTMP(PXRRXTMP,"ENCTR",FACILITY))
I FACILITY="" G SETPR
S STOIND=STOIND+1
S ^XTMP(PXRRXTMP,"INFO","FACILITY",FACILITY,FACILITY)=STOIND
;
S PNAME=""
PRV S PNAME=$O(^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME))
I PNAME="" G FAC
;Start INFOTYPE with "G" so it always comes after FACILITY.
S INFOTYPE="G"
I ($L(PNAME)>1)&(+PNAME=0)&(INFOTYPE'["PRV") D
. S INFOTYPE=INFOTYPE_"PRV"
;
;Check for a user request to stop the task.
I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRFDD
;
S VACODE=""
PCLASS S VACODE=$O(^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,VACODE))
I VACODE="" G PRV
I ($L(VACODE)>1)&(+VACODE=0)&(INFOTYPE'["PC") D
. S INFOTYPE=INFOTYPE_"PC"
;
S HLOC=""
LOC S HLOC=$O(^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,VACODE,HLOC))
I HLOC="" G PCLASS
;The location is stored in the form NAME_U_STOP CODE
I ($L(HLOC)>1)&(+$P(HLOC,U,2)>0)&(INFOTYPE'["LOC") D
. S INFOTYPE=INFOTYPE_"LOC"
;
S STOIND=STOIND+1
S ^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PNAME,VACODE,HLOC)=STOIND
;
S VIEN=""
ENC S VIEN=$O(^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,VACODE,HLOC,VIEN))
I (VIEN="")!(VIEN=0) G LOC
;Count the encounters
I '$D(ENCTOT(STOIND)) S ENCTOT(STOIND)=1
E S ENCTOT(STOIND)=ENCTOT(STOIND)+1
;
;If this is an interactive session let the user know that something
;is happening.
I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting diagnoses",.BUSY)
;
;Initialzide the diagnosis counter.
I '$D(DIAGTOT(STOIND)) S DIAGTOT(STOIND)=0
;
;Get the diagnoses associated with this VIEN.
S POVIEN=""
DIAG S POVIEN=$O(^AUPNVPOV("AD",VIEN,POVIEN))
I POVIEN="" G ENC
S POV=^AUPNVPOV(POVIEN,0)
;
;Apply the primary/secondary screen. If this field does not contain P
;then we take it to be secondary.
I PRIMARY I $P(POV,U,12)'="P" G DIAG
;
;Count the ICD9 entries.
S ICD9IEN=$P(POV,U,1)
I '$D(^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD9",ICD9IEN)) S ^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD9",ICD9IEN)=1
E S ^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD9",ICD9IEN)=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD9",ICD9IEN)+1
S DIAGTOT(STOIND)=DIAGTOT(STOIND)+1
;
;Count the diagnostic categories.
;This will probably require a DBIA.
S DCIEN=$P(^ICD9(ICD9IEN,0),U,5)
I DCIEN'>0 S DCIEN=0
I '$D(^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN)) S ^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN)=1
E S ^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN)=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN)+1
;
G DIAG
;
SETPR ;Rearrange the information for printing.
S STOIND=""
NEXTSTO S STOIND=$O(^TMP(PXRRXTMP,$J,"DIAG",STOIND))
I STOIND="" G EXIT
I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting diagnoses",.BUSY)
;
S ICD9IEN=""
NEXTIC S ICD9IEN=$O(^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD9",ICD9IEN))
I ICD9IEN="" G STDC
S COUNT=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD9",ICD9IEN)
S DIAGTOT=DIAGTOT+COUNT
S ^XTMP(PXRRXTMP,"PRINT",STOIND,"ICD9",COUNT,ICD9IEN)="DIAG"_ICD9IEN
G NEXTIC
;
;
STDC S DCIEN=""
NEXTDC S DCIEN=$O(^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN))
I DCIEN="" G NEXTSTO
S COUNT=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN)
S ^XTMP(PXRRXTMP,"PRINT",STOIND,"DC",COUNT,DCIEN)=""
G NEXTDC
;
EXIT ;
;Kill the arrays we are done with.
K ^TMP(PXRRXTMP,$J,"DIAG")
K ^XTMP(PXRRXTMP,"ENCTR")
;
S STOIND=""
F S STOIND=$O(ENCTOT(STOIND)) Q:STOIND="" D
. S ^XTMP(PXRRXTMP,"TOTALS","DIAGTOT",STOIND)=DIAGTOT(STOIND)
. S ^XTMP(PXRRXTMP,"TOTALS","ENCTOT",STOIND)=ENCTOT(STOIND)
;
I '(PXRRQUE!$D(IO("S"))) D DONE^PXRRBUSY("done")
;
;Print the report.
I PXRRQUE D
. N DESC,ROUTINE,TASK
. S DESC="Frequency of diagnosis report - print"
. S ROUTINE="PXRRFDP"
. S TASK=^XTMP(PXRRXTMP,"PRZTSK")
. S ZTDTH=$$NOW^XLFDT
. D REQUE^PXRRQUE(DESC,ROUTINE,TASK)
E D ^PXRRFDP
;
Q
PXRRFDSD ;ISL/PKR - Go through the encounters attaching a diagnosis and then sort based on the diagnosis. ;06/08/98
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,31,54**;Aug 12, 1996
SORT ;
+1 NEW BUSY,COUNT,DIAGTOT,DCIEN,ENCTOT,ICD9IEN,INFOTYPE,FACILITY,HLOC
+2 NEW POV,POVIEN,PNAME,PRIMARY,STOIND,VACODE,VIEN
+3 ;
+4 ;The ^XTMP array created in PXRRFDSE can have four possible structures.
+5 ;If the encounters were sorted by location then the structure will be:
+6 ; ^XTMP(PXRRXTMP,FACILITY,1,1,HLOC,VIEN).
+7 ;If the encounters were sorted by person class then the structure will be:
+8 ; ^XTMP(PXRRXTMP,FACILITY,1,VACODE,1,VIEN).
+9 ;If the encounters were sorted by provider then the structure will be:
+10 ; ^XTMP(PXRRXTMP,FACILITY,PNAME,1,1,VIEN).
+11 ;If none of the above screens were used then the structure will be:
+12 ; ^XTMP(PXRRXTMP,FACILITY,1,1,1,VIEN).
+13 ;
+14 IF '(PXRRQUE!$DATA(IO("S")))
DO INIT^PXRRBUSY(.BUSY)
+15 ;
+16 ;Allow the task to be cleaned up on successful completion.
+17 SET ZTREQ="@"
+18 ;
+19 IF $PIECE(PXRRFDDC,U,1)="P"
SET PRIMARY=1
+20 IF '$TEST
SET PRIMARY=0
+21 ;
+22 SET DIAGTOT=0
+23 ;Initialize the storage index.
+24 SET STOIND=0
+25 ;
+26 SET FACILITY=""
FAC SET FACILITY=$ORDER(^XTMP(PXRRXTMP,"ENCTR",FACILITY))
+1 IF FACILITY=""
GOTO SETPR
+2 SET STOIND=STOIND+1
+3 SET ^XTMP(PXRRXTMP,"INFO","FACILITY",FACILITY,FACILITY)=STOIND
+4 ;
+5 SET PNAME=""
PRV SET PNAME=$ORDER(^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME))
+1 IF PNAME=""
GOTO FAC
+2 ;Start INFOTYPE with "G" so it always comes after FACILITY.
+3 SET INFOTYPE="G"
+4 IF ($LENGTH(PNAME)>1)&(+PNAME=0)&(INFOTYPE'["PRV")
Begin DoDot:1
+5 SET INFOTYPE=INFOTYPE_"PRV"
End DoDot:1
+6 ;
+7 ;Check for a user request to stop the task.
+8 IF $$S^%ZTLOAD
SET ZTSTOP=1
DO EXIT^PXRRFDD
+9 ;
+10 SET VACODE=""
PCLASS SET VACODE=$ORDER(^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,VACODE))
+1 IF VACODE=""
GOTO PRV
+2 IF ($LENGTH(VACODE)>1)&(+VACODE=0)&(INFOTYPE'["PC")
Begin DoDot:1
+3 SET INFOTYPE=INFOTYPE_"PC"
End DoDot:1
+4 ;
+5 SET HLOC=""
LOC SET HLOC=$ORDER(^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,VACODE,HLOC))
+1 IF HLOC=""
GOTO PCLASS
+2 ;The location is stored in the form NAME_U_STOP CODE
+3 IF ($LENGTH(HLOC)>1)&(+$PIECE(HLOC,U,2)>0)&(INFOTYPE'["LOC")
Begin DoDot:1
+4 SET INFOTYPE=INFOTYPE_"LOC"
End DoDot:1
+5 ;
+6 SET STOIND=STOIND+1
+7 SET ^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PNAME,VACODE,HLOC)=STOIND
+8 ;
+9 SET VIEN=""
ENC SET VIEN=$ORDER(^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,VACODE,HLOC,VIEN))
+1 IF (VIEN="")!(VIEN=0)
GOTO LOC
+2 ;Count the encounters
+3 IF '$DATA(ENCTOT(STOIND))
SET ENCTOT(STOIND)=1
+4 IF '$TEST
SET ENCTOT(STOIND)=ENCTOT(STOIND)+1
+5 ;
+6 ;If this is an interactive session let the user know that something
+7 ;is happening.
+8 IF '(PXRRQUE!$DATA(IO("S")))
DO SPIN^PXRRBUSY("Sorting diagnoses",.BUSY)
+9 ;
+10 ;Initialzide the diagnosis counter.
+11 IF '$DATA(DIAGTOT(STOIND))
SET DIAGTOT(STOIND)=0
+12 ;
+13 ;Get the diagnoses associated with this VIEN.
+14 SET POVIEN=""
DIAG SET POVIEN=$ORDER(^AUPNVPOV("AD",VIEN,POVIEN))
+1 IF POVIEN=""
GOTO ENC
+2 SET POV=^AUPNVPOV(POVIEN,0)
+3 ;
+4 ;Apply the primary/secondary screen. If this field does not contain P
+5 ;then we take it to be secondary.
+6 IF PRIMARY
IF $PIECE(POV,U,12)'="P"
GOTO DIAG
+7 ;
+8 ;Count the ICD9 entries.
+9 SET ICD9IEN=$PIECE(POV,U,1)
+10 IF '$DATA(^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD9",ICD9IEN))
SET ^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD9",ICD9IEN)=1
+11 IF '$TEST
SET ^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD9",ICD9IEN)=^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD9",ICD9IEN)+1
+12 SET DIAGTOT(STOIND)=DIAGTOT(STOIND)+1
+13 ;
+14 ;Count the diagnostic categories.
+15 ;This will probably require a DBIA.
+16 SET DCIEN=$PIECE(^ICD9(ICD9IEN,0),U,5)
+17 IF DCIEN'>0
SET DCIEN=0
+18 IF '$DATA(^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC",DCIEN))
SET ^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC",DCIEN)=1
+19 IF '$TEST
SET ^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC",DCIEN)=^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC",DCIEN)+1
+20 ;
+21 GOTO DIAG
+22 ;
SETPR ;Rearrange the information for printing.
+1 SET STOIND=""
NEXTSTO SET STOIND=$ORDER(^TMP(PXRRXTMP,$JOB,"DIAG",STOIND))
+1 IF STOIND=""
GOTO EXIT
+2 IF '(PXRRQUE!$DATA(IO("S")))
DO SPIN^PXRRBUSY("Sorting diagnoses",.BUSY)
+3 ;
+4 SET ICD9IEN=""
NEXTIC SET ICD9IEN=$ORDER(^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD9",ICD9IEN))
+1 IF ICD9IEN=""
GOTO STDC
+2 SET COUNT=^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD9",ICD9IEN)
+3 SET DIAGTOT=DIAGTOT+COUNT
+4 SET ^XTMP(PXRRXTMP,"PRINT",STOIND,"ICD9",COUNT,ICD9IEN)="DIAG"_ICD9IEN
+5 GOTO NEXTIC
+6 ;
+7 ;
STDC SET DCIEN=""
NEXTDC SET DCIEN=$ORDER(^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC",DCIEN))
+1 IF DCIEN=""
GOTO NEXTSTO
+2 SET COUNT=^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC",DCIEN)
+3 SET ^XTMP(PXRRXTMP,"PRINT",STOIND,"DC",COUNT,DCIEN)=""
+4 GOTO NEXTDC
+5 ;
EXIT ;
+1 ;Kill the arrays we are done with.
+2 KILL ^TMP(PXRRXTMP,$JOB,"DIAG")
+3 KILL ^XTMP(PXRRXTMP,"ENCTR")
+4 ;
+5 SET STOIND=""
+6 FOR
SET STOIND=$ORDER(ENCTOT(STOIND))
IF STOIND=""
QUIT
Begin DoDot:1
+7 SET ^XTMP(PXRRXTMP,"TOTALS","DIAGTOT",STOIND)=DIAGTOT(STOIND)
+8 SET ^XTMP(PXRRXTMP,"TOTALS","ENCTOT",STOIND)=ENCTOT(STOIND)
End DoDot:1
+9 ;
+10 IF '(PXRRQUE!$DATA(IO("S")))
DO DONE^PXRRBUSY("done")
+11 ;
+12 ;Print the report.
+13 IF PXRRQUE
Begin DoDot:1
+14 NEW DESC,ROUTINE,TASK
+15 SET DESC="Frequency of diagnosis report - print"
+16 SET ROUTINE="PXRRFDP"
+17 SET TASK=^XTMP(PXRRXTMP,"PRZTSK")
+18 SET ZTDTH=$$NOW^XLFDT
+19 DO REQUE^PXRRQUE(DESC,ROUTINE,TASK)
End DoDot:1
+20 IF '$TEST
DO ^PXRRFDP
+21 ;
+22 QUIT
