source: FOIAVistA/trunk/r/HOSPITAL_BASED_HOME_CARE-HBH/HBHCR15A.m@ 1757

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1HBHCR15A ;LR VAMC(IRMS)/MJT-HBHC rpt using file 634.6, user selects date/forms from last 12 transmit batchs, fields: form#, pat name, last 4, form date, + action on form 3, prov #, & prov name on visits, & Adm or D/C on form 6 ;2/5/98 15:23
2 ;;1.0;HOSPITAL BASED HOME CARE;**6,8,9,13,15**;NOV 01, 1993
3 ; Calls HBHCR15B
4 ; Report can also be generated by Transmit File option [HBHCXMT] if default printer is defined in sys param (631.9). If no printer defined, no report. User selects forms to include, date is transmit date
5 ; HBHCXMT calls entry points: PROMPT2^HBHCR15B & DQ^HBHCR15A
6 I '$D(^HBHC(634.6,"C")) W *7,!,"No transmit history data on file." H 3 Q
7 I $P(^HBHC(631.9,1,0),U,6)]"" W *7,!,"Transmission in progress; history data being updated. Please try again later." H 3 Q
8 D PROMPT1^HBHCR15B
9 G:$D(DIRUT) EXIT
10 S %ZIS="Q" D ^%ZIS G:POP EXIT
11 I $D(IO("Q")) S ZTRTN="DQ^HBHCR15A",ZTDESC="HBPC Transmit Report",ZTSAVE("HBHC*")="" D ^%ZTLOAD G EXIT
12DQ ; De-queue
13 U IO
14 S (HBHCPAGE,HBHCCNTA,HBHCCNTR,HBHCCNT4,HBHCCNT5,HBHCCNT6)=0,$P(HBHCY,"-",81)="",HBHCCOLM=(80-(30+$L(HBHCHEAD))\2) S:HBHCCOLM'>0 HBHCCOLM=1
15 S HBHCHDR=$S(HBHCDIR="S":"W ?36,""Summary""",1:"W ?31,""Last"",!?4,""#"",?8,""Patient Name"",?31,""Four"",?38,""Date""")
16LOOP ; Loop thru HBHC(634.6,"C" (transmit date) cross-ref to build report
17 S HBHCIEN=0 F S HBHCIEN=$O(^HBHC(634.6,"C",HBHCXMDT,HBHCIEN)) Q:HBHCIEN'>0 S HBHCINFO=$P(^HBHC(634.6,HBHCIEN,0),U) D PROCESS
18 D END^HBHCR15B
19EXIT ; Exit module
20 D ^%ZISC
21 K DIR,DIRUT,HBHC,HBHCACTN,HBHCCC,HBHCCNT,HBHCCNTA,HBHCCNTR,HBHCCNT4,HBHCCNT5,HBHCCNT6,HBHCCOLM,HBHCDATE,HBHCDFN,HBHCDIR,HBHCDSDT,HBHCFLG,HBHCFORM,HBHCHEAD,HBHCHDR,HBHCI,HBHCIEN,HBHCINFO,HBHCIOP,HBHCLST4,HBHCNAME,HBHCPAGE
22 K HBHCPIEN,HBHCPRV,HBHCPRVN,HBHCTDY,HBHCTIME,HBHCTYPE,HBHCXMDT,HBHCY,HBHCY0,HBHCZ,X,Y,TMP,^TMP("HBHC",$J),^TMP($J)
23 Q
24PROCESS ; Process records
25 S (HBHCACTN,HBHCPRV)="Z",(HBHCPRVN,HBHCTIME,HBHCTYPE)=""
26 D:($E(HBHCINFO)=3)&((HBHCDIR=3)!(HBHCDIR="A")!(HBHCDIR="S")) FORM3
27 D:($E(HBHCINFO)=4)&((HBHCDIR=4)!(HBHCDIR="A")!(HBHCDIR="S")) FORM4
28 D:($E(HBHCINFO)=5)&((HBHCDIR=5)!(HBHCDIR="A")!(HBHCDIR="S")) FORM5
29 D:($E(HBHCINFO)=6)&((HBHCDIR=6)!(HBHCDIR="A")!(HBHCDIR="S")) FORM6
30 Q
31FORM3 ; Process Form 3 (Admission) records
32 S HBHCDATE=$E(HBHCINFO,18,25)
33 S:$E(HBHCINFO,55)=1 HBHCCNTA=HBHCCNTA+1,HBHCACTN="Admit"
34 S:$E(HBHCINFO,55)=2 HBHCCNTR=HBHCCNTR+1,HBHCACTN="Reject"
35 Q:HBHCDIR="S"
36 S HBHCFORM="A"
37 S HBHCDFN="" F S HBHCDFN=$O(^DPT("SSN",$E(HBHCINFO,9,17),HBHCDFN)) Q:HBHCDFN="" S HBHCNAME=$E($P(^DPT(HBHCDFN,0),U),1,20)
38 S HBHCLST4=$E(HBHCINFO,14,17)
39 D SET
40 Q
41FORM4 ; Process Form 4 (Visit) records
42 S HBHCCNT4=HBHCCNT4+1
43 S HBHCFORM="V"
44 S HBHCDFN="" F S HBHCDFN=$O(^DPT("SSN",$E(HBHCINFO,9,17),HBHCDFN)) Q:HBHCDFN="" S HBHCNAME=$E($P(^DPT(HBHCDFN,0),U),1,20)
45 S HBHCLST4=$E(HBHCINFO,14,17)
46 S HBHCDATE=$E(HBHCINFO,18,25)
47 S HBHCTIME=$E(HBHCINFO,26,27)_":"_$E(HBHCINFO,28,29)
48 S HBHCPRVN=+$E(HBHCINFO,30,33)
49 S (HBHCFLG,HBHCPIEN)=0 F S HBHCPIEN=$O(^HBHC(631.4,"B",HBHCPRVN,HBHCPIEN)) Q:HBHCPIEN'>0 D NAME
50 D SET
51 Q
52NAME ; Form 4 Name
53 I HBHCFLG=1 S HBHCPRV="** Duplicate Prov #" Q
54 S HBHCFLG=1,HBHCPRV=$E($P(^VA(200,$P(^HBHC(631.4,HBHCPIEN,0),U,2),0),U),1,20)
55 Q
56FORM5 ; Process Form 5 (Discharge) records
57 S HBHCCNT5=HBHCCNT5+1
58 Q:HBHCDIR="S"
59 S HBHCFORM="D"
60 S HBHCDFN="" F S HBHCDFN=$O(^DPT("SSN",$E(HBHCINFO,9,17),HBHCDFN)) Q:HBHCDFN="" S HBHCNAME=$E($P(^DPT(HBHCDFN,0),U),1,20)
61 S HBHCLST4=$E(HBHCINFO,14,17)
62 S HBHCDATE=$E(HBHCINFO,18,25)
63 D SET
64 Q
65FORM6 ; Process Form 6 (Correction) records
66 S HBHCCNT6=HBHCCNT6+1
67 Q:HBHCDIR="S"
68 S HBHCFORM=6
69 S HBHCDFN="" F S HBHCDFN=$O(^DPT("SSN",$E(HBHCINFO,9,17),HBHCDFN)) Q:HBHCDFN="" S HBHCNAME=$E($P(^DPT(HBHCDFN,0),U),1,20)
70 S HBHCLST4=$E(HBHCINFO,14,17)
71 S HBHCDSDT=$TR($E(HBHCINFO,56,63)," ","")
72 ; Use Discharge date if exists, otherwise use Admission date
73 S HBHCDATE=$S(HBHCDSDT]"":HBHCDSDT,1:$E(HBHCINFO,18,25))
74 S HBHCTYPE=$S(HBHCDSDT]"":"Discharge",1:"Evaluation/Admission")
75 D SET
76 Q
77SET ; Set TMP node
78 ; By design, records are processed/printed in the following order by form number: 6, 3 (A), 5 (D), 4 (V)
79 S:HBHCDIR'="S" ^TMP("HBHC",$J,HBHCFORM,HBHCACTN,HBHCNAME,HBHCLST4,HBHCDATE,HBHCPRV,HBHCIEN)=HBHCPRVN_U_HBHCTYPE_U_HBHCTIME
80 S:HBHCFORM="V" ^TMP($J,HBHCNAME,HBHCLST4,HBHCDATE_HBHCTIME,HBHCPRV)=""
81 Q
Note: See TracBrowser for help on using the repository browser.