- HBHCRP3 ; LR VAMC(IRMS)/MJT-HBHC report on file 632, individual patient visit data by date range, includes all fields, calls DX^HBHCUTL3, DX80^HBHCUTL3, CPT^HBHCUTL3 ; Jan 2000
- ;;1.0;HOSPITAL BASED HOME CARE;**6,8,15,16,14,22**;NOV 01, 1993;Build 2
- PROMPT ; Prompt user for patient name
- K DIC S DIC="^DPT(",DIC(0)="AEMQ",HBHCCC=0 D ^DIC
- G:Y=-1 EXIT
- S HBHCDPT=+Y
- I '$D(^HBHC(632,"B",HBHCDPT)) W *7,!!,"This patient has no visits on file.",!! H 3 G PROMPT
- D START^HBHCUTL
- G:(HBHCBEG1=-1)!(HBHCEND1=-1) EXIT
- S %ZIS="Q",HBHCCC=0 K IOP,ZTIO,ZTSAVE D ^%ZIS G:POP EXIT
- I $D(IO("Q")) S ZTRTN="DQ^HBHCRP3",ZTDESC="HBPC Patient Visit Data Report",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT
- DQ ; De-queue
- U IO
- S $P(HBHCY,"-",81)="",$P(HBHCZ,"=",81)="",$P(HBHCSP2," ",3)="",HBHCMSG="(continued from previous page...)"
- S HBHCDPT0=^DPT(HBHCDPT,0),HBHCINFO=$P(HBHCDPT0,U)_HBHCSP2_$E($P(HBHCDPT0,U,9),6,9)
- S HBHCHEAD="Patient: "_HBHCINFO_" Visit Data",HBHCCOLM=(80-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1
- D:IO'=IO(0)!($D(IO("S"))) HDRRANGE^HBHCUTL
- I '$D(IO("S")),IO=IO(0) S HBHCCC=HBHCCC+1 D HDRRANGE^HBHCUTL
- LOOP ; Loop thru ^HBHC(632) "B" cross-ref to build report
- S HBHCDFN="" F S HBHCDFN=$O(^HBHC(632,"B",HBHCDPT,HBHCDFN)) Q:HBHCDFN="" S HBHCNOD0=^HBHC(632,HBHCDFN,0) D:$P(HBHCNOD0,U,7)="" PROCESS
- D ENDRPT^HBHCUTL1
- EXIT ; Exit module
- D ^%ZISC
- K DIC,HBHCBEG1,HBHCBEG2,HBHCCC,HBHCCOLM,HBHCCPT,HBHCCPTA,HBHCDFN,HBHCDPT,HBHCDPT0,HBHCEND1,HBHCEND2,HBHCHEAD,HBHCI,HBHCINFO,HBHCJ,HBHCMSG,HBHCNOD0,HBHCPAGE,HBHCPRV,HBHCSP2,HBHCTDY,HBHCY,HBHCZ,X,Y
- Q
- PROCESS ; Process record
- Q:($E($P(HBHCNOD0,U,2),1,7)<HBHCBEG1)!($E($P(HBHCNOD0,U,2),1,7)>HBHCEND1)
- I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<8) W @IOF D HDRRANGE^HBHCUTL
- S HBHCPRV=$S($P(HBHCNOD0,U,4)]"":$E($P(^VA(200,$P(^HBHC(631.4,$P(HBHCNOD0,U,4),0),U,2),0),U),1,23),1:"")
- D WRITE,DX^HBHCUTL3,DX80^HBHCUTL3,CPT^HBHCUTL3,CPT80
- Q
- WRITE ; Write record info
- W !,"Visit Date: ",$S($P(HBHCNOD0,U,2)]"":$E($P(HBHCNOD0,U,2),4,5)_"-"_$E($P(HBHCNOD0,U,2),6,7)_"-"_(1700+$E($P(HBHCNOD0,U,2),1,3)),1:""),?27,"Prov No.: ",$P(^HBHC(631.4,$P(HBHCNOD0,U,4),0),U),?45,"Prov Name: ",HBHCPRV
- Q
- CPT80 ; Print CPT info in 80 column format
- S HBHCI=0 F S HBHCI=$O(HBHCCPTA(HBHCI)) Q:HBHCI'>0 D:(IOSL-$Y)<8 HDRCONT W !,"CPT Code: ",?13,HBHCCPTA(HBHCI) S HBHCJ=0 F S HBHCJ=$O(HBHCCPTA(HBHCI,HBHCJ)) Q:HBHCJ'>0 W !," Modifier: - ",HBHCCPTA(HBHCI,HBHCJ)
- W !,HBHCY
- Q
- HDRCONT ; Print header info when record continued to new page
- W @IOF D HDRRANGE^HBHCUTL W !,HBHCMSG,!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRP3 2557 printed Mar 13, 2025@21:03:24 Page 2
- HBHCRP3 ; LR VAMC(IRMS)/MJT-HBHC report on file 632, individual patient visit data by date range, includes all fields, calls DX^HBHCUTL3, DX80^HBHCUTL3, CPT^HBHCUTL3 ; Jan 2000
- +1 ;;1.0;HOSPITAL BASED HOME CARE;**6,8,15,16,14,22**;NOV 01, 1993;Build 2
- PROMPT ; Prompt user for patient name
- +1 KILL DIC
- SET DIC="^DPT("
- SET DIC(0)="AEMQ"
- SET HBHCCC=0
- DO ^DIC
- +2 if Y=-1
- GOTO EXIT
- +3 SET HBHCDPT=+Y
- +4 IF '$DATA(^HBHC(632,"B",HBHCDPT))
- WRITE *7,!!,"This patient has no visits on file.",!!
- HANG 3
- GOTO PROMPT
- +5 DO START^HBHCUTL
- +6 if (HBHCBEG1=-1)!(HBHCEND1=-1)
- GOTO EXIT
- +7 SET %ZIS="Q"
- SET HBHCCC=0
- KILL IOP,ZTIO,ZTSAVE
- DO ^%ZIS
- if POP
- GOTO EXIT
- +8 IF $DATA(IO("Q"))
- SET ZTRTN="DQ^HBHCRP3"
- SET ZTDESC="HBPC Patient Visit Data Report"
- SET ZTSAVE("HBHC*")=""
- DO ^%ZTLOAD
- GOTO EXIT
- DQ ; De-queue
- +1 USE IO
- +2 SET $PIECE(HBHCY,"-",81)=""
- SET $PIECE(HBHCZ,"=",81)=""
- SET $PIECE(HBHCSP2," ",3)=""
- SET HBHCMSG="(continued from previous page...)"
- +3 SET HBHCDPT0=^DPT(HBHCDPT,0)
- SET HBHCINFO=$PIECE(HBHCDPT0,U)_HBHCSP2_$EXTRACT($PIECE(HBHCDPT0,U,9),6,9)
- +4 SET HBHCHEAD="Patient: "_HBHCINFO_" Visit Data"
- SET HBHCCOLM=(80-(30+$LENGTH(HBHCHEAD))\2)
- if HBHCCOLM'>0
- SET HBHCCOLM=1
- +5 if IO'=IO(0)!($DATA(IO("S")))
- DO HDRRANGE^HBHCUTL
- +6 IF '$DATA(IO("S"))
- IF IO=IO(0)
- SET HBHCCC=HBHCCC+1
- DO HDRRANGE^HBHCUTL
- LOOP ; Loop thru ^HBHC(632) "B" cross-ref to build report
- +1 SET HBHCDFN=""
- FOR
- SET HBHCDFN=$ORDER(^HBHC(632,"B",HBHCDPT,HBHCDFN))
- if HBHCDFN=""
- QUIT
- SET HBHCNOD0=^HBHC(632,HBHCDFN,0)
- if $PIECE(HBHCNOD0,U,7)=""
- DO PROCESS
- +2 DO ENDRPT^HBHCUTL1
- EXIT ; Exit module
- +1 DO ^%ZISC
- +2 KILL DIC,HBHCBEG1,HBHCBEG2,HBHCCC,HBHCCOLM,HBHCCPT,HBHCCPTA,HBHCDFN,HBHCDPT,HBHCDPT0,HBHCEND1,HBHCEND2,HBHCHEAD,HBHCI,HBHCINFO,HBHCJ,HBHCMSG,HBHCNOD0,HBHCPAGE,HBHCPRV,HBHCSP2,HBHCTDY,HBHCY,HBHCZ,X,Y
- +3 QUIT
- PROCESS ; Process record
- +1 if ($EXTRACT($PIECE(HBHCNOD0,U,2),1,7)<HBHCBEG1)!($EXTRACT($PIECE(HBHCNOD0,U,2),1,7)>HBHCEND1)
- QUIT
- +2 IF ($DATA(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<8)
- WRITE @IOF
- DO HDRRANGE^HBHCUTL
- +3 SET HBHCPRV=$SELECT($PIECE(HBHCNOD0,U,4)]"":$EXTRACT($PIECE(^VA(200,$PIECE(^HBHC(631.4,$PIECE(HBHCNOD0,U,4),0),U,2),0),U),1,23),1:"")
- +4 DO WRITE
- DO DX^HBHCUTL3
- DO DX80^HBHCUTL3
- DO CPT^HBHCUTL3
- DO CPT80
- +5 QUIT
- WRITE ; Write record info
- +1 WRITE !,"Visit Date: ",$SELECT($PIECE(HBHCNOD0,U,2)]"":$EXTRACT($PIECE(HBHCNOD0,U,2),4,5)_"-"_$EXTRACT($PIECE(HBHCNOD0,U,2),6,7)_"-"_(1700+...
- ... $EXTRACT($PIECE(HBHCNOD0,U,2),1,3)),1:""),?27,"Prov No.: ",$PIECE(^HBHC(631.4,$PIECE(HBHCNOD0,U,4),0),U),?45,"Prov Name: ",HBHCPRV
- +2 QUIT
- CPT80 ; Print CPT info in 80 column format
- +1 SET HBHCI=0
- FOR
- SET HBHCI=$ORDER(HBHCCPTA(HBHCI))
- if HBHCI'>0
- QUIT
- if (IOSL-$Y)<8
- DO HDRCONT
- WRITE !,"CPT Code: ",?13,HBHCCPTA(HBHCI)
- SET HBHCJ=0
- FOR
- SET HBHCJ=$ORDER(HBHCCPTA(HBHCI,HBHCJ))
- if HBHCJ'>0
- QUIT
- WRITE !," Modifier: - ",HBHCCPTA(HBHCI,HBHCJ)
- +2 WRITE !,HBHCY
- +3 QUIT
- HDRCONT ; Print header info when record continued to new page
- +1 WRITE @IOF
- DO HDRRANGE^HBHCUTL
- WRITE !,HBHCMSG,!
- +2 QUIT
