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, calls DQ^HBHCRP31 ;Apr 2000
;;1.0;HOSPITAL BASED HOME CARE;**6,8,10,13,16,24,25**;NOV 01, 1993;Build 45
;
; This routine references the following supported ICRs:
; 5747 $$CODEC^ICDEX
; 5747 $$VSTD^ICDEX
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;HBH*1.0*25 FEB 2012 K GUPTA Support for ICD-10 Coding System
;******************************************************************************
;******************************************************************************
;
; 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 $C(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
; Print Medical Foster Home (MFH) Form Errors if exist
I $D(^HBHC(634.7,"B")) W @IOF D DQ^HBHCRP31
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
N DXINFO
S:HBHCICDP]"" DXINFO=$$CODEC^ICDEX(80,HBHCICDP)_" "_$$VSTD^ICDEX(HBHCICDP)
S ^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,3,HBHCI)=HBHCDX1_$G(DXINFO)_$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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRP1A 4973 printed Nov 22, 2024@17:08:31 Page 2
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, calls DQ^HBHCRP31 ;Apr 2000
+1 ;;1.0;HOSPITAL BASED HOME CARE;**6,8,10,13,16,24,25**;NOV 01, 1993;Build 45
+2 ;
+3 ; This routine references the following supported ICRs:
+4 ; 5747 $$CODEC^ICDEX
+5 ; 5747 $$VSTD^ICDEX
+6 ;
+7 ;******************************************************************************
+8 ;******************************************************************************
+9 ; --- ROUTINE MODIFICATION LOG ---
+10 ;
+11 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+12 ;----------- ---------- ----------- ----------------------------------------
+13 ;HBH*1.0*25 FEB 2012 K GUPTA Support for ICD-10 Coding System
+14 ;******************************************************************************
+15 ;******************************************************************************
+16 ;
+17 ; 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
+18 IF $PIECE(^HBHC(631.9,1,0),U,8)]""
WRITE $CHAR(7),!,"File Update in progress. Please try again later."
HANG 3
QUIT
+19 SET %ZIS="Q"
SET HBHCCC=0
KILL IOP,ZTIO,ZTSAVE
DO ^%ZIS
if POP
QUIT
+20 IF $DATA(IO("Q"))
SET ZTRTN="DQ^HBHCRP1A"
SET ZTSAVE("HBHC*")=""
SET ZTDESC="HBPC Form Errors Report"
DO ^%ZTLOAD
GOTO EXIT
DQ ; De-queue
+1 USE IO
+2 DO START^HBHCRP1B
LOOP ; Loop thru files 634.1, 634.2 & 634.3 "B" cross-ref
+1 FOR HBHCFILE=634.1,634.2,634.3
SET HBHCDPT=""
FOR
SET HBHCDPT=$ORDER(^HBHC(HBHCFILE,"B",HBHCDPT))
if HBHCDPT=""
QUIT
DO SETUP^HBHCRP1B
SET HBHCIEN=""
FOR
SET HBHCIEN=$ORDER(^HBHC(HBHCFILE,"B",HBHCDPT,HBHCIEN))
if HBHCIEN=""
QUIT
DO PROCESS
+2 DO PRTLOOP^HBHCRP1B
if $DATA(^HBHC(634.5,"B"))
DO PSEUDO^HBHCUTL3
+3 IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<12)
WRITE @IOF
DO HDRPAGE^HBHCUTL
+4 if $DATA(^HBHC(634.2,"B"))
DO PCEMSG^HBHCUTL3
DO ENDRPT^HBHCUTL1
+5 ; Print Medical Foster Home (MFH) Form Errors if exist
+6 IF $DATA(^HBHC(634.7,"B"))
WRITE @IOF
DO DQ^HBHCRP31
EXIT ; Exit module
+1 DO EXIT^HBHCRP1B
+2 QUIT
PROCESS ; Process report data
+1 SET HBHCDPT0=^DPT(HBHCDPT,0)
SET HBHCNOD0=$SELECT(HBHCFORM="V":$GET(^HBHC(HBHCFL,HBHCIEN,0)),1:$GET(^HBHC(HBHCFL,$PIECE(^HBHC(HBHCFILE,HBHCIEN,0),U,2),0)))
+2 ; Form 3: use Evaluation Date (field 1) if Date (field 17) null, 'reject' episodes prior to PCE patch will only have eval date
+3 SET (HBHCDAT,Y)=$PIECE(HBHCNOD0,U,HBHCPC)
if (HBHCFORM="A")&(Y="")
SET (HBHCDAT,Y)=$PIECE(HBHCNOD0,U,2)
DO DD^%DT
SET HBHCDATE=$EXTRACT(Y,1,18)
if HBHCDAT=""
SET (HBHCDAT,HBHCDATE)="Missing"
+4 SET HBHCNAME=$EXTRACT($PIECE(HBHCDPT0,U),1,14)
SET HBHCSSN=$EXTRACT($PIECE(HBHCDPT0,U,9),6,9)
+5 SET HBHCCLN="n/a"
if HBHCFORM="V"
SET HBHCCLN=$SELECT($PIECE(HBHCNOD0,U,6)]"":$EXTRACT($PIECE(^SC($PIECE(HBHCNOD0,U,6),0),U),1,18),1:"Unknown")
+6 SET HBHCMSG=""
if HBHCFORM="V"
SET HBHCMSG=$SELECT($PIECE(HBHCNOD0,U,3)]"":$PIECE(^HBHC(633.1,$PIECE(HBHCNOD0,U,3),0),U),1:"")
+7 IF HBHCFORM="V"
SET HBHCOEP=$PIECE(HBHCNOD0,U,4)
if HBHCOEP]""
DO OE
+8 SET ^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,1)="`"_HBHCDPT_U_HBHCDATE_U_HBHCMSG
+9 QUIT
OE ; Process Outpatient Encounter data
+1 ; Provider, 2 pieces of info delimited by $ (Provider name & V PROVIDER ^AUPNVPRV(9000010.06) DFN)
+2 KILL HBHCPRV1,HBHCPRVL
+3 DO GETPRV^SDOE(HBHCOEP,"HBHCPRVL")
+4 SET HBHCDFN=0
FOR HBHCI=1:1
SET HBHCDFN=$ORDER(HBHCPRVL(HBHCDFN))
if HBHCDFN'>0
QUIT
SET HBHCPRVP=$PIECE(HBHCPRVL(HBHCDFN),U)
SET ^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,2,HBHCI)=$SELECT(HBHCPRVP]"":$PIECE(^VA(200,HBHCPRVP,0),U)_"$"_HBHCPRVP,1:"")
+5 ; Dx
+6 KILL HBHCDXL
+7 DO GETDX^SDOE(HBHCOEP,"HBHCDXL")
+8 SET HBHCDFN=0
FOR HBHCI=1:1
SET HBHCDFN=$ORDER(HBHCDXL(HBHCDFN))
if HBHCDFN'>0
QUIT
SET HBHCINFO=HBHCDXL(HBHCDFN)
SET HBHCICDP=$PIECE(HBHCINFO,U)
SET HBHCDX1=$SELECT($PIECE(HBHCINFO,U,12)="P":"* ",1:HBHCSP2)
DO ICD
+9 ; 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
+10 KILL HBHCCPTL,HBHCPRV
+11 DO GETCPT^SDOE(HBHCOEP,"HBHCCPTL")
+12 SET HBHCDFN=0
FOR HBHCI=1:1
SET HBHCDFN=$ORDER(HBHCCPTL(HBHCDFN))
if HBHCDFN'>0
QUIT
SET HBHCJ=0
FOR
SET HBHCJ=$ORDER(HBHCCPTL(HBHCDFN,HBHCJ))
if HBHCJ'>0
QUIT
SET HBHCINFO=HBHCCPTL(HBHCDFN,0)
SET HBHCCPT=$$CPT^ICPTCOD($PIECE(HBHCINFO,U))
DO SETCPT
DO MOD
+13 QUIT
ICD ; Dx info
+1 NEW DXINFO
+2 if HBHCICDP]""
SET DXINFO=$$CODEC^ICDEX(80,HBHCICDP)_" "_$$VSTD^ICDEX(HBHCICDP)
+3 SET ^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,3,HBHCI)=HBHCDX1_$GET(DXINFO)_$SELECT(HBHCDX1["*":" * Primary Dx",1:"")
+4 QUIT
SETCPT ; Set TMP global with CPT info
+1 SET ^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,4,HBHCI)=$PIECE(HBHCCPT,U,2)_HBHCSP3_$PIECE(HBHCCPT,U,3)_"$"_$PIECE(HBHCINFO,U,16)_"$"_$SELECT($DATA(HBHCCPTL(HBHCDFN,12)):$PIECE(HBHCCPTL(HBHCDFN,12),U,4),1:"")
+2 QUIT
MOD ; CPT Modifier loop & set
+1 SET HBHCK=0
+2 FOR
SET HBHCK=$ORDER(HBHCCPTL(HBHCDFN,HBHCJ,HBHCK))
if HBHCK'>0
QUIT
SET HBHCMOD=$$MOD^ICPTMOD(HBHCCPTL(HBHCDFN,HBHCJ,HBHCK,0),"I")
SET ^TMP("HBHC",$JOB,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,4,HBHCI,HBHCJ)=$PIECE(HBHCMOD,U,2)_HBHCSP3_$PIECE(HBHCMOD,U,3)
+3 QUIT
