- HBHCRP4 ; LR VAMC(IRMS)/MJT-HBHC report on file 632, visit data by date range, sorted alphabetically by provider, then by visit date, includes all fields, & total ; Jan 2000
- ;;1.0;HOSPITAL BASED HOME CARE;**6,8,15,16,14**;NOV 01, 1993
- ; calls PROV^HBHCUTL2, EN^HBHCUTL2, TOT^HBHCUTL2, FTOT^HBHCUTL2, DX^HBHCUTL3, CPT^HBHCUTL3
- D PROV^HBHCUTL2,EN^HBHCUTL2
- G:(%=-1)!($D(DTOUT))!($D(DUOUT)) EXIT
- 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^HBHCRP4",ZTDESC="HBPC Visit Data Date Range Report",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT
- DQ ; De-queue
- U IO
- K ^TMP("HBHC",$J)
- S HBHCTEXT=" Modifier: - ",HBHCTXT="Visit",HBHCONE=1,(HBHCFTOT,HBHCTOT)=0,$P(HBHCY,"-",81)="",HBHCMSG="(continued from previous page...)",HBHCHEAD="Visit Data by Date Range",HBHCCOLM=(80-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1
- LOOP ; Loop thru ^HBHC(632) "C" (visit date) cross-ref to build report
- S X1=HBHCBEG1,X2=-1 D C^%DTC S HBHCDATE=X_.9999
- F S HBHCDATE=$O(^HBHC(632,"C",HBHCDATE)) Q:(HBHCDATE="")!($P(HBHCDATE,".")>HBHCEND1) S HBHCDFN="" F S HBHCDFN=$O(^HBHC(632,"C",HBHCDATE,HBHCDFN)) Q:HBHCDFN="" D PROCESS
- I '$D(^TMP("HBHC",$J)) K HBHCNAM D HDRRANGE^HBHCUTL W !!,"No Visits found for Date Range selected."
- I $D(^TMP("HBHC",$J)) D PRTLOOP I '$D(HBHCPRVL) S HBHCTXT="All Providers Visit" D FTOT^HBHCUTL2
- D ENDRPT^HBHCUTL1
- EXIT ; Exit module
- D ^%ZISC
- K DIC,DTOUT,DUOUT,HBHCBEG1,HBHCBEG2,HBHCCC,HBHCCLM1,HBHCCOLM,HBHCCPT,HBHCCPTA,HBHCDATE,HBHCDFN,HBHCDPT0,HBHCEND1,HBHCEND2,HBHCFILE,HBHCFTOT,HBHCHEAD,HBHCI,HBHCJ,HBHCMSG,HBHCNAM,HBHCNOD0,HBHCONE,HBHCPAGE,HBHCPRV,HBHCPRVL
- K HBHCSUB,HBHCTDY,HBHCTEXT,HBHCTMP,HBHCTOT,HBHCTXT,HBHCWHO,HBHCWHOC,HBHCWHOS,HBHCXREF,HBHCY,HBHCZ,X,X1,X2,Y,^TMP("HBHC",$J),%
- Q
- PROCESS ; Process record & create ^TMP("HBHC",$J global
- S HBHCNOD0=^HBHC(632,HBHCDFN,0),HBHCDPT0=^DPT($P(HBHCNOD0,U),0)
- Q:$P(HBHCNOD0,U,7)]"" ; Q if cancelled appointment
- Q:($D(HBHCPRVL))&('$D(HBHCPRVL($P(HBHCNOD0,U,4)))) ; Q if not selected provider
- 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)_" ("_$P(^HBHC(631.4,$P(HBHCNOD0,U,4),0),U)_")",1:"None")
- S ^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,1)=$E($P(HBHCDPT0,U),1,21)_U_$E($P(HBHCDPT0,U,9),6,9)
- D DX^HBHCUTL3
- ; Note use of "DX" as subscript
- S (HBHCSUB,HBHCI)=0 F S HBHCI=$O(HBHCDX(HBHCI)) Q:HBHCI'>0 S HBHCSUB=HBHCSUB+1,^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,"DX",HBHCI)=HBHCDX(HBHCI)
- D CPT^HBHCUTL3
- ; HBHCSUB must be initialized to 1, since node 1 is hardcoded above
- S HBHCSUB=1,HBHCI=0 F S HBHCI=$O(HBHCCPTA(HBHCI)) Q:HBHCI'>0 S HBHCSUB=HBHCSUB+1,^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,HBHCSUB)=HBHCCPTA(HBHCI) S HBHCJ=0 F S HBHCJ=$O(HBHCCPTA(HBHCI,HBHCJ)) Q:HBHCJ'>0 D SETMOD
- Q
- SETMOD ; Set TMP global with CPT Modifier info
- S ^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,HBHCSUB,HBHCJ)=HBHCCPTA(HBHCI,HBHCJ)
- Q
- PRTLOOP ; Print loop
- S HBHCPRV=""
- F S HBHCPRV=$O(^TMP("HBHC",$J,HBHCPRV)) D TOT Q:HBHCPRV="" D HDR S HBHCDATE="" F S HBHCDATE=$O(^TMP("HBHC",$J,HBHCPRV,HBHCDATE)) Q:HBHCDATE="" S HBHCDFN="" F S HBHCDFN=$O(^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN)) Q:HBHCDFN="" D PRINT
- Q
- PRINT ; Print report
- K HBHCTMP
- S HBHCTMP(1)=^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,1)
- W !,"Visit Date: ",$E(HBHCDATE,4,5)_"-"_$E(HBHCDATE,6,7)_"-"_(1700+$E(HBHCDATE,1,3)),?26,"Patient Name: ",$P(HBHCTMP(1),U),?67,"Last 4: ",$P(HBHCTMP(1),U,2) S HBHCTOT=HBHCTOT+1
- S HBHCI=0 F S HBHCI=$O(^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,"DX",HBHCI)) Q:HBHCI'>0 D NEWPAGE W ! W:HBHCI=1 "Diagnosis: " W ?13,^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,"DX",HBHCI)
- ; HBHCI must be initialized to 1, since node 1 is hardcoded above
- S HBHCI=1
- F S HBHCI=$O(^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,HBHCI)) Q:HBHCI'>0 D CPTPRT S HBHCJ=0 F S HBHCJ=$O(^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,HBHCI,HBHCJ)) Q:HBHCJ'>0 W !,HBHCTEXT,^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,HBHCI,HBHCJ)
- W !,HBHCY
- Q
- HDR ; Report header setup
- S HBHCPAGE=0,HBHCNAM=HBHCPRV,HBHCCLM1=(80-(16+$L(HBHCNAM))\2) S:HBHCCLM1'>0 HBHCCLM1=1
- W @IOF D HDRRANGE^HBHCUTL
- Q
- TOT ; Print total
- Q:HBHCTOT=0
- D TOT^HBHCUTL2
- Q
- CPTPRT ; CPT print
- D NEWPAGE
- W ! W:HBHCI=2 "CPT Code: " W ?13,^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,HBHCI)
- Q
- NEWPAGE ; Check if new page needed
- I ((IOSL-$Y)<8) W @IOF D HDRRANGE^HBHCUTL W !,HBHCMSG,!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHBHCRP4 4476 printed Feb 18, 2025@23:25:01 Page 2
- HBHCRP4 ; LR VAMC(IRMS)/MJT-HBHC report on file 632, visit data by date range, sorted alphabetically by provider, then by visit date, includes all fields, & total ; Jan 2000
- +1 ;;1.0;HOSPITAL BASED HOME CARE;**6,8,15,16,14**;NOV 01, 1993
- +2 ; calls PROV^HBHCUTL2, EN^HBHCUTL2, TOT^HBHCUTL2, FTOT^HBHCUTL2, DX^HBHCUTL3, CPT^HBHCUTL3
- +3 DO PROV^HBHCUTL2
- DO EN^HBHCUTL2
- +4 if (%=-1)!($DATA(DTOUT))!($DATA(DUOUT))
- GOTO EXIT
- +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^HBHCRP4"
- SET ZTDESC="HBPC Visit Data Date Range Report"
- SET ZTSAVE("HBHC*")=""
- DO ^%ZTLOAD
- GOTO EXIT
- DQ ; De-queue
- +1 USE IO
- +2 KILL ^TMP("HBHC",$JOB)
- +3 SET HBHCTEXT=" Modifier: - "
- SET HBHCTXT="Visit"
- SET HBHCONE=1
- SET (HBHCFTOT,HBHCTOT)=0
- SET $PIECE(HBHCY,"-",81)=""
- SET HBHCMSG="(continued from previous page...)"
- SET HBHCHEAD="Visit Data by Date Range"
- SET HBHCCOLM=(80-(30+$LENGTH(HBHCHEAD))\2)
- if HBHCCOLM'>0
- SET HBHCCOLM=1
- LOOP ; Loop thru ^HBHC(632) "C" (visit date) cross-ref to build report
- +1 SET X1=HBHCBEG1
- SET X2=-1
- DO C^%DTC
- SET HBHCDATE=X_.9999
- +2 FOR
- SET HBHCDATE=$ORDER(^HBHC(632,"C",HBHCDATE))
- if (HBHCDATE="")!($PIECE(HBHCDATE,".")>HBHCEND1)
- QUIT
- SET HBHCDFN=""
- FOR
- SET HBHCDFN=$ORDER(^HBHC(632,"C",HBHCDATE,HBHCDFN))
- if HBHCDFN=""
- QUIT
- DO PROCESS
- +3 IF '$DATA(^TMP("HBHC",$JOB))
- KILL HBHCNAM
- DO HDRRANGE^HBHCUTL
- WRITE !!,"No Visits found for Date Range selected."
- +4 IF $DATA(^TMP("HBHC",$JOB))
- DO PRTLOOP
- IF '$DATA(HBHCPRVL)
- SET HBHCTXT="All Providers Visit"
- DO FTOT^HBHCUTL2
- +5 DO ENDRPT^HBHCUTL1
- EXIT ; Exit module
- +1 DO ^%ZISC
- +2 KILL DIC,DTOUT,DUOUT,HBHCBEG1,HBHCBEG2,HBHCCC,HBHCCLM1,HBHCCOLM,HBHCCPT,HBHCCPTA,HBHCDATE,HBHCDFN,HBHCDPT0,HBHCEND1,HBHCEND2,HBHCFILE,HBHCFTOT,HBHCHEAD,HBHCI,HBHCJ,HBHCMSG,HBHCNAM,HBHCNOD0,HBHCONE,HBHCPAGE,HBHCPRV,HBHCPRVL
- +3 KILL HBHCSUB,HBHCTDY,HBHCTEXT,HBHCTMP,HBHCTOT,HBHCTXT,HBHCWHO,HBHCWHOC,HBHCWHOS,HBHCXREF,HBHCY,HBHCZ,X,X1,X2,Y,^TMP("HBHC",$JOB),%
- +4 QUIT
- PROCESS ; Process record & create ^TMP("HBHC",$J global
- +1 SET HBHCNOD0=^HBHC(632,HBHCDFN,0)
- SET HBHCDPT0=^DPT($PIECE(HBHCNOD0,U),0)
- +2 ; Q if cancelled appointment
- if $PIECE(HBHCNOD0,U,7)]""
- QUIT
- +3 ; Q if not selected provider
- if ($DATA(HBHCPRVL))&('$DATA(HBHCPRVL($PIECE(HBHCNOD0,U,4))))
- QUIT
- +4 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)_" ("_$PIECE(^HBHC(631.4,$PIECE(HBHCNOD0,U,4),0),U)_")",1:"None")
- +5 SET ^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE,HBHCDFN,1)=$EXTRACT($PIECE(HBHCDPT0,U),1,21)_U_$EXTRACT($PIECE(HBHCDPT0,U,9),6,9)
- +6 DO DX^HBHCUTL3
- +7 ; Note use of "DX" as subscript
- +8 SET (HBHCSUB,HBHCI)=0
- FOR
- SET HBHCI=$ORDER(HBHCDX(HBHCI))
- if HBHCI'>0
- QUIT
- SET HBHCSUB=HBHCSUB+1
- SET ^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE,HBHCDFN,"DX",HBHCI)=HBHCDX(HBHCI)
- +9 DO CPT^HBHCUTL3
- +10 ; HBHCSUB must be initialized to 1, since node 1 is hardcoded above
- +11 SET HBHCSUB=1
- SET HBHCI=0
- FOR
- SET HBHCI=$ORDER(HBHCCPTA(HBHCI))
- if HBHCI'>0
- QUIT
- SET HBHCSUB=HBHCSUB+1
- SET ^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE,HBHCDFN,HBHCSUB)=HBHCCPTA(HBHCI)
- SET HBHCJ=0
- FOR
- SET HBHCJ=$ORDER(HBHCCPTA(HBHCI,HBHCJ))
- if HBHCJ'>0
- QUIT
- DO SETMOD
- +12 QUIT
- SETMOD ; Set TMP global with CPT Modifier info
- +1 SET ^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE,HBHCDFN,HBHCSUB,HBHCJ)=HBHCCPTA(HBHCI,HBHCJ)
- +2 QUIT
- PRTLOOP ; Print loop
- +1 SET HBHCPRV=""
- +2 FOR
- SET HBHCPRV=$ORDER(^TMP("HBHC",$JOB,HBHCPRV))
- DO TOT
- if HBHCPRV=""
- QUIT
- DO HDR
- SET HBHCDATE=""
- FOR
- SET HBHCDATE=$ORDER(^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE))
- if HBHCDATE=""
- QUIT
- SET HBHCDFN=""
- FOR
- SET HBHCDFN=$ORDER(^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE,HBHCDFN))
- if HBHCDFN=""
- QUIT
- DO PRINT
- +3 QUIT
- PRINT ; Print report
- +1 KILL HBHCTMP
- +2 SET HBHCTMP(1)=^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE,HBHCDFN,1)
- +3 WRITE !,"Visit Date: ",$EXTRACT(HBHCDATE,4,5)_"-"_$EXTRACT(HBHCDATE,6,7)_"-"_(1700+$EXTRACT(HBHCDATE,1,3)),?26,"Patient Name: ",$PIECE(HBHCTMP(1),U),?67,"Last 4: ",$PIECE(HBHCTMP(1),U,2)
- SET HBHCTOT=HBHCTOT+1
- +4 SET HBHCI=0
- FOR
- SET HBHCI=$ORDER(^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE,HBHCDFN,"DX",HBHCI))
- if HBHCI'>0
- QUIT
- DO NEWPAGE
- WRITE !
- if HBHCI=1
- WRITE "Diagnosis: "
- WRITE ?13,^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE,HBHCDFN,"DX",HBHCI)
- +5 ; HBHCI must be initialized to 1, since node 1 is hardcoded above
- +6 SET HBHCI=1
- +7 FOR
- SET HBHCI=$ORDER(^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE,HBHCDFN,HBHCI))
- if HBHCI'>0
- QUIT
- DO CPTPRT
- SET HBHCJ=0
- FOR
- SET HBHCJ=$ORDER(^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE,HBHCDFN,HBHCI,HBHCJ))
- if HBHCJ'>0
- QUIT
- WRITE !,HBHCTEXT,^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE,HBHCDFN,HBHCI,HBHCJ)
- +8 WRITE !,HBHCY
- +9 QUIT
- HDR ; Report header setup
- +1 SET HBHCPAGE=0
- SET HBHCNAM=HBHCPRV
- SET HBHCCLM1=(80-(16+$LENGTH(HBHCNAM))\2)
- if HBHCCLM1'>0
- SET HBHCCLM1=1
- +2 WRITE @IOF
- DO HDRRANGE^HBHCUTL
- +3 QUIT
- TOT ; Print total
- +1 if HBHCTOT=0
- QUIT
- +2 DO TOT^HBHCUTL2
- +3 QUIT
- CPTPRT ; CPT print
- +1 DO NEWPAGE
- +2 WRITE !
- if HBHCI=2
- WRITE "CPT Code: "
- WRITE ?13,^TMP("HBHC",$JOB,HBHCPRV,HBHCDATE,HBHCDFN,HBHCI)
- +3 QUIT
- NEWPAGE ; Check if new page needed
- +1 IF ((IOSL-$Y)<8)
- WRITE @IOF
- DO HDRRANGE^HBHCUTL
- WRITE !,HBHCMSG,!
- +2 QUIT
