HBHCXMV ;LR VAMC(IRMS)/MJT - POPULATE HBHC TRANSMIT FILE OR LOG PSEUDO SSN ERRORS; Feb 22, 2021@07:22
;;1.0;HOSPITAL BASED HOME CARE;**2,5,6,9,12,15,17,14,19,24,25,32**;NOV 01, 1993;Build 58
;
;Reference to:
; ^SC supported by ICR #10040
; ^DIC(4 supported by ICR #10090
; ^DG(40.8 supported by ICR #7024
;
D START^HBHCXMV1
LOOP ; Loop thru ^HBHC(632) "AC","N" cross-ref to create nodes in ^HBHC(634) => transmit
S HBHCDFN="" F S HBHCDFN=$O(^HBHC(632,"AC","N",HBHCDFN)) Q:HBHCDFN="" D SETNODE
EXIT ; Exit module
D EXIT^HBHCXMV1
Q
SETNODE ; Set node in ^HBHC(634) (Transmit)
S HBHCINFO=^HBHC(632,HBHCDFN,0),HBHCXMT4=$P(HBHCINFO,U,8),HBHCAPDT=$P(HBHCINFO,U,2),HBHCSSN=$P(^DPT($P(HBHCINFO,U),0),U,9)
Q:$P(HBHCINFO,U,7)]"" ; cancelled/no show appointment
Q:HBHCAPDT>HBHCLSDT ; Visit appointment date > HBHCLSDT (last date to include in transmit set up in ^HBHCFILE)
I HBHCAPDT<2961001 D PCE^HBHCXMV1 Q
I HBHCSSN'?9N D PSSN^HBHCXMV1 Q
S HBHCPRV=+^HBHC(631.4,$P(HBHCINFO,U,4),0)
;HBH*1.0*32: pad provider number with leading zeroes instead of trailing spaces
S:$L(HBHCPRV)'=4 HBHCPRV=$E("000",1,4-$L(HBHCPRV))_HBHCPRV
;HBH*1.0*32: HBHCHOSPX = division of visit location
N HBHCHOSPX
S HBHCHOSPX=$P(HBHCINFO,U,3)
I HBHCHOSPX]"" D
. S HBHCHOSPX=$P($G(^SC(HBHCHOSPX,0)),U,15)
. Q:HBHCHOSPX=""
. ;retrieve institution file pointer
. S HBHCHOSPX=$P($G(^DG(40.8,HBHCHOSPX,0)),"^",7)
. Q:HBHCHOSPX=""
. ;retrieve station number
. S HBHCHOSPX=$P($G(^DIC(4,HBHCHOSPX,99)),U)
. Q:HBHCHOSPX=""
. S:$L(HBHCHOSPX)'=7 HBHCHOSPX=HBHCHOSPX_$E(HBHCSP4,1,(7-($L(HBHCHOSPX))))
;if for some reason did not retrieve the institution's station number, use default.
I HBHCHOSPX="" S HBHCHOSPX=HBHCHOSP
;HBHC*1.0*32 end
S HBHCTIME=$P(HBHCAPDT,".",2) S:$L(HBHCTIME)<4 HBHCTIME=HBHCTIME_$E(HBHCZRO4,1,(4-($L(HBHCTIME)))) S:$L(HBHCTIME)>4 HBHCTIME=$E(HBHCTIME,1,4)
S HBHCDATE=$E(HBHCAPDT,4,5)_$E(HBHCAPDT,6,7)_(1700+$E(HBHCAPDT,1,3))_HBHCTIME
S HBHCLNME=$P($P(^DPT($P(HBHCINFO,U),0),U),",") S:$L(HBHCLNME)'=11 HBHCLNME=$S($L(HBHCLNME)<11:HBHCLNME_$E(HBHCSP10,1,11-$L(HBHCLNME)),1:$E(HBHCLNME,1,11))
S HBHCQAI=$S(($L($P(HBHCINFO,U,16))=1)&($E(HBHCINFO,U,16)=""):HBHCSP1_$P(HBHCINFO,U,16),($L($P(HBHCINFO,U,16))=1)&($E(HBHCINFO,U,16)]""):$P(HBHCINFO,U,16)_HBHCSP1,$L($P(HBHCINFO,U,16))=2:$P(HBHCINFO,U,16),1:HBHCSP2)
DX ; Dx
D INIT,DX^HBHCUTL3
S HBHCL=0
F S HBHCL=$O(HBHCDX(HBHCL)) Q:HBHCL'>0 D
. S HBHCDX=$P(HBHCDX(HBHCL)," ")
. S HBHCDX=$P(HBHCDX,".")_$P(HBHCDX,".",2)
. S HBHCDX(HBHCL)=$S($L(HBHCDX)'=8:HBHCDX_$E(HBHCSP8,1,8-$L(HBHCDX)),1:HBHCDX)
; Note: HBHCI initialized here vs in CPT loop, since need HBHCI to continue for each 10 CPT code iteration
S (HBHCFLAG,HBHCI,HBHCL)=0 F S HBHCL=$O(HBHCDX(HBHCL)) Q:HBHCL'>0 S HBHCCNT1=HBHCCNT1+1,@("HBHCDX"_HBHCCNT1)=HBHCDX(HBHCL) D:(HBHCCNT1=5)&('HBHCFLAG) CPT D:HBHCCNT1=5 WRITE
F D:'HBHCFLAG CPT D WRITE Q:HBHCFLAG
Q
CPT ; CPT Codes
F HBHCCNT=1:1:10 S HBHCI=$O(^HBHC(632,HBHCDFN,2,HBHCI)) Q:HBHCI'>0 S HBHCNOD2=^HBHC(632,HBHCDFN,2,HBHCI,0) D SET
S:HBHCI'>0 HBHCFLAG=1
Q
SET ; Set CPT variables
I HBHCCNT<10 S @("HBHCCPT"_HBHCCNT)=$S($P(HBHCNOD2,U)]"":$E($P($G(^ICPT($P(HBHCNOD2,U),0)),U),1,5),1:HBHCSP5) S:$L(@("HBHCCPT"_HBHCCNT))'=5 @("HBHCCPT"_HBHCCNT)=@("HBHCCPT"_HBHCCNT)_$E(HBHCSP5,1,5-$L(@("HBHCCPT"_HBHCCNT)))
I HBHCCNT=10 S HBHCCP10=$S($P(HBHCNOD2,U)]"":$E($P($G(^ICPT($P(HBHCNOD2,U),0)),U),1,5),1:HBHCSP5) S:$L(HBHCCP10)'=5 HBHCCP10=HBHCCP10_$E(HBHCSP5,1,5-$L(HBHCCP10))
Q
WRITE ; Write transmit record, separate records containing max 5 DX & 10 CPTs each are generated for same visit if > 5 DX or > 10 CPTs exist
Q:(HBHCDX1=HBHCSP8)&(HBHCCPT1=HBHCSP5)
L +^HBHC(634,0):$S($D(DILOCKTM):DILOCKTM,1:3) Q:'$T S HBHCNDX1=$P(^HBHC(634,0),U,3)+1 F Q:'$D(^HBHC(634,HBHCNDX1)) S HBHCNDX1=HBHCNDX1+1
S $P(^HBHC(634,0),U,3)=HBHCNDX1,$P(^HBHC(634,0),U,4)=$P(^HBHC(634,0),U,4)+1 L -^HBHC(634,0)
;HBH*1.0*32 variable HBHCHOSP replaced by HBHCHOSPX
S HBHCREC=HBHCFORM_HBHCHOSPX_HBHCSSN_HBHCDATE_HBHCPRV_HBHCLNME_HBHCQAI_HBHCDX1_HBHCDX2_HBHCDX3_HBHCDX4_HBHCDX5_HBHCCPT1_HBHCCPT2_HBHCCPT3_HBHCCPT4_HBHCCPT5_HBHCCPT6_HBHCCPT7_HBHCCPT8_HBHCCPT9_HBHCCP10_HBHCSP64
S ^HBHC(634,HBHCNDX1,0)=HBHCREC,^HBHC(634,"B",$E(HBHCREC,1,30),HBHCNDX1)=""
; Flag record as filed
L +^HBHC(632,HBHCDFN,0):$S($D(DILOCKTM):DILOCKTM,1:3) Q:'$T K:HBHCXMT4]"" ^HBHC(632,"AC",HBHCXMT4,HBHCDFN) S $P(^HBHC(632,HBHCDFN,0),U,8)="F",^HBHC(632,"AC","F",HBHCDFN)="",$P(^HBHC(632,HBHCDFN,0),U,9)=HBHCTDY L -^HBHC(632,HBHCDFN,0)
; Initialize QAI, DX & CPT fields to spaces after 1st record written to avoid multiple count(s) of same data when > 5 DX or > 10 CPTs exist
S HBHCQAI=HBHCSP2
INIT ; Initialize variables
F HBHCK=1:1:5 S @("HBHCDX"_HBHCK)=HBHCSP8
S (HBHCCNT,HBHCCNT1)=0,HBHCCP10=HBHCSP5
F HBHCJ=1:1:9 S @("HBHCCPT"_HBHCJ)=HBHCSP5
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCXMV 4883 printed Dec 13, 2024@01:59:01 Page 2
HBHCXMV ;LR VAMC(IRMS)/MJT - POPULATE HBHC TRANSMIT FILE OR LOG PSEUDO SSN ERRORS; Feb 22, 2021@07:22
+1 ;;1.0;HOSPITAL BASED HOME CARE;**2,5,6,9,12,15,17,14,19,24,25,32**;NOV 01, 1993;Build 58
+2 ;
+3 ;Reference to:
+4 ; ^SC supported by ICR #10040
+5 ; ^DIC(4 supported by ICR #10090
+6 ; ^DG(40.8 supported by ICR #7024
+7 ;
+8 DO START^HBHCXMV1
LOOP ; Loop thru ^HBHC(632) "AC","N" cross-ref to create nodes in ^HBHC(634) => transmit
+1 SET HBHCDFN=""
FOR
SET HBHCDFN=$ORDER(^HBHC(632,"AC","N",HBHCDFN))
if HBHCDFN=""
QUIT
DO SETNODE
EXIT ; Exit module
+1 DO EXIT^HBHCXMV1
+2 QUIT
SETNODE ; Set node in ^HBHC(634) (Transmit)
+1 SET HBHCINFO=^HBHC(632,HBHCDFN,0)
SET HBHCXMT4=$PIECE(HBHCINFO,U,8)
SET HBHCAPDT=$PIECE(HBHCINFO,U,2)
SET HBHCSSN=$PIECE(^DPT($PIECE(HBHCINFO,U),0),U,9)
+2 ; cancelled/no show appointment
if $PIECE(HBHCINFO,U,7)]""
QUIT
+3 ; Visit appointment date > HBHCLSDT (last date to include in transmit set up in ^HBHCFILE)
if HBHCAPDT>HBHCLSDT
QUIT
+4 IF HBHCAPDT<2961001
DO PCE^HBHCXMV1
QUIT
+5 IF HBHCSSN'?9N
DO PSSN^HBHCXMV1
QUIT
+6 SET HBHCPRV=+^HBHC(631.4,$PIECE(HBHCINFO,U,4),0)
+7 ;HBH*1.0*32: pad provider number with leading zeroes instead of trailing spaces
+8 if $LENGTH(HBHCPRV)'=4
SET HBHCPRV=$EXTRACT("000",1,4-$LENGTH(HBHCPRV))_HBHCPRV
+9 ;HBH*1.0*32: HBHCHOSPX = division of visit location
+10 NEW HBHCHOSPX
+11 SET HBHCHOSPX=$PIECE(HBHCINFO,U,3)
+12 IF HBHCHOSPX]""
Begin DoDot:1
+13 SET HBHCHOSPX=$PIECE($GET(^SC(HBHCHOSPX,0)),U,15)
+14 if HBHCHOSPX=""
QUIT
+15 ;retrieve institution file pointer
+16 SET HBHCHOSPX=$PIECE($GET(^DG(40.8,HBHCHOSPX,0)),"^",7)
+17 if HBHCHOSPX=""
QUIT
+18 ;retrieve station number
+19 SET HBHCHOSPX=$PIECE($GET(^DIC(4,HBHCHOSPX,99)),U)
+20 if HBHCHOSPX=""
QUIT
+21 if $LENGTH(HBHCHOSPX)'=7
SET HBHCHOSPX=HBHCHOSPX_$EXTRACT(HBHCSP4,1,(7-($LENGTH(HBHCHOSPX))))
End DoDot:1
+22 ;if for some reason did not retrieve the institution's station number, use default.
+23 IF HBHCHOSPX=""
SET HBHCHOSPX=HBHCHOSP
+24 ;HBHC*1.0*32 end
+25 SET HBHCTIME=$PIECE(HBHCAPDT,".",2)
if $LENGTH(HBHCTIME)<4
SET HBHCTIME=HBHCTIME_$EXTRACT(HBHCZRO4,1,(4-($LENGTH(HBHCTIME))))
if $LENGTH(HBHCTIME)>4
SET HBHCTIME=$EXTRACT(HBHCTIME,1,4)
+26 SET HBHCDATE=$EXTRACT(HBHCAPDT,4,5)_$EXTRACT(HBHCAPDT,6,7)_(1700+$EXTRACT(HBHCAPDT,1,3))_HBHCTIME
+27 SET HBHCLNME=$PIECE($PIECE(^DPT($PIECE(HBHCINFO,U),0),U),",")
if $LENGTH(HBHCLNME)'=11
SET HBHCLNME=$SELECT($LENGTH(HBHCLNME)<11:HBHCLNME_$EXTRACT(HBHCSP10,1,11-$LENGTH(HBHCLNME)),1:$EXTRACT(HBHCLNME,1,11))
+28 SET HBHCQAI=$SELECT(($LENGTH($PIECE(HBHCINFO,U,16))=1)&($EXTRACT(HBHCINFO,U,16)=""):HBHCSP1_$PIECE(HBHCINFO,U,16),($LENGTH($PIECE(HBHCINFO,U,16))=1)&(...
... $EXTRACT(HBHCINFO,U,16)]""):$PIECE(HBHCINFO,U,16)_HBHCSP1,$LENGTH($PIECE(HBHCINFO,U,16))=2:$PIECE(HBHCINFO,U,16),1:HBHCSP2)
DX ; Dx
+1 DO INIT
DO DX^HBHCUTL3
+2 SET HBHCL=0
+3 FOR
SET HBHCL=$ORDER(HBHCDX(HBHCL))
if HBHCL'>0
QUIT
Begin DoDot:1
+4 SET HBHCDX=$PIECE(HBHCDX(HBHCL)," ")
+5 SET HBHCDX=$PIECE(HBHCDX,".")_$PIECE(HBHCDX,".",2)
+6 SET HBHCDX(HBHCL)=$SELECT($LENGTH(HBHCDX)'=8:HBHCDX_$EXTRACT(HBHCSP8,1,8-$LENGTH(HBHCDX)),1:HBHCDX)
End DoDot:1
+7 ; Note: HBHCI initialized here vs in CPT loop, since need HBHCI to continue for each 10 CPT code iteration
+8 SET (HBHCFLAG,HBHCI,HBHCL)=0
FOR
SET HBHCL=$ORDER(HBHCDX(HBHCL))
if HBHCL'>0
QUIT
SET HBHCCNT1=HBHCCNT1+1
SET @("HBHCDX"_HBHCCNT1)=HBHCDX(HBHCL)
if (HBHCCNT1=5)&('HBHCFLAG)
DO CPT
if HBHCCNT1=5
DO WRITE
+9 FOR
if 'HBHCFLAG
DO CPT
DO WRITE
if HBHCFLAG
QUIT
+10 QUIT
CPT ; CPT Codes
+1 FOR HBHCCNT=1:1:10
SET HBHCI=$ORDER(^HBHC(632,HBHCDFN,2,HBHCI))
if HBHCI'>0
QUIT
SET HBHCNOD2=^HBHC(632,HBHCDFN,2,HBHCI,0)
DO SET
+2 if HBHCI'>0
SET HBHCFLAG=1
+3 QUIT
SET ; Set CPT variables
+1 IF HBHCCNT<10
SET @("HBHCCPT"_HBHCCNT)=$SELECT($PIECE(HBHCNOD2,U)]"":$EXTRACT($PIECE($GET(^ICPT($PIECE(HBHCNOD2,U),0)),U),1,5),1:HBHCSP5)
if $LENGTH(@("HBHCCPT"_HBHCCNT))'=5
SET @("HBHCCPT"_HBHCCNT)=@("HBHCCPT"_HBHCCNT)_$EXTRACT(HBHCSP5,1,5-$LENGTH(@("HBHCCPT"_HBHCCNT)))
+2 IF HBHCCNT=10
SET HBHCCP10=$SELECT($PIECE(HBHCNOD2,U)]"":$EXTRACT($PIECE($GET(^ICPT($PIECE(HBHCNOD2,U),0)),U),1,5),1:HBHCSP5)
if $LENGTH(HBHCCP10)'=5
SET HBHCCP10=HBHCCP10_$EXTRACT(HBHCSP5,1,5-$LENGTH(HBHCCP10))
+3 QUIT
WRITE ; Write transmit record, separate records containing max 5 DX & 10 CPTs each are generated for same visit if > 5 DX or > 10 CPTs exist
+1 if (HBHCDX1=HBHCSP8)&(HBHCCPT1=HBHCSP5)
QUIT
+2 LOCK +^HBHC(634,0):$SELECT($DATA(DILOCKTM):DILOCKTM,1:3)
if '$TEST
QUIT
SET HBHCNDX1=$PIECE(^HBHC(634,0),U,3)+1
FOR
if '$DATA(^HBHC(634,HBHCNDX1))
QUIT
SET HBHCNDX1=HBHCNDX1+1
+3 SET $PIECE(^HBHC(634,0),U,3)=HBHCNDX1
SET $PIECE(^HBHC(634,0),U,4)=$PIECE(^HBHC(634,0),U,4)+1
LOCK -^HBHC(634,0)
+4 ;HBH*1.0*32 variable HBHCHOSP replaced by HBHCHOSPX
+5 SET HBHCREC=HBHCFORM_HBHCHOSPX_HBHCSSN_HBHCDATE_HBHCPRV_HBHCLNME_HBHCQAI_HBHCDX1_HBHCDX2_HBHCDX3_HBHCDX4_HBHCDX5_HBHCCPT1_HBHCCPT2_HBHCCPT3_HBHCCPT4_HBHCCPT5_HBHCCPT6_HBHCCPT7_HBHCCPT8_HBHCCPT9_HBHCCP10_HBHCSP64
+6 SET ^HBHC(634,HBHCNDX1,0)=HBHCREC
SET ^HBHC(634,"B",$EXTRACT(HBHCREC,1,30),HBHCNDX1)=""
+7 ; Flag record as filed
+8 LOCK +^HBHC(632,HBHCDFN,0):$SELECT($DATA(DILOCKTM):DILOCKTM,1:3)
if '$TEST
QUIT
if HBHCXMT4]""
KILL ^HBHC(632,"AC",HBHCXMT4,HBHCDFN)
SET $PIECE(^HBHC(632,HBHCDFN,0),U,8)="F"
SET ^HBHC(632,"AC","F",HBHCDFN)=""
SET $PIECE(^HBHC(632,HBHCDFN,0),U,9)=HBHCTDY
LOCK -^HBHC(632,HBHCDFN,0)
+9 ; Initialize QAI, DX & CPT fields to spaces after 1st record written to avoid multiple count(s) of same data when > 5 DX or > 10 CPTs exist
+10 SET HBHCQAI=HBHCSP2
INIT ; Initialize variables
+1 FOR HBHCK=1:1:5
SET @("HBHCDX"_HBHCK)=HBHCSP8
+2 SET (HBHCCNT,HBHCCNT1)=0
SET HBHCCP10=HBHCSP5
+3 FOR HBHCJ=1:1:9
SET @("HBHCCPT"_HBHCJ)=HBHCSP5
+4 QUIT
