| [613] | 1 | 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
|
|---|
| 2 | ;;1.0;HOSPITAL BASED HOME CARE;**6,8,15,16,14**;NOV 01, 1993
|
|---|
| 3 | ; calls PROV^HBHCUTL2, EN^HBHCUTL2, TOT^HBHCUTL2, FTOT^HBHCUTL2, DX^HBHCUTL3, CPT^HBHCUTL3
|
|---|
| 4 | D PROV^HBHCUTL2,EN^HBHCUTL2
|
|---|
| 5 | G:(%=-1)!($D(DTOUT))!($D(DUOUT)) EXIT
|
|---|
| 6 | D START^HBHCUTL
|
|---|
| 7 | G:(HBHCBEG1=-1)!(HBHCEND1=-1) EXIT
|
|---|
| 8 | S %ZIS="Q",HBHCCC=0 K IOP,ZTIO,ZTSAVE D ^%ZIS G:POP EXIT
|
|---|
| 9 | I $D(IO("Q")) S ZTRTN="DQ^HBHCRP4",ZTDESC="HBPC Visit Data Date Range Report",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT
|
|---|
| 10 | DQ ; De-queue
|
|---|
| 11 | U IO
|
|---|
| 12 | K ^TMP("HBHC",$J)
|
|---|
| 13 | 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
|
|---|
| 14 | LOOP ; Loop thru ^HBHC(632) "C" (visit date) cross-ref to build report
|
|---|
| 15 | S X1=HBHCBEG1,X2=-1 D C^%DTC S HBHCDATE=X_.9999
|
|---|
| 16 | 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
|
|---|
| 17 | I '$D(^TMP("HBHC",$J)) K HBHCNAM D HDRRANGE^HBHCUTL W !!,"No Visits found for Date Range selected."
|
|---|
| 18 | I $D(^TMP("HBHC",$J)) D PRTLOOP I '$D(HBHCPRVL) S HBHCTXT="All Providers Visit" D FTOT^HBHCUTL2
|
|---|
| 19 | D ENDRPT^HBHCUTL1
|
|---|
| 20 | EXIT ; Exit module
|
|---|
| 21 | D ^%ZISC
|
|---|
| 22 | 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
|
|---|
| 23 | K HBHCSUB,HBHCTDY,HBHCTEXT,HBHCTMP,HBHCTOT,HBHCTXT,HBHCWHO,HBHCWHOC,HBHCWHOS,HBHCXREF,HBHCY,HBHCZ,X,X1,X2,Y,^TMP("HBHC",$J),%
|
|---|
| 24 | Q
|
|---|
| 25 | PROCESS ; Process record & create ^TMP("HBHC",$J global
|
|---|
| 26 | S HBHCNOD0=^HBHC(632,HBHCDFN,0),HBHCDPT0=^DPT($P(HBHCNOD0,U),0)
|
|---|
| 27 | Q:$P(HBHCNOD0,U,7)]"" ; Q if cancelled appointment
|
|---|
| 28 | Q:($D(HBHCPRVL))&('$D(HBHCPRVL($P(HBHCNOD0,U,4)))) ; Q if not selected provider
|
|---|
| 29 | 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")
|
|---|
| 30 | S ^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,1)=$E($P(HBHCDPT0,U),1,21)_U_$E($P(HBHCDPT0,U,9),6,9)
|
|---|
| 31 | D DX^HBHCUTL3
|
|---|
| 32 | ; Note use of "DX" as subscript
|
|---|
| 33 | 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)
|
|---|
| 34 | D CPT^HBHCUTL3
|
|---|
| 35 | ; HBHCSUB must be initialized to 1, since node 1 is hardcoded above
|
|---|
| 36 | 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
|
|---|
| 37 | Q
|
|---|
| 38 | SETMOD ; Set TMP global with CPT Modifier info
|
|---|
| 39 | S ^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,HBHCSUB,HBHCJ)=HBHCCPTA(HBHCI,HBHCJ)
|
|---|
| 40 | Q
|
|---|
| 41 | PRTLOOP ; Print loop
|
|---|
| 42 | S HBHCPRV=""
|
|---|
| 43 | 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
|
|---|
| 44 | Q
|
|---|
| 45 | PRINT ; Print report
|
|---|
| 46 | K HBHCTMP
|
|---|
| 47 | S HBHCTMP(1)=^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,1)
|
|---|
| 48 | 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
|
|---|
| 49 | 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)
|
|---|
| 50 | ; HBHCI must be initialized to 1, since node 1 is hardcoded above
|
|---|
| 51 | S HBHCI=1
|
|---|
| 52 | 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)
|
|---|
| 53 | W !,HBHCY
|
|---|
| 54 | Q
|
|---|
| 55 | HDR ; Report header setup
|
|---|
| 56 | S HBHCPAGE=0,HBHCNAM=HBHCPRV,HBHCCLM1=(80-(16+$L(HBHCNAM))\2) S:HBHCCLM1'>0 HBHCCLM1=1
|
|---|
| 57 | W @IOF D HDRRANGE^HBHCUTL
|
|---|
| 58 | Q
|
|---|
| 59 | TOT ; Print total
|
|---|
| 60 | Q:HBHCTOT=0
|
|---|
| 61 | D TOT^HBHCUTL2
|
|---|
| 62 | Q
|
|---|
| 63 | CPTPRT ; CPT print
|
|---|
| 64 | D NEWPAGE
|
|---|
| 65 | W ! W:HBHCI=2 "CPT Code: " W ?13,^TMP("HBHC",$J,HBHCPRV,HBHCDATE,HBHCDFN,HBHCI)
|
|---|
| 66 | Q
|
|---|
| 67 | NEWPAGE ; Check if new page needed
|
|---|
| 68 | I ((IOSL-$Y)<8) W @IOF D HDRRANGE^HBHCUTL W !,HBHCMSG,!
|
|---|
| 69 | Q
|
|---|
