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,121,199**;Aug 12, 1996;Build 51
SORT ;
N BUSY,COUNT,DCIEN,DGTOT10,DIAGTOT,ENCTOT,FACILITY,HLOC,ICD9IEN,ICDDATA
N ICDTYP,INFOTYPE,PNAME,POV,POVIEN,PRIMARY,PXDXDATE,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,DGTOT10=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)
;
;Initialize the diagnosis counters.
I '$D(DIAGTOT(STOIND)) S DIAGTOT(STOIND)=0
I '$D(DGTOT10(STOIND)) S DGTOT10(STOIND)=0 ; keep track of ICD10s also
;
;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)
S PXDXDATE=$$CSDATE^PXDXUTL(VIEN)
S ICDDATA=$$ICDDATA^ICDXCODE("DIAG",ICD9IEN,PXDXDATE,"I"),ICDTYP=$P(ICDDATA,U,20)
I ICDTYP="30" G DIAG2
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
G DIAG3
DIAG2 I '$D(^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD10",ICD9IEN)) S ^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD10",ICD9IEN)=1
E S ^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD10",ICD9IEN)=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD10",ICD9IEN)+1
S DGTOT10(STOIND)=DGTOT10(STOIND)+1
DIAG3 ;
;Count the diagnostic categories.
;This will probably require a DBIA.
;S DCIEN=$P(^ICD9(ICD9IEN,0),U,5)
S DCIEN=$P(ICDDATA,U,6)
I DCIEN'>0 S DCIEN=0
G:ICDTYP="30" DIAG4
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
DIAG4 I '$D(^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC10",DCIEN)) S ^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC10",DCIEN)=1
E S ^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC10",DCIEN)=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC10",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 NXTIC10
S COUNT=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN)
S ^XTMP(PXRRXTMP,"PRINT",STOIND,"DC",COUNT,DCIEN)=""
G NEXTDC
;
NXTIC10 S ICD9IEN=""
NEXTIC10 ;
S ICD9IEN=$O(^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD10",ICD9IEN))
I ICD9IEN="" G STDC10
S COUNT=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD10",ICD9IEN)
S DGTOT10=DGTOT10+COUNT
S ^XTMP(PXRRXTMP,"PRINT",STOIND,"ICD10",COUNT,ICD9IEN)="DIAG"_ICD9IEN
G NEXTIC10
;
;
STDC10 S DCIEN=""
NEXTDC10 ;
S DCIEN=$O(^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC10",DCIEN))
I DCIEN="" G NEXTSTO
S COUNT=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC10",DCIEN)
S ^XTMP(PXRRXTMP,"PRINT",STOIND,"DC10",COUNT,DCIEN)=""
G NEXTDC10
;
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","DGTOT10",STOIND)=DGTOT10(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
. S ZTSAVE("DIAGTOT")="",ZTSAVE("DGTOT10")="" ; FIX UNDEF IN PXRRFDP
. D REQUE^PXRRQUE(DESC,ROUTINE,TASK)
E D ^PXRRFDP
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRFDSD 6407 printed Apr 09, 2024@21:30:14 Page 2
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,121,199**;Aug 12, 1996;Build 51
SORT ;
+1 NEW BUSY,COUNT,DCIEN,DGTOT10,DIAGTOT,ENCTOT,FACILITY,HLOC,ICD9IEN,ICDDATA
+2 NEW ICDTYP,INFOTYPE,PNAME,POV,POVIEN,PRIMARY,PXDXDATE,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
SET DGTOT10=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 ;Initialize the diagnosis counters.
+11 IF '$DATA(DIAGTOT(STOIND))
SET DIAGTOT(STOIND)=0
+12 ; keep track of ICD10s also
IF '$DATA(DGTOT10(STOIND))
SET DGTOT10(STOIND)=0
+13 ;
+14 ;Get the diagnoses associated with this VIEN.
+15 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 SET PXDXDATE=$$CSDATE^PXDXUTL(VIEN)
+11 SET ICDDATA=$$ICDDATA^ICDXCODE("DIAG",ICD9IEN,PXDXDATE,"I")
SET ICDTYP=$PIECE(ICDDATA,U,20)
+12 IF ICDTYP="30"
GOTO DIAG2
+13 IF '$DATA(^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD9",ICD9IEN))
SET ^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD9",ICD9IEN)=1
+14 IF '$TEST
SET ^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD9",ICD9IEN)=^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD9",ICD9IEN)+1
+15 SET DIAGTOT(STOIND)=DIAGTOT(STOIND)+1
+16 GOTO DIAG3
DIAG2 IF '$DATA(^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD10",ICD9IEN))
SET ^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD10",ICD9IEN)=1
+1 IF '$TEST
SET ^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD10",ICD9IEN)=^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD10",ICD9IEN)+1
+2 SET DGTOT10(STOIND)=DGTOT10(STOIND)+1
DIAG3 ;
+1 ;Count the diagnostic categories.
+2 ;This will probably require a DBIA.
+3 ;S DCIEN=$P(^ICD9(ICD9IEN,0),U,5)
+4 SET DCIEN=$PIECE(ICDDATA,U,6)
+5 IF DCIEN'>0
SET DCIEN=0
+6 if ICDTYP="30"
GOTO DIAG4
+7 IF '$DATA(^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC",DCIEN))
SET ^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC",DCIEN)=1
+8 IF '$TEST
SET ^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC",DCIEN)=^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC",DCIEN)+1
+9 GOTO DIAG
DIAG4 IF '$DATA(^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC10",DCIEN))
SET ^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC10",DCIEN)=1
+1 IF '$TEST
SET ^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC10",DCIEN)=^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC10",DCIEN)+1
+2 ;
+3 GOTO DIAG
+4 ;
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 NXTIC10
+2 SET COUNT=^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC",DCIEN)
+3 SET ^XTMP(PXRRXTMP,"PRINT",STOIND,"DC",COUNT,DCIEN)=""
+4 GOTO NEXTDC
+5 ;
NXTIC10 SET ICD9IEN=""
NEXTIC10 ;
+1 SET ICD9IEN=$ORDER(^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD10",ICD9IEN))
+2 IF ICD9IEN=""
GOTO STDC10
+3 SET COUNT=^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"ICD10",ICD9IEN)
+4 SET DGTOT10=DGTOT10+COUNT
+5 SET ^XTMP(PXRRXTMP,"PRINT",STOIND,"ICD10",COUNT,ICD9IEN)="DIAG"_ICD9IEN
+6 GOTO NEXTIC10
+7 ;
+8 ;
STDC10 SET DCIEN=""
NEXTDC10 ;
+1 SET DCIEN=$ORDER(^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC10",DCIEN))
+2 IF DCIEN=""
GOTO NEXTSTO
+3 SET COUNT=^TMP(PXRRXTMP,$JOB,"DIAG",STOIND,"DC10",DCIEN)
+4 SET ^XTMP(PXRRXTMP,"PRINT",STOIND,"DC10",COUNT,DCIEN)=""
+5 GOTO NEXTDC10
+6 ;
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","DGTOT10",STOIND)=DGTOT10(STOIND)
+9 SET ^XTMP(PXRRXTMP,"TOTALS","ENCTOT",STOIND)=ENCTOT(STOIND)
End DoDot:1
+10 ;
+11 IF '(PXRRQUE!$DATA(IO("S")))
DO DONE^PXRRBUSY("done")
+12 ;
+13 ;Print the report.
+14 IF PXRRQUE
Begin DoDot:1
+15 NEW DESC,ROUTINE,TASK
+16 SET DESC="Frequency of diagnosis report - print"
+17 SET ROUTINE="PXRRFDP"
+18 SET TASK=^XTMP(PXRRXTMP,"PRZTSK")
+19 SET ZTDTH=$$NOW^XLFDT
+20 ; FIX UNDEF IN PXRRFDP
SET ZTSAVE("DIAGTOT")=""
SET ZTSAVE("DGTOT10")=""
+21 DO REQUE^PXRRQUE(DESC,ROUTINE,TASK)
End DoDot:1
+22 IF '$TEST
DO ^PXRRFDP
+23 ;
+24 QUIT
