source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDPPDIS2.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.0 KB
RevLine 
[613]1SDPPDIS2 ;ALB/CAW - Patient Profile - Disposition (con't) ; 5/12/92
2 ;;5.3;Scheduling;**6,386**;Aug 13, 1993
3 ;
4 ;
5NEED ; Need Related to Occupation and Need Related to Accident
6 ;D ^sdppdis2 Q
7 S X="",X=$$SETSTR^VALM1("Need Rel. to Occ.:",X,1,18)
8 S SDYN=$S($P(SDDIS(2),U)="N":"NO",$P(SDDIS(2),U)="Y":"YES",1:"UNKNOWN")
9 S X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
10 S X=$$SETSTR^VALM1("Need Rel. to Acc.:",X,41,18)
11 S SDYN=$S($P(SDDIS(2),U,4)="N":"NO",$P(SDDIS(2),U,4)="Y":"YES",1:"UNKNOWN")
12 S X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)
13 D SET^SDPPDIS1(X)
14 ;
15STATUS ; Status of disposition
16 S SDSTATUS=$P($G(^SCE(+$P(SDDIS(0),U,18),0)),U,12)
17 S SDSTATUS=$P($G(^SD(409.63,+SDSTATUS,0)),U)
18 I SDSTATUS]"" D
19 .S X="",X=$$SETSTR^VALM1("Status:",X,12,18)
20 .S X=$$SETSTR^VALM1(SDSTATUS,X,SDFST,SDLEN)
21 .D SET^SDPPDIS1(X)
22 ;
23WORK ; Workmans Comp. Claim and Injury Caused By
24 S X=""
25 I $P(SDDIS(2),U)="Y",$P(SDDIS(2),U,2)'="" D
26 .S X=$$SETSTR^VALM1("Work. Comp. Claim:",X,1,18)
27 .S SDYN=$S($P(SDDIS(2),U,2)="N":"NO",$P(SDDIS(2),U,2)="Y":"YES",1:"UNKNOWN")
28 .S X=$$SETSTR^VALM1(SDYN,X,SDFST,SDLEN)
29 I $P(SDDIS(2),U,4)="Y",$P(SDDIS(2),U,5)'="" D
30 .S X=$$SETSTR^VALM1("Injury Caused By:",X,42,17)
31 .S X=$$SETSTR^VALM1($P(SDDIS(2),U,5),X,SDSEC,SDLEN)
32 D:X'="" SET^SDPPDIS1(X)
33WORKN ; Workmans Comp. Number and Injury Parties Insurance
34 S X=""
35 I $P(SDDIS(2),U)="Y",$P(SDDIS(2),U,3)'="" D
36 .S X=$$SETSTR^VALM1("Work. Comp. Num.:",X,2,17)
37 .S X=$$SETSTR^VALM1($P(SDDIS(2),U,3),X,SDFST,SDLEN)
38 I $P(SDDIS(2),U,4)="Y",$P(SDDIS(2),U,6)'="" D
39 .S X=$$SETSTR^VALM1("Inj. Parties Ins.:",X,41,18)
40 .S X=$$SETSTR^VALM1("UNSUPPORTED",X,SDSEC,SDLEN)
41 D:X'="" SET^SDPPDIS1(X)
42ATTN ; Attorney Info and Filed Against Party
43 S X=""
44 I $P(SDDIS(2),U,4)="Y",$P(SDDIS(3),U)'="" D
45 .S X=$$SETSTR^VALM1("Attorney Info:",X,5,14)
46 I $P(SDDIS(2),U,4)="Y",$P(SDDIS(2),U,7)'="" D
47 .S X=$$SETSTR^VALM1("Filed Against Pty:",X,41,18)
48 .S SDYN=$S($P(SDDIS(2),U,2)="N":"NO",$P(SDDIS(2),U,2)="Y":"YES",1:"UNKNOWN")
49 .S X=$$SETSTR^VALM1(SDYN,X,SDSEC,SDLEN)
50 D:X'="" SET^SDPPDIS1(X)
51AADD ; Attorney Address
52 S X=""
53 I $P(SDDIS(2),U,4)="Y",$P(SDDIS(3),U)'="" D
54 .S X="",X=$$SETSTR^VALM1($P(SDDIS(3),U),X,5,30) D SET^SDPPDIS1(X)
55 I $P(SDDIS(2),U,4)="Y",$P(SDDIS(3),U,2)'="" D
56 .S X="",X=$$SETSTR^VALM1($P(SDDIS(3),U,2),X,5,30) D SET^SDPPDIS1(X)
57 I $P(SDDIS(2),U,4)="Y",$P(SDDIS(3),U,3)'="" D
58 .S X="",X=$$SETSTR^VALM1($P(SDDIS(3),U,3),X,5,30) D SET^SDPPDIS1(X)
59 I $P(SDDIS(2),U,4)="Y",$P(SDDIS(3),U,4)'="" D
60 .S X="",X=$$SETSTR^VALM1($P(SDDIS(3),U,4),X,5,30) D SET^SDPPDIS1(X)
61 I $P(SDDIS(2),U,4)="Y",$P(SDDIS(3),U,5)'="" D
62 .S SDADD=$P(SDDIS(3),U,5)
63 I $P(SDDIS(2),U,4)="Y",$P(SDDIS(3),U,6)'="" D
64 .S SDADD=$G(SDADD)_$S($G(SDADD):", ",1:"")_$P($G(^DIC(5,+$P(SDDIS(3),U,6),0)),U)
65 I $P(SDDIS(2),U,4)="Y",$P(SDDIS(3),U,7)'="" D
66 .S SDADD=$G(SDADD)_" "_$P(SDDIS(3),U,7)
67 I $P(SDDIS(2),U,4)="Y",$D(SDADD) S X="",X=$$SETSTR^VALM1(SDADD,X,5,70) D SET^SDPPDIS1(X)
68 I $P(SDDIS(2),U,4)="Y",$P(SDDIS(3),U,8)'="" D
69 .S X="",X=$$SETSTR^VALM1($P(SDDIS(3),U,8),X,5,20) D SET^SDPPDIS1(X)
70 D SET^SDPPDIS1("")
71 Q
Note: See TracBrowser for help on using the repository browser.