source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXRRFDSD.m@ 1801

Last change on this file since 1801 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.7 KB
Line 
1PXRRFDSD ;ISL/PKR - Go through the encounters attaching a diagnosis and then sort based on the diagnosis. ;06/08/98
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**3,10,12,31,54,121**;Aug 12, 1996
3SORT ;
4 N BUSY,COUNT,DIAGTOT,DCIEN,ENCTOT,ICD9IEN,INFOTYPE,FACILITY,HLOC
5 N POV,POVIEN,PNAME,PRIMARY,STOIND,VACODE,VIEN
6 ;
7 ;The ^XTMP array created in PXRRFDSE can have four possible structures.
8 ;If the encounters were sorted by location then the structure will be:
9 ; ^XTMP(PXRRXTMP,FACILITY,1,1,HLOC,VIEN).
10 ;If the encounters were sorted by person class then the structure will be:
11 ; ^XTMP(PXRRXTMP,FACILITY,1,VACODE,1,VIEN).
12 ;If the encounters were sorted by provider then the structure will be:
13 ; ^XTMP(PXRRXTMP,FACILITY,PNAME,1,1,VIEN).
14 ;If none of the above screens were used then the structure will be:
15 ; ^XTMP(PXRRXTMP,FACILITY,1,1,1,VIEN).
16 ;
17 I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)
18 ;
19 ;Allow the task to be cleaned up on successful completion.
20 S ZTREQ="@"
21 ;
22 I $P(PXRRFDDC,U,1)="P" S PRIMARY=1
23 E S PRIMARY=0
24 ;
25 S DIAGTOT=0
26 ;Initialize the storage index.
27 S STOIND=0
28 ;
29 S FACILITY=""
30FAC S FACILITY=$O(^XTMP(PXRRXTMP,"ENCTR",FACILITY))
31 I FACILITY="" G SETPR
32 S STOIND=STOIND+1
33 S ^XTMP(PXRRXTMP,"INFO","FACILITY",FACILITY,FACILITY)=STOIND
34 ;
35 S PNAME=""
36PRV S PNAME=$O(^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME))
37 I PNAME="" G FAC
38 ;Start INFOTYPE with "G" so it always comes after FACILITY.
39 S INFOTYPE="G"
40 I ($L(PNAME)>1)&(+PNAME=0)&(INFOTYPE'["PRV") D
41 . S INFOTYPE=INFOTYPE_"PRV"
42 ;
43 ;Check for a user request to stop the task.
44 I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRFDD
45 ;
46 S VACODE=""
47PCLASS S VACODE=$O(^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,VACODE))
48 I VACODE="" G PRV
49 I ($L(VACODE)>1)&(+VACODE=0)&(INFOTYPE'["PC") D
50 . S INFOTYPE=INFOTYPE_"PC"
51 ;
52 S HLOC=""
53LOC S HLOC=$O(^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,VACODE,HLOC))
54 I HLOC="" G PCLASS
55 ;The location is stored in the form NAME_U_STOP CODE
56 I ($L(HLOC)>1)&(+$P(HLOC,U,2)>0)&(INFOTYPE'["LOC") D
57 . S INFOTYPE=INFOTYPE_"LOC"
58 ;
59 S STOIND=STOIND+1
60 S ^XTMP(PXRRXTMP,"INFO",INFOTYPE,FACILITY,PNAME,VACODE,HLOC)=STOIND
61 ;
62 S VIEN=""
63ENC S VIEN=$O(^XTMP(PXRRXTMP,"ENCTR",FACILITY,PNAME,VACODE,HLOC,VIEN))
64 I (VIEN="")!(VIEN=0) G LOC
65 ;Count the encounters
66 I '$D(ENCTOT(STOIND)) S ENCTOT(STOIND)=1
67 E S ENCTOT(STOIND)=ENCTOT(STOIND)+1
68 ;
69 ;If this is an interactive session let the user know that something
70 ;is happening.
71 I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting diagnoses",.BUSY)
72 ;
73 ;Initialzide the diagnosis counter.
74 I '$D(DIAGTOT(STOIND)) S DIAGTOT(STOIND)=0
75 ;
76 ;Get the diagnoses associated with this VIEN.
77 S POVIEN=""
78DIAG S POVIEN=$O(^AUPNVPOV("AD",VIEN,POVIEN))
79 I POVIEN="" G ENC
80 S POV=^AUPNVPOV(POVIEN,0)
81 ;
82 ;Apply the primary/secondary screen. If this field does not contain P
83 ;then we take it to be secondary.
84 I PRIMARY I $P(POV,U,12)'="P" G DIAG
85 ;
86 ;Count the ICD9 entries.
87 S ICD9IEN=$P(POV,U,1)
88 I '$D(^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD9",ICD9IEN)) S ^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD9",ICD9IEN)=1
89 E S ^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD9",ICD9IEN)=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD9",ICD9IEN)+1
90 S DIAGTOT(STOIND)=DIAGTOT(STOIND)+1
91 ;
92 ;Count the diagnostic categories.
93 ;This will probably require a DBIA.
94 ;S DCIEN=$P(^ICD9(ICD9IEN,0),U,5)
95 S DCIEN=$P($$ICDDX^ICDCODE(ICD9IEN),U,6)
96 I DCIEN'>0 S DCIEN=0
97 I '$D(^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN)) S ^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN)=1
98 E S ^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN)=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN)+1
99 ;
100 G DIAG
101 ;
102SETPR ;Rearrange the information for printing.
103 S STOIND=""
104NEXTSTO S STOIND=$O(^TMP(PXRRXTMP,$J,"DIAG",STOIND))
105 I STOIND="" G EXIT
106 I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting diagnoses",.BUSY)
107 ;
108 S ICD9IEN=""
109NEXTIC S ICD9IEN=$O(^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD9",ICD9IEN))
110 I ICD9IEN="" G STDC
111 S COUNT=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"ICD9",ICD9IEN)
112 S DIAGTOT=DIAGTOT+COUNT
113 S ^XTMP(PXRRXTMP,"PRINT",STOIND,"ICD9",COUNT,ICD9IEN)="DIAG"_ICD9IEN
114 G NEXTIC
115 ;
116 ;
117STDC S DCIEN=""
118NEXTDC S DCIEN=$O(^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN))
119 I DCIEN="" G NEXTSTO
120 S COUNT=^TMP(PXRRXTMP,$J,"DIAG",STOIND,"DC",DCIEN)
121 S ^XTMP(PXRRXTMP,"PRINT",STOIND,"DC",COUNT,DCIEN)=""
122 G NEXTDC
123 ;
124EXIT ;
125 ;Kill the arrays we are done with.
126 K ^TMP(PXRRXTMP,$J,"DIAG")
127 K ^XTMP(PXRRXTMP,"ENCTR")
128 ;
129 S STOIND=""
130 F S STOIND=$O(ENCTOT(STOIND)) Q:STOIND="" D
131 . S ^XTMP(PXRRXTMP,"TOTALS","DIAGTOT",STOIND)=DIAGTOT(STOIND)
132 . S ^XTMP(PXRRXTMP,"TOTALS","ENCTOT",STOIND)=ENCTOT(STOIND)
133 ;
134 I '(PXRRQUE!$D(IO("S"))) D DONE^PXRRBUSY("done")
135 ;
136 ;Print the report.
137 I PXRRQUE D
138 . N DESC,ROUTINE,TASK
139 . S DESC="Frequency of diagnosis report - print"
140 . S ROUTINE="PXRRFDP"
141 . S TASK=^XTMP(PXRRXTMP,"PRZTSK")
142 . S ZTDTH=$$NOW^XLFDT
143 . D REQUE^PXRRQUE(DESC,ROUTINE,TASK)
144 E D ^PXRRFDP
145 ;
146 Q
Note: See TracBrowser for help on using the repository browser.