HBHXMNT3 ;VAMC(IRMS)/MJT-HBHC maintenance routine prints report of patients with pseudo SSN, includes: patient name, SSN, form & corresponding date, called from HBHXMNT2 ;9403
;;1.0;HOSPITAL BASED HOME CARE;**2**;NOV 01,1993
K ^TMP("HBHC",$J)
; Max length for HBHCHEAD = 50
S HBHCCC=0,$P(HBHCY,"-",81)="",HBHCPAGE=0,HBHCHEAD="Pseudo SSN Patch Related",HBHCHDR="W ""Patient Name"",?35,""SSN"",?51,""Form"",?62,""Date""",HBHCCOLM=(80-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1 D TODAY^HBHCUTL
D:IO'=IO(0)!($D(IO("S"))) HDRPAGE^HBHCUTL
I '$D(IO("S")),(IO=IO(0)) S HBHCCC=HBHCCC+1 W @IOF D HDRPAGE^HBHCUTL
S HBHCDPT=0
F S HBHCDPT=$O(^HBHC(634.5,"B",HBHCDPT)) Q:HBHCDPT'>0 F HBHCFILE=631,632 S HBHCDFN=0 F S HBHCDFN=$O(^HBHC(HBHCFILE,"B",HBHCDFN)) Q:HBHCDFN'>0 S HBHCIEN=0 F S HBHCIEN=$O(^HBHC(HBHCFILE,"B",HBHCDFN,HBHCIEN)) Q:HBHCIEN'>0 D PROCESS
D PRTLOOP,ENDRPT^HBHCUTL1
EXIT ; Exit module
D ^%ZISC
K HBHCCC,HBHCCOLM,HBHCDATE,HBHCDFN,HBHCDPT,HBHCDPT0,HBHCFILE,HBHCFORM,HBHCHEAD,HBHCHDR,HBHCIEN,HBHCINFO,HBHCNAME,HBHCPAGE,HBHCSSN,HBHCTDY,HBHCY,HBHCZ,Y,^TMP("HBHC",$J)
Q
PROCESS ; Process records
S HBHCINFO=^HBHC(HBHCFILE,HBHCIEN,0),HBHCDPT0=^DPT($P(HBHCINFO,U),0),HBHCSSN=$P(HBHCDPT0,U,9)
Q:HBHCSSN?9N
I HBHCFILE=631 S:$D(^HBHC(HBHCFILE,"AE","F",HBHCIEN)) ^TMP("HBHC",$J,3,$P(HBHCDPT0,U),$P(HBHCINFO,U,2))=$E(HBHCSSN,1,3)_"-"_$E(HBHCSSN,4,5)_"-"_$E(HBHCSSN,6,10)
I HBHCFILE=631 S:($D(^HBHC(HBHCFILE,"AF","F",HBHCIEN)))&('$D(^HBHC(HBHCFILE,"AE","F",HBHCIEN))) ^TMP("HBHC",$J,5,$P(HBHCDPT0,U),$P(HBHCINFO,U,40))=$E(HBHCSSN,1,3)_"-"_$E(HBHCSSN,4,5)_"-"_$E(HBHCSSN,6,10)
I HBHCFILE=632 S:$D(^HBHC(HBHCFILE,"AC","F",HBHCIEN)) ^TMP("HBHC",$J,4,$P(HBHCDPT0,U),$P(HBHCINFO,U,2))=$E(HBHCSSN,1,3)_"-"_$E(HBHCSSN,4,5)_"-"_$E(HBHCSSN,6,10)
Q
PRTLOOP ; Print loop
S HBHCFORM=0
F S HBHCFORM=$O(^TMP("HBHC",$J,HBHCFORM)) Q:HBHCFORM'>0 S HBHCNAME="" F S HBHCNAME=$O(^TMP("HBHC",$J,HBHCFORM,HBHCNAME)) Q:HBHCNAME="" S HBHCDATE=0 F S HBHCDATE=$O(^TMP("HBHC",$J,HBHCFORM,HBHCNAME,HBHCDATE)) Q:HBHCDATE'>0 D PRINT
Q
PRINT ; Print report
I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5) W @IOF D HDRPAGE^HBHCUTL
I (IOSL-$Y)<5 W @IOF D HDRPAGE^HBHCUTL
S Y=HBHCDATE D DD^%DT
W !,HBHCNAME,?35,^TMP("HBHC",$J,HBHCFORM,HBHCNAME,HBHCDATE),?51,HBHCFORM,?62,Y,!,HBHCY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHXMNT3 2302 printed Sep 23, 2025@19:35:09 Page 2
HBHXMNT3 ;VAMC(IRMS)/MJT-HBHC maintenance routine prints report of patients with pseudo SSN, includes: patient name, SSN, form & corresponding date, called from HBHXMNT2 ;9403
+1 ;;1.0;HOSPITAL BASED HOME CARE;**2**;NOV 01,1993
+2 KILL ^TMP("HBHC",$JOB)
+3 ; Max length for HBHCHEAD = 50
+4 SET HBHCCC=0
SET $PIECE(HBHCY,"-",81)=""
SET HBHCPAGE=0
SET HBHCHEAD="Pseudo SSN Patch Related"
SET HBHCHDR="W ""Patient Name"",?35,""SSN"",?51,""Form"",?62,""Date"""
SET HBHCCOLM=(80-(30+$LENGTH(HBHCHEAD))\2)
if HBHCCOLM'>0
SET HBHCCOLM=1
DO TODAY^HBHCUTL
+5 if IO'=IO(0)!($DATA(IO("S")))
DO HDRPAGE^HBHCUTL
+6 IF '$DATA(IO("S"))
IF (IO=IO(0))
SET HBHCCC=HBHCCC+1
WRITE @IOF
DO HDRPAGE^HBHCUTL
+7 SET HBHCDPT=0
+8 FOR
SET HBHCDPT=$ORDER(^HBHC(634.5,"B",HBHCDPT))
if HBHCDPT'>0
QUIT
FOR HBHCFILE=631,632
SET HBHCDFN=0
FOR
SET HBHCDFN=$ORDER(^HBHC(HBHCFILE,"B",HBHCDFN))
if HBHCDFN'>0
QUIT
SET HBHCIEN=0
FOR
SET HBHCIEN=$ORDER(^HBHC(HBHCFILE,"B",HBHCDFN,HBHCIEN))
if HBHCIEN'>0
QUIT
DO PROCESS
+9 DO PRTLOOP
DO ENDRPT^HBHCUTL1
EXIT ; Exit module
+1 DO ^%ZISC
+2 KILL HBHCCC,HBHCCOLM,HBHCDATE,HBHCDFN,HBHCDPT,HBHCDPT0,HBHCFILE,HBHCFORM,HBHCHEAD,HBHCHDR,HBHCIEN,HBHCINFO,HBHCNAME,HBHCPAGE,HBHCSSN,HBHCTDY,HBHCY,HBHCZ,Y,^TMP("HBHC",$JOB)
+3 QUIT
PROCESS ; Process records
+1 SET HBHCINFO=^HBHC(HBHCFILE,HBHCIEN,0)
SET HBHCDPT0=^DPT($PIECE(HBHCINFO,U),0)
SET HBHCSSN=$PIECE(HBHCDPT0,U,9)
+2 if HBHCSSN?9N
QUIT
+3 IF HBHCFILE=631
if $DATA(^HBHC(HBHCFILE,"AE","F",HBHCIEN))
SET ^TMP("HBHC",$JOB,3,$PIECE(HBHCDPT0,U),$PIECE(HBHCINFO,U,2))=$EXTRACT(HBHCSSN,1,3)_"-"_$EXTRACT(HBHCSSN,4,5)_"-"_$EXTRACT(HBHCSSN,6,10)
+4 IF HBHCFILE=631
if ($DATA(^HBHC(HBHCFILE,"AF","F",HBHCIEN)))&('$DATA(^HBHC(HBHCFILE,"AE","F",HBHCIEN)))
SET ^TMP("HBHC",$JOB,5,$PIECE(HBHCDPT0,U),$PIECE(HBHCINFO,U,40))=$EXTRACT(HBHCSSN,1,3)_"-"_$EXTRACT(HBHCSSN,4,5)_"-"_$EXTRACT(HBHCSSN,6,10)
+5 IF HBHCFILE=632
if $DATA(^HBHC(HBHCFILE,"AC","F",HBHCIEN))
SET ^TMP("HBHC",$JOB,4,$PIECE(HBHCDPT0,U),$PIECE(HBHCINFO,U,2))=$EXTRACT(HBHCSSN,1,3)_"-"_$EXTRACT(HBHCSSN,4,5)_"-"_$EXTRACT(HBHCSSN,6,10)
+6 QUIT
PRTLOOP ; Print loop
+1 SET HBHCFORM=0
+2 FOR
SET HBHCFORM=$ORDER(^TMP("HBHC",$JOB,HBHCFORM))
if HBHCFORM'>0
QUIT
SET HBHCNAME=""
FOR
SET HBHCNAME=$ORDER(^TMP("HBHC",$JOB,HBHCFORM,HBHCNAME))
if HBHCNAME=""
QUIT
SET HBHCDATE=0
FOR
SET HBHCDATE=$ORDER(^TMP("HBHC",$JOB,HBHCFORM,HBHCNAME,HBHCDATE))
if HBHCDATE'>0
QUIT
DO PRINT
+3 QUIT
PRINT ; Print report
+1 IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<5)
WRITE @IOF
DO HDRPAGE^HBHCUTL
+2 IF (IOSL-$Y)<5
WRITE @IOF
DO HDRPAGE^HBHCUTL
+3 SET Y=HBHCDATE
DO DD^%DT
+4 WRITE !,HBHCNAME,?35,^TMP("HBHC",$JOB,HBHCFORM,HBHCNAME,HBHCDATE),?51,HBHCFORM,?62,Y,!,HBHCY
+5 QUIT
