source: WorldVistAEHR/trunk/r/HOSPITAL_BASED_HOME_CARE-HBH/HBHCRP1A.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.9 KB
Line 
1HBHCRP1A ; LR VAMC(IRMS)/MJT-HBHC report on files 634.1, 634.2, & 634.3, (Form 3/4/5 (A/V/D respectively) Error(s)), sorted by form, then by: clinic, date, patient & includes: pt name, last 4, form, & date ; Apr 2000
2 ;;1.0;HOSPITAL BASED HOME CARE;**6,8,10,13,16**;NOV 01, 1993
3 ; visits display current outpatient encounter file data, allowing easier re-entry when cleaning up errors, includes: Pt file IEN, error, provider, Dx, CPT code with Modifiers & clinic name, calls HBHCRP1B & PSEUDO^HBHCUTL3
4 I $P(^HBHC(631.9,1,0),U,8)]"" W *7,!,"File Update in progress. Please try again later." H 3 Q
5 S %ZIS="Q",HBHCCC=0 K IOP,ZTIO,ZTSAVE D ^%ZIS Q:POP
6 I $D(IO("Q")) S ZTRTN="DQ^HBHCRP1A",ZTSAVE("HBHC*")="",ZTDESC="HBPC Form Errors Report" D ^%ZTLOAD G EXIT
7DQ ; De-queue
8 U IO
9 D START^HBHCRP1B
10LOOP ; Loop thru files 634.1, 634.2 & 634.3 "B" cross-ref
11 F HBHCFILE=634.1,634.2,634.3 S HBHCDPT="" F S HBHCDPT=$O(^HBHC(HBHCFILE,"B",HBHCDPT)) Q:HBHCDPT="" D SETUP^HBHCRP1B S HBHCIEN="" F S HBHCIEN=$O(^HBHC(HBHCFILE,"B",HBHCDPT,HBHCIEN)) Q:HBHCIEN="" D PROCESS
12 D PRTLOOP^HBHCRP1B D:$D(^HBHC(634.5,"B")) PSEUDO^HBHCUTL3
13 I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<12) W @IOF D HDRPAGE^HBHCUTL
14 D:$D(^HBHC(634.2,"B")) PCEMSG^HBHCUTL3 D ENDRPT^HBHCUTL1
15EXIT ; Exit module
16 D EXIT^HBHCRP1B
17 Q
18PROCESS ; Process report data
19 S HBHCDPT0=^DPT(HBHCDPT,0),HBHCNOD0=$S(HBHCFORM="V":$G(^HBHC(HBHCFL,HBHCIEN,0)),1:$G(^HBHC(HBHCFL,$P(^HBHC(HBHCFILE,HBHCIEN,0),U,2),0)))
20 ; Form 3: use Evaluation Date (field 1) if Date (field 17) null, 'reject' episodes prior to PCE patch will only have eval date
21 S (HBHCDAT,Y)=$P(HBHCNOD0,U,HBHCPC) S:(HBHCFORM="A")&(Y="") (HBHCDAT,Y)=$P(HBHCNOD0,U,2) D DD^%DT S HBHCDATE=$E(Y,1,18) S:HBHCDAT="" (HBHCDAT,HBHCDATE)="Missing"
22 S HBHCNAME=$E($P(HBHCDPT0,U),1,14),HBHCSSN=$E($P(HBHCDPT0,U,9),6,9)
23 S HBHCCLN="n/a" S:HBHCFORM="V" HBHCCLN=$S($P(HBHCNOD0,U,6)]"":$E($P(^SC($P(HBHCNOD0,U,6),0),U),1,18),1:"Unknown")
24 S HBHCMSG="" S:HBHCFORM="V" HBHCMSG=$S($P(HBHCNOD0,U,3)]"":$P(^HBHC(633.1,$P(HBHCNOD0,U,3),0),U),1:"")
25 I HBHCFORM="V" S HBHCOEP=$P(HBHCNOD0,U,4) D:HBHCOEP]"" OE
26 S ^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,1)="`"_HBHCDPT_U_HBHCDATE_U_HBHCMSG
27 Q
28OE ; Process Outpatient Encounter data
29 ; Provider, 2 pieces of info delimited by $ (Provider name & V PROVIDER ^AUPNVPRV(9000010.06) DFN)
30 K HBHCPRV1,HBHCPRVL
31 D GETPRV^SDOE(HBHCOEP,"HBHCPRVL")
32 S HBHCDFN=0 F HBHCI=1:1 S HBHCDFN=$O(HBHCPRVL(HBHCDFN)) Q:HBHCDFN'>0 S HBHCPRVP=$P(HBHCPRVL(HBHCDFN),U),^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,2,HBHCI)=$S(HBHCPRVP]"":$P(^VA(200,HBHCPRVP,0),U)_"$"_HBHCPRVP,1:"")
33 ; Dx
34 K HBHCDXL
35 D GETDX^SDOE(HBHCOEP,"HBHCDXL")
36 S HBHCDFN=0 F HBHCI=1:1 S HBHCDFN=$O(HBHCDXL(HBHCDFN)) Q:HBHCDFN'>0 S HBHCINFO=HBHCDXL(HBHCDFN),HBHCICDP=$P(HBHCINFO,U),HBHCDX1=$S($P(HBHCINFO,U,12)="P":"* ",1:HBHCSP2) D ICD
37 ; CPT Code, 3 pieces of info delimited by $ (CPT Code w/Text, Quantity of CPT code & New Person file (200) DFN), must match V PROVIDER ^AUPNVPRV(9000010.06) DFN to ensure same provider
38 K HBHCCPTL,HBHCPRV
39 D GETCPT^SDOE(HBHCOEP,"HBHCCPTL")
40 S HBHCDFN=0 F HBHCI=1:1 S HBHCDFN=$O(HBHCCPTL(HBHCDFN)) Q:HBHCDFN'>0 S HBHCJ=0 F S HBHCJ=$O(HBHCCPTL(HBHCDFN,HBHCJ)) Q:HBHCJ'>0 S HBHCINFO=HBHCCPTL(HBHCDFN,0),HBHCCPT=$$CPT^ICPTCOD($P(HBHCINFO,U)) D SETCPT,MOD
41 Q
42ICD ; Dx info
43 S ^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,3,HBHCI)=HBHCDX1_$S(HBHCICDP]"":$P(^ICD9(HBHCICDP,0),U)_" "_$P(^ICD9(HBHCICDP,0),U,3),1:"")_$S(HBHCDX1["*":" * Primary Dx",1:"")
44 Q
45SETCPT ; Set TMP global with CPT info
46 S ^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,4,HBHCI)=$P(HBHCCPT,U,2)_HBHCSP3_$P(HBHCCPT,U,3)_"$"_$P(HBHCINFO,U,16)_"$"_$S($D(HBHCCPTL(HBHCDFN,12)):$P(HBHCCPTL(HBHCDFN,12),U,4),1:"")
47 Q
48MOD ; CPT Modifier loop & set
49 S HBHCK=0
50 F S HBHCK=$O(HBHCCPTL(HBHCDFN,HBHCJ,HBHCK)) Q:HBHCK'>0 S HBHCMOD=$$MOD^ICPTMOD(HBHCCPTL(HBHCDFN,HBHCJ,HBHCK,0),"I"),^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,4,HBHCI,HBHCJ)=$P(HBHCMOD,U,2)_HBHCSP3_$P(HBHCMOD,U,3)
51 Q
Note: See TracBrowser for help on using the repository browser.