Routine: HBHCRP1B

HBHCRP1B ;LR VAMC(IRMS)/MJT - HBHC report on files 634.1, 634.2, & 634.3, (Form 3/4/5 (A/V/D respectively) Error(s)), called by HBHCRP1A, entry points:  START, SETUP, PRTLOOP, EXIT ;April 2000

 ;;1.0;HOSPITAL BASED HOME CARE;**6,8,10,16,25**;NOV 01, 1993;Build 45

 ;******************************************************************************

 ;******************************************************************************

 ;                       --- ROUTINE MODIFICATION LOG ---

 ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION

 ;-----------  ----------  -----------  ----------------------------------------

 ;HBH*1.0*25   FEB  2012   K GUPTA      Support for ICD-10 Coding System

 ;******************************************************************************

 ;******************************************************************************

START ; Entry point

 K ^TMP("HBHC",$J)

 ; Max length for HBHCHEAD = 50

 S $P(HBHCSP2," ",3)="",$P(HBHCSP3," ",4)="",HBHCTEXT="   Modifier:   - ",$P(HBHCY,"-",81)="",HBHCPAGE=0,HBHCHEAD="Form Errors"

 S HBHCHDR="W ""Patient"",?27,""Last"",!,""File IEN"",?10,""Patient Name"",?27,""Four"",?34,""Visit Clinic Name"",?55,""Date"",?75,""Form"""

 S HBHCCOLM=(80-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1 D TODAY^HBHCUTL

SETUP ; Setup variables

 S HBHCFORM=$S(HBHCFILE=634.1:"A",HBHCFILE=634.2:"V",1:"D"),HBHCFL=$S(HBHCFORM="V":634.2,1:631),HBHCPC=$S(HBHCFORM="D":40,HBHCFORM="V":5,1:18)

PRTLOOP ; Print loop

 D:IO'=IO(0)!($D(IO("S"))) HDRPAGE^HBHCUTL

 I '$D(IO("S")),(IO=IO(0)) S HBHCCC=HBHCCC+1 D HDRPAGE^HBHCUTL

 S HBHCFORM=""

 F  S HBHCFORM=$O(^TMP("HBHC",$J,HBHCFORM)) Q:HBHCFORM=""  D SETTXT S HBHCCLN="" F  S HBHCCLN=$O(^TMP("HBHC",$J,HBHCFORM,HBHCCLN)) Q:HBHCCLN=""  S HBHCDAT="" F  S HBHCDAT=$O(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT)) Q:HBHCDAT=""  D LOOP2

SETTXT ; Set text

 S HBHCTXT=$S(HBHCFORM="A":"E/Adm",HBHCFORM="V":"Visit",1:"D/C")

LOOP2 ; Continuation of PRTLOOP

 S HBHCNAME="" F  S HBHCNAME=$O(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME)) Q:HBHCNAME=""  S HBHCSSN="" F  S HBHCSSN=$O(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN)) Q:HBHCSSN=""  D PRINT

PRINT ; Print report

 S HBHCINFO=^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,1)

 I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<12) W @IOF D HDRPAGE^HBHCUTL

 W !,$J($P(HBHCINFO,U),8),?10,HBHCNAME,?27,HBHCSSN,?34,HBHCCLN,?55,$P(HBHCINFO,U,2),"  ",?75,HBHCTXT W:$P(HBHCINFO,U,3)]"" !,"Error:  ",$P(HBHCINFO,U,3)

 I HBHCFORM'="V" W !,HBHCY Q

 ; provider

 F HBHCI=1:1 S HBHCINFO=$G(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,2,HBHCI)) Q:HBHCINFO=""  W !,"Provider:  ",$P(HBHCINFO,"$"),?54,"Encounter Prov #:",?72,$J($P(HBHCINFO,"$",2),8)

 ; Dx

 F HBHCI=1:1 S HBHCINFO=$G(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,3,HBHCI)) Q:HBHCINFO=""  W !,"ICD:  ",HBHCINFO

 ; CPT code

 F HBHCI=1:1 S HBHCINFO=$G(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,4,HBHCI)) Q:HBHCINFO=""  D CPT F HBHCJ=1:1 S HBHCINFO=$G(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,4,HBHCI,HBHCJ)) Q:HBHCINFO=""   D MOD

 W !,HBHCY

CPT ; Write CPT info

 W !?1,"CPT:  ",$P(HBHCINFO,"$"),?45,"QTY: ",$J($P(HBHCINFO,"$",2),3),?55,"CPT Code Prov #:",?72,$J($P(HBHCINFO,"$",3),8)

MOD ; Write Modifier info

 W !,HBHCTEXT,HBHCINFO

EXIT ; Exit module

 D ^%ZISC

 K DA,DIK,HBHCCC,HBHCCLN,HBHCCOLM,HBHCCPT,HBHCCPTL,HBHCDAT,HBHCDATE,HBHCDFN,HBHCDPT,HBHCDPT0,HBHCDX1,HBHCDXL,HBHCFILE,HBHCFL,HBHCFORM,HBHCHDR,HBHCHEAD,HBHCI,HBHCICDP,HBHCIEN,HBHCINFO,HBHCJ,HBHCK,HBHCMOD,HBHCMSG,HBHCNAME,HBHCNOD0

 K HBHCOEP,HBHCPAGE,HBHCPC,HBHCPRV,HBHCPRV1,HBHCPRVL,HBHCPRVP,HBHCSP2,HBHCSP3,HBHCSSN,HBHCTDY,HBHCTEXT,HBHCTXT,HBHCY,HBHCZ,X,Y,^TMP("HBHC",$J)

HBHCRP1B.m