| 1 | HBHCR15A ;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
|
|---|
| 12 | DQ ; 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""")
|
|---|
| 16 | LOOP ; 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
|
|---|
| 19 | EXIT ; 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
|
|---|
| 24 | PROCESS ; 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
|
|---|
| 31 | FORM3 ; 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
|
|---|
| 41 | FORM4 ; 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
|
|---|
| 52 | NAME ; 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
|
|---|
| 56 | FORM5 ; 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
|
|---|
| 65 | FORM6 ; 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
|
|---|
| 77 | SET ; 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
|
|---|
