source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQPSE04.m@ 691

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1VAQPSE04 ;ALB/JRP,JFP - EXPORTED PDX ROUTINE;9-FEB-94
2 ;;1.5;PATIENT DATA EXCHANGE;**1**;NOV 17, 1993
3IBAPDX1 ;ALB/CPM - BUILD DISPLAY SET FOR EXTRACTED PDX BILLING DATA ; 09-APR-93
4 ;;Version 1.5 ; INTEGRATED BILLING ;**15**; 29-JUL-92
5 ;
6DISP(IN,SPTR,OUT,OFF) ; PDX Entry Point to build output array from extract.
7 ; Input: IN -- Root for the input extract array
8 ; OUT -- Root for the output display array
9 ; OFF -- Offset to begin line-numbering
10 ; SPTR -- Pointer to extracted segment in file #394.71
11 ; Output: NUM -- Number of lines in the output display array, or
12 ; -1^err -- if an error was encountered.
13 ;
14 N NUM,IBCT,IBCTR,IBDOL,IBDT,IBFR,IBHDR,IBI,IBST,IBTO,X
15 I $G(IN)="" S NUM="-1^Did not pass root for the input extract array." G DISPQ
16 I $G(OUT)="" S NUM="-1^Did not pass root for the output display array." G DISPQ
17 I '$D(OFF) S NUM="-1^Did not pass the offset line number." G DISPQ
18 I '$G(SPTR) S NUM="-1^Did not pass the extraction segment pointer." G DISPQ
19 ;
20 ; - build display header
21 S IBTTL=$P($G(^VAT(394.71,+SPTR,0)),"^"),IBCTR="< "_$S(IBTTL]"":IBTTL,1:"Segment Description Missing")_" >"
22 S @OUT@("DISPLAY",+OFF,0)=$$CENTER^VAQDIS20($TR($J("",79)," ","-"),IBCTR)
23 S @OUT@("DISPLAY",+OFF+1,0)=""
24 S @OUT@("DISPLAY",+OFF+2,0)=$J("",24)_"MEANS TEST BILLING INFORMATION"
25 S @OUT@("DISPLAY",+OFF+3,0)=""
26 ;
27 ; - build continuous patient display
28 I @IN@("VALUE",351.1,.01,0)="" S NUM=4 G CLOCK
29 S IBDT=@IN@("VALUE",351.1,.02,0)
30 I IBDT="" S @OUT@("DISPLAY",+OFF+4,0)=" ** This patient has been continuously hospitalized since 7/1/86 **",@OUT@("DISPLAY",+OFF+5,0)="",NUM=6 G CLOCK
31 S @OUT@("DISPLAY",+OFF+4,0)="This patient was a continuous patient up through "_IBDT_" (No longer continuous)",@OUT@("DISPLAY",+OFF+5,0)="",NUM=6
32 ;
33CLOCK ; - build active billing clock data display
34 I @IN@("VALUE",351,.01,0)="" S @OUT@("DISPLAY",+OFF+NUM,0)=" --- This patient has no current Means Test Billing activity ---",NUM=NUM+1 G DISPQ
35 S @OUT@("DISPLAY",+OFF+NUM,0)="Means Test Active Billing Clock Information:",NUM=NUM+1
36 S @OUT@("DISPLAY",+OFF+NUM,0)=$TR($J("",80)," ","-"),NUM=NUM+1
37 S @OUT@("DISPLAY",+OFF+NUM,0)=" Clock Start Date: "_@IN@("VALUE",351,.03,0)_$J("",14)_"Inpatient Days: "_@IN@("VALUE",351,.09,0),NUM=NUM+1
38 S @OUT@("DISPLAY",+OFF+NUM,0)="",NUM=NUM+1
39 S @OUT@("DISPLAY",+OFF+NUM,0)=" Medicare Deductible Co-payments:",NUM=NUM+1
40 S IBDOL=@IN@("VALUE",351,.05,0)
41 S @OUT@("DISPLAY",+OFF+NUM,0)=$J("",15)_"1st 90 days: $"_IBDOL_$J("",13+(3-$L(IBDOL)))_"3rd 90 days: $"_@IN@("VALUE",351,.07,0),NUM=NUM+1
42 S IBDOL=@IN@("VALUE",351,.06,0)
43 S @OUT@("DISPLAY",+OFF+NUM,0)=$J("",15)_"2nd 90 days: $"_IBDOL_$J("",13+(3-$L(IBDOL)))_"4th 90 days: $"_@IN@("VALUE",351,.08,0),NUM=NUM+1
44 S @OUT@("DISPLAY",+OFF+NUM,0)=$TR($J("",80)," ","-"),NUM=NUM+1
45 S @OUT@("DISPLAY",+OFF+NUM,0)="",NUM=NUM+1
46 S @OUT@("DISPLAY",+OFF+NUM,0)="",NUM=NUM+1
47 ;
48 ; - build list of charges billed in active billing clock period
49 I @IN@("VALUE",350,.01,0)="" S @OUT@("DISPLAY",+OFF+NUM,0)=" --- There were no charges billed during this active billing clock period ---",NUM=NUM+1 G DISPQ
50 S @OUT@("DISPLAY",+OFF+NUM,0)="Charges Billed in this Active Billing Clock Period:",NUM=NUM+1
51 S @OUT@("DISPLAY",+OFF+NUM,0)=$TR($J("",80)," ","-"),NUM=NUM+1
52 S @OUT@("DISPLAY",+OFF+NUM,0)=" Bill From Bill To Charge Type"_$J("",15)_"Status"_$J("",13)_"Charge",NUM=NUM+1
53 S @OUT@("DISPLAY",+OFF+NUM,0)=$TR($J("",80)," ","-"),NUM=NUM+1
54 ;
55 F IBI=0:1 Q:'$D(@IN@("VALUE",350,.01,IBI)) D
56 .S IBFR=@IN@("VALUE",350,.14,IBI),IBTO=@IN@("VALUE",350,.15,IBI)
57 .S IBCT=@IN@("VALUE",350,.03,IBI),IBST=@IN@("VALUE",350,.05,IBI)
58 .S X=" "_$S(IBFR]"":IBFR,1:$J("",8))_" "_$S(IBTO]"":IBTO,1:$J("",8))_" "
59 .S X=X_IBCT_$J("",(26-$L(IBCT)))_IBST_$J("",(19-$L(IBST)))
60 .S X=X_$S(IBCT["CANCEL":"($",1:" $")_@IN@("VALUE",350,.07,IBI)_$S(IBCT["CANCEL":")",1:"")
61 .S @OUT@("DISPLAY",+OFF+NUM,0)=X,NUM=NUM+1
62 ;
63DISPQ Q NUM
Note: See TracBrowser for help on using the repository browser.