1 | HBHCRP1B ; LR VAMC(IRMS)/MJT-HBHC report on files 634.1, 634.2, & 634.3, (Form 3/4/5 (A/V/D respectively) Error(s)), called by HBHCRP1A, entry points: START, SETUP, PRTLOOP, EXIT ; April 2000
|
---|
2 | ;;1.0;HOSPITAL BASED HOME CARE;**6,8,10,16**;NOV 01, 1993
|
---|
3 | START ; Entry point
|
---|
4 | K ^TMP("HBHC",$J)
|
---|
5 | ; Max length for HBHCHEAD = 50
|
---|
6 | S $P(HBHCSP2," ",3)="",$P(HBHCSP3," ",4)="",HBHCTEXT=" Modifier: - ",$P(HBHCY,"-",81)="",HBHCPAGE=0,HBHCHEAD="Form Errors"
|
---|
7 | S HBHCHDR="W ""Patient"",?27,""Last"",!,""File IEN"",?10,""Patient Name"",?27,""Four"",?34,""Visit Clinic Name"",?55,""Date"",?75,""Form"""
|
---|
8 | S HBHCCOLM=(80-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1 D TODAY^HBHCUTL
|
---|
9 | Q
|
---|
10 | SETUP ; Setup variables
|
---|
11 | S HBHCFORM=$S(HBHCFILE=634.1:"A",HBHCFILE=634.2:"V",1:"D"),HBHCFL=$S(HBHCFORM="V":634.2,1:631),HBHCPC=$S(HBHCFORM="D":40,HBHCFORM="V":5,1:18)
|
---|
12 | Q
|
---|
13 | PRTLOOP ; Print loop
|
---|
14 | D:IO'=IO(0)!($D(IO("S"))) HDRPAGE^HBHCUTL
|
---|
15 | I '$D(IO("S")),(IO=IO(0)) S HBHCCC=HBHCCC+1 D HDRPAGE^HBHCUTL
|
---|
16 | S HBHCFORM=""
|
---|
17 | F S HBHCFORM=$O(^TMP("HBHC",$J,HBHCFORM)) Q:HBHCFORM="" D SETTXT S HBHCCLN="" F S HBHCCLN=$O(^TMP("HBHC",$J,HBHCFORM,HBHCCLN)) Q:HBHCCLN="" S HBHCDAT="" F S HBHCDAT=$O(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT)) Q:HBHCDAT="" D LOOP2
|
---|
18 | Q
|
---|
19 | SETTXT ; Set text
|
---|
20 | S HBHCTXT=$S(HBHCFORM="A":"E/Adm",HBHCFORM="V":"Visit",1:"D/C")
|
---|
21 | Q
|
---|
22 | LOOP2 ; Continuation of PRTLOOP
|
---|
23 | S HBHCNAME="" F S HBHCNAME=$O(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME)) Q:HBHCNAME="" S HBHCSSN="" F S HBHCSSN=$O(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN)) Q:HBHCSSN="" D PRINT
|
---|
24 | Q
|
---|
25 | PRINT ; Print report
|
---|
26 | S HBHCINFO=^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,1)
|
---|
27 | I ($D(ZTRTN)!(HBHCCC=0))&((IOSL-$Y)<12) W @IOF D HDRPAGE^HBHCUTL
|
---|
28 | W !,$J($P(HBHCINFO,U),8),?10,HBHCNAME,?27,HBHCSSN,?34,HBHCCLN,?55,$P(HBHCINFO,U,2)," ",?75,HBHCTXT W:$P(HBHCINFO,U,3)]"" !,"Error: ",$P(HBHCINFO,U,3)
|
---|
29 | I HBHCFORM'="V" W !,HBHCY Q
|
---|
30 | ; provider
|
---|
31 | F HBHCI=1:1 S HBHCINFO=$G(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,2,HBHCI)) Q:HBHCINFO="" W !,"Provider: ",$P(HBHCINFO,"$"),?54,"Encounter Prov #:",?72,$J($P(HBHCINFO,"$",2),8)
|
---|
32 | ; Dx
|
---|
33 | F HBHCI=1:1 S HBHCINFO=$G(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,3,HBHCI)) Q:HBHCINFO="" W !,"ICD9: ",HBHCINFO
|
---|
34 | ; CPT code
|
---|
35 | F HBHCI=1:1 S HBHCINFO=$G(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,4,HBHCI)) Q:HBHCINFO="" D CPT F HBHCJ=1:1 S HBHCINFO=$G(^TMP("HBHC",$J,HBHCFORM,HBHCCLN,HBHCDAT,HBHCNAME,HBHCSSN,4,HBHCI,HBHCJ)) Q:HBHCINFO="" D MOD
|
---|
36 | W !,HBHCY
|
---|
37 | Q
|
---|
38 | CPT ; Write CPT info
|
---|
39 | W !?1,"CPT: ",$P(HBHCINFO,"$"),?45,"QTY: ",$J($P(HBHCINFO,"$",2),3),?55,"CPT Code Prov #:",?72,$J($P(HBHCINFO,"$",3),8)
|
---|
40 | Q
|
---|
41 | MOD ; Write Modifier info
|
---|
42 | W !,HBHCTEXT,HBHCINFO
|
---|
43 | Q
|
---|
44 | EXIT ; Exit module
|
---|
45 | D ^%ZISC
|
---|
46 | K DA,DIK,HBHCCC,HBHCCLN,HBHCCOLM,HBHCCPT,HBHCCPTL,HBHCDAT,HBHCDATE,HBHCDFN,HBHCDPT,HBHCDPT0,HBHCDX1,HBHCDXL,HBHCFILE,HBHCFL,HBHCFORM,HBHCHDR,HBHCHEAD,HBHCI,HBHCICDP,HBHCIEN,HBHCINFO,HBHCJ,HBHCK,HBHCMOD,HBHCMSG,HBHCNAME,HBHCNOD0
|
---|
47 | K HBHCOEP,HBHCPAGE,HBHCPC,HBHCPRV,HBHCPRV1,HBHCPRVL,HBHCPRVP,HBHCSP2,HBHCSP3,HBHCSSN,HBHCTDY,HBHCTEXT,HBHCTXT,HBHCY,HBHCZ,X,Y,^TMP("HBHC",$J)
|
---|
48 | Q
|
---|