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
Q
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)
Q
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
Q
SETTXT ; Set text
S HBHCTXT=$S(HBHCFORM="A":"E/Adm",HBHCFORM="V":"Visit",1:"D/C")
Q
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
Q
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
Q
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)
Q
MOD ; Write Modifier info
W !,HBHCTEXT,HBHCINFO
Q
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRP1B 3779 printed Sep 23, 2025@19:34:26 Page 2
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 ;;1.0;HOSPITAL BASED HOME CARE;**6,8,10,16,25**;NOV 01, 1993;Build 45
+2 ;******************************************************************************
+3 ;******************************************************************************
+4 ; --- ROUTINE MODIFICATION LOG ---
+5 ;
+6 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+7 ;----------- ---------- ----------- ----------------------------------------
+8 ;HBH*1.0*25 FEB 2012 K GUPTA Support for ICD-10 Coding System
+9 ;******************************************************************************
+10 ;******************************************************************************
+11 ;
START ; Entry point
+1 KILL ^TMP("HBHC",$JOB)
+2 ; Max length for HBHCHEAD = 50
+3 SET $PIECE(HBHCSP2," ",3)=""
SET $PIECE(HBHCSP3," ",4)=""
SET HBHCTEXT=" Modifier: - "
SET $PIECE(HBHCY,"-",81)=""
SET HBHCPAGE=0
SET HBHCHEAD="Form Errors"
+4 SET HBHCHDR="W ""Patient"",?27,""Last"",!,""File IEN"",?10,""Patient Name"",?27,""Four"",?34,""Visit Clinic Name"",?55,""Date"",?75,""Form"""
+5 SET HBHCCOLM=(80-(30+$LENGTH(HBHCHEAD))\2)
if HBHCCOLM'>0
SET HBHCCOLM=1
DO TODAY^HBHCUTL
+6 QUIT
SETUP ; Setup variables
+1 SET HBHCFORM=$SELECT(HBHCFILE=634.1:"A",HBHCFILE=634.2:"V",1:"D")
SET HBHCFL=$SELECT(HBHCFORM="V":634.2,1:631)
SET HBHCPC=$SELECT(HBHCFORM="D":40,HBHCFORM="V":5,1:18)
+2 QUIT
PRTLOOP ; Print loop
+1 if IO'=IO(0)!($DATA(IO("S")))
DO HDRPAGE^HBHCUTL
+2 IF '$DATA(IO("S"))
IF (IO=IO(0))
SET HBHCCC=HBHCCC+1
DO HDRPAGE^HBHCUTL
+3 SET HBHCFORM=""
+4 FOR
SET HBHCFORM=$ORDER(^TMP("HBHC",$JOB,HBHCFORM))
if HBHCFORM=""
QUIT
DO SETTXT
SET HBHCCLN=""
FOR
SET HBHCCLN=$ORDER(^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN))
if HBHCCLN=""
QUIT
SET HBHCDAT=""
FOR
SET HBHCDAT=$ORDER(^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT))
if HBHCDAT=""
QUIT
DO LOOP2
+5 QUIT
SETTXT ; Set text
+1 SET HBHCTXT=$SELECT(HBHCFORM="A":"E/Adm",HBHCFORM="V":"Visit",1:"D/C")
+2 QUIT
LOOP2 ; Continuation of PRTLOOP
+1 SET HBHCNAME=""
FOR
SET HBHCNAME=$ORDER(^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME))
if HBHCNAME=""
QUIT
SET HBHCSSN=""
FOR
SET HBHCSSN=$ORDER(^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN))
if HBHCSSN=""
QUIT
DO PRINT
+2 QUIT
PRINT ; Print report
+1 SET HBHCINFO=^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,1)
+2 IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<12)
WRITE @IOF
DO HDRPAGE^HBHCUTL
+3 WRITE !,$JUSTIFY($PIECE(HBHCINFO,U),8),?10,HBHCNAME,?27,HBHCSSN,?34,HBHCCLN,?55,$PIECE(HBHCINFO,U,2)," ",?75,HBHCTXT
if $PIECE(HBHCINFO,U,3)]""
WRITE !,"Error: ",$PIECE(HBHCINFO,U,3)
+4 IF HBHCFORM'="V"
WRITE !,HBHCY
QUIT
+5 ; provider
+6 FOR HBHCI=1:1
SET HBHCINFO=$GET(^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,2,HBHCI))
if HBHCINFO=""
QUIT
WRITE !,"Provider: ",$PIECE(HBHCINFO,"$"),?54,"Encounter Prov #:",?72,$JUSTIFY($PIECE(HBHCINFO,"$",2),8)
+7 ; Dx
+8 FOR HBHCI=1:1
SET HBHCINFO=$GET(^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,3,HBHCI))
if HBHCINFO=""
QUIT
WRITE !,"ICD: ",HBHCINFO
+9 ; CPT code
+10 FOR HBHCI=1:1
SET HBHCINFO=$GET(^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,4,HBHCI))
if HBHCINFO=""
QUIT
DO CPT
FOR HBHCJ=1:1
SET HBHCINFO=$GET(^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,4,HBHCI,HBHCJ))
if HBHCINFO=""
QUIT
DO MOD
+11 WRITE !,HBHCY
+12 QUIT
CPT ; Write CPT info
+1 WRITE !?1,"CPT: ",$PIECE(HBHCINFO,"$"),?45,"QTY: ",$JUSTIFY($PIECE(HBHCINFO,"$",2),3),?55,"CPT Code Prov #:",?72,$JUSTIFY($PIECE(HBHCINFO,"$",3),8)
+2 QUIT
MOD ; Write Modifier info
+1 WRITE !,HBHCTEXT,HBHCINFO
+2 QUIT
EXIT ; Exit module
+1 DO ^%ZISC
+2 KILL 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
+3 KILL HBHCOEP,HBHCPAGE,HBHCPC,HBHCPRV,HBHCPRV1,HBHCPRVL,HBHCPRVP,HBHCSP2,HBHCSP3,HBHCSSN,HBHCTDY,HBHCTEXT,HBHCTXT,HBHCY,HBHCZ,X,Y,^TMP("HBHC",$JOB)
+4 QUIT
