source: FOIAVistA/trunk/r/HOSPITAL_BASED_HOME_CARE-HBH/HBHCRP1A.m@ 1458

HBHCRP1A ; 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
 ;;1.0;HOSPITAL BASED HOME CARE;**6,8,10,13,16**;NOV 01, 1993
 ; 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
 I $P(^HBHC(631.9,1,0),U,8)]"" W *7,!,"File Update in progress.  Please try again later." H 3 Q
 S %ZIS="Q",HBHCCC=0 K IOP,ZTIO,ZTSAVE D ^%ZIS Q:POP
 I $D(IO("Q")) S ZTRTN="DQ^HBHCRP1A",ZTSAVE("HBHC*")="",ZTDESC="HBPC Form Errors Report" D ^%ZTLOAD G EXIT
DQ ; De-queue
 U IO
 D START^HBHCRP1B
LOOP ; Loop thru files 634.1, 634.2 & 634.3 "B" cross-ref
 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
 D PRTLOOP^HBHCRP1B D:$D(^HBHC(634.5,"B")) PSEUDO^HBHCUTL3
 I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<12) W @IOF D HDRPAGE^HBHCUTL
 D:$D(^HBHC(634.2,"B")) PCEMSG^HBHCUTL3 D ENDRPT^HBHCUTL1
EXIT ; Exit module
 D EXIT^HBHCRP1B
 Q
PROCESS ; Process report data
 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)))
 ; Form 3: use Evaluation Date (field 1) if Date (field 17) null, 'reject' episodes prior to PCE patch will only have eval date
 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"
 S HBHCNAME=$E($P(HBHCDPT0,U),1,14),HBHCSSN=$E($P(HBHCDPT0,U,9),6,9)
 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")
 S HBHCMSG="" S:HBHCFORM="V" HBHCMSG=$S($P(HBHCNOD0,U,3)]"":$P(^HBHC(633.1,$P(HBHCNOD0,U,3),0),U),1:"")
 I HBHCFORM="V" S HBHCOEP=$P(HBHCNOD0,U,4) D:HBHCOEP]"" OE
 S ^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,1)="`"_HBHCDPT_U_HBHCDATE_U_HBHCMSG
 Q
OE ; Process Outpatient Encounter data
 ; Provider, 2 pieces of info delimited by $ (Provider name & V PROVIDER  ^AUPNVPRV(9000010.06) DFN)
 K HBHCPRV1,HBHCPRVL
 D GETPRV^SDOE(HBHCOEP,"HBHCPRVL")
 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:"")
 ; Dx
 K HBHCDXL
 D GETDX^SDOE(HBHCOEP,"HBHCDXL")
 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
 ; 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
 K HBHCCPTL,HBHCPRV
 D GETCPT^SDOE(HBHCOEP,"HBHCCPTL")
 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
 Q
ICD ; Dx info
 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:"")
 Q
SETCPT ; Set TMP global with CPT info
 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:"")
 Q
MOD ; CPT Modifier loop & set
 S HBHCK=0
 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)
 Q