source: WorldVistAEHR/trunk/r/HOSPITAL_BASED_HOME_CARE-HBH/HBHCR19A.m@ 789

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1HBHCR19A ;LR VAMC(IRMS)/MJT-HBHC file 632 rpt, DX info by date range, sorted by DX category, then pt name, includes: name, last four, DX (code & text), w/category subtotals & grand total, calls HBHCR19B & DX^HBHCUTL3; ; 12/21/05 3:39pm
2 ;;1.0;HOSPITAL BASED HOME CARE;**8,14,22**;NOV 01, 1993;Build 2
3 D START^HBHCUTL
4 G:(HBHCBEG1=-1)!(HBHCEND1=-1) EXIT
5 K ^TMP($J)
6PROMPT1 ; Prompt user for whether to include all ICD9 Diagnosis Codes
7 K DD,D0 W !!,"Do you wish to include ALL ICD Diagnosis Codes on the report" S %=2 D YN^DICN
8 G:(%=-1) EXIT
9 I %=1 S HBHCFLAG=1 G START2
10 I %=0 W !!,"A 'Yes' response will include ALL ICD Diagnosis Codes. A 'No' response will",!,"prompt for an individual ICD Diagnosis Code." G PROMPT1
11PROMPT2 ; Prompt user for individual ICD9 Diagnosis Code
12 W ! K DIR S DIR(0)="PO^80:AEMQ" D ^DIR
13 G:($D(DTOUT))!($D(DUOUT)) EXIT
14 G:(Y=-1) START1
15 S HBHCTMP=Y
16PROMPT3 ; Prompt user for whether ICD9 category is to be considered a range (e.g. Diabetes ICD9 codes range from 250 to 250.93 (as of 8/97))
17 W !!,"Do you wish to include ALL codes within category "_$P($P(HBHCTMP,U,2),".") S %=1 D YN^DICN
18 G:(%=-1) START1
19 I %=0 W !!,"A 'Yes' response will include ALL ICD Diagnosis Codes withing the category.",!,"A 'No' response selects the specific ICD9 Diagnosis Code." G PROMPT3
20 S HBHCCAT=$P($P(HBHCTMP,U,2),".")
21 S:%=2 ^TMP($J,HBHCCAT,$P(HBHCTMP,U,2))="",^TMP($J,"B",$P(^ICD9($P(HBHCTMP,U),0),U))=""
22 ; Setup ^TMP($J array with range of Dx
23 S:%=1 HBHCCATE=(HBHCCAT)_".99",HBHCCATB=$S($E(HBHCCAT)=0:"0"_(HBHCCAT-1)_".99",$E(HBHCCAT)'?1N:$E(HBHCCAT)_($E(HBHCCAT,2,99)-1)_".99",1:(HBHCCAT-1)_".99")
24 I %=1 F S HBHCCATB=$O(^ICD9("BA",HBHCCATB)) Q:(HBHCCATB="")!(($E(HBHCCATB,2,99))>($E(HBHCCATE,2,99))) S HBHCICDP="" F S HBHCICDP=$O(^ICD9("BA",HBHCCATB,HBHCICDP)) Q:HBHCICDP="" D SETTMP
25 G PROMPT2
26START1 ; Initialization 1
27 G:'$D(^TMP($J)) EXIT
28START2 ; Initialization 2
29 S %ZIS="Q",HBHCCC=0 K IOP,ZTIO,ZTSAVE D ^%ZIS G:POP EXIT
30 I $D(IO("Q")) S ZTRTN="DQ^HBHCR19A",ZTDESC="HBPC ICD9 Code/Text Report",ZTSAVE("HBHC*")="",ZTSAVE("^TMP($J,")="" D ^%ZTLOAD G EXIT
31DQ ; De-queue
32 U IO
33 D INITIAL^HBHCR19B,TODAY^HBHCUTL D:IO'=IO(0)!($D(IO("S"))) HDRRANGE^HBHCUTL
34 I '$D(IO("S")),(IO=IO(0)) S HBHCCC=HBHCCC+1 W @IOF D HDRRANGE^HBHCUTL
35LOOP ; Loop thru ^HBHC(632,"C" (appointment date) cross-ref to build report
36 S X1=HBHCBEG1,X2=-1 D C^%DTC S HBHCAPDT=X_.9999
37 F S HBHCAPDT=$O(^HBHC(632,"C",HBHCAPDT)) Q:(HBHCAPDT="")!($P(HBHCAPDT,".")>HBHCEND1) S HBHCDFN="" F S HBHCDFN=$O(^HBHC(632,"C",HBHCAPDT,HBHCDFN)) Q:HBHCDFN="" S HBHCNOD0=^HBHC(632,HBHCDFN,0) D:$P(HBHCNOD0,U,7)="" PROCESS
38 W:'$D(^TMP("HBHC",$J)) !!,"No data found for Date Range selected."
39 I $D(^TMP("HBHC",$J)) D PRTLOOP^HBHCR19B W !!,HBHCZ,!,"ICD9 Diagnosis Categories Total: ",HBHCTOT,!,HBHCZ
40 D ENDRPT^HBHCUTL1
41EXIT ; Exit module
42 D EXIT^HBHCR19B
43 Q
44SETTMP ; Set ^TMP($J
45 S ^TMP($J,HBHCCAT,HBHCCATB)="",^TMP($J,"B",$P(^ICD9(HBHCICDP,0),U))=""
46 Q
47PROCESS ; Process record & build ^TMP("HBHC",$J) global
48 S HBHCDPT0=^DPT($P(HBHCNOD0,U),0)
49DX ; Process Diagnosis (DX), HBHCDFN must be defined prior to call, returns code plus text in local array HBHCDX
50 D DX^HBHCUTL3
51 S HBHCI=0 F S HBHCI=$O(HBHCDX(HBHCI)) Q:HBHCI'>0 S HBHCDX="HBHCDX("_HBHCI_")" D:$D(HBHCFLAG) SET I '$D(HBHCFLAG) D:$D(^TMP($J,"B",$P(@HBHCDX,HBHCSP2))) SET
52 Q
53SET ; Set ^TMP node
54 ; HBH*1*22 shortens SSN to Last 4 only for display; following full SSN left intact since used as subscript
55 S ^TMP("HBHC",$J,$P(@HBHCDX,"."),$E($P(HBHCDPT0,U),1,24),$E($P(HBHCDPT0,U,9),1,3)_"-"_$E($P(HBHCDPT0,U,9),4,5)_"-"_$E($P(HBHCDPT0,U,9),6,9),@HBHCDX)=""
56 Q
Note: See TracBrowser for help on using the repository browser.