source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YSPP1.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1YSPP1 ;ALB/ASF-PATIENT INQUIRY-PART 2 KIN ; 2/15/89 09:29 ;07/30/93 15:10
2 ;;5.01;MENTAL HEALTH;;Dec 30, 1994
3 ;
4 S YSFHDR="Next of Kin, Employment, Claim Number Data <<section 2>>" D ENHD^YSFORM
5ENCE ; Called indirectly from YSCEN31
6 ;
7 I $P(A(.15),U,2)?7N W !?20,"PATIENT LISTED AS INELIGIBLE",$C(7,7)
8NOK ;
9 W !?3,"NEXT OF KIN: ",$P(A(.21),U),?40,"KIN-2: ",$P(A(.211),U)
10 W !," RELATIONSHIP: ",$P(A(.21),U,2),?40,"RELATION: ",$P(A(.211),U,2)
11 S X=.21,X1=1,X2=3 D MOVE S X=.211,X1=5,X2=3 D MOVE
12 W !?16,S(1),?45,S(5),!?16,S(2),?45,S(6),!?16,S(3),?45,S(7),!?16,$$ZIP4^YSPP(+YSDFN,7,S(4)),?45,$$ZIP4^YSPP(+YSDFN,2,S(8))
13 W !," K1 PHONE: ",$P(A(.21),U,9),?40,"K2 PHONE: ",$P(A(.211),U,9)
14EMP ;
15 W !!," EMP: ",$P(A(.311),U),?40,"DESIGNEE: ",$P(A(.34),U)
16 W !," OCCUPAT: ",$P(A(0),U,7),?40,"RELATION: ",$P(A(.34),U,2) S X=.311,X1=1,X2=3 D MOVE S X=.34,X1=5,X2=3 D MOVE
17 W !,$S($P(A(.311),U,2)="Y":"(GOVNMT)",1:""),?10,S(1),?47,S(5)
18 W !?10,$$ZIP4^YSPP(+YSDFN,3,S(2)),?47,$$ZIP4^YSPP(+YSDFN,6,S(6)),!?10,S(3),?47,S(7),!?10,S(4),?47,S(8)
19 W !," E PHONE: ",$P(A(.311),U,9),?38,"D PHONE: ",$P(A(.34),U,9)
20 W !!,"",?7,"CLAIM #: ",$P(A(.31),U,3),?29,"LOCATION: ",$$CFL(+$G(YSDFN))
21 W !," SERVICE CON: ",$S($P(A(.3),U)?1"Y".E:"YES "_(+$P(A(.3),U,2))_"%",1:"NO"),?30,"PAYMENT: $",$J($P(A(.3),U,3),3,2)
22PAR ;
23 W !,"FATHER: ",$P(A(.24),U),?40,"MOTHER: ",$P(A(.24),U,2),!?32,"MOTHERS MAIDEN: ",$P(A(.24),U,3)
24 Q:$D(YSNOFORM) D WAIT1^YSUTL:'YST,ENFT^YSFORM:YST Q
25MOVE ;
26 S S(X1)=$P(A(X),U,X2),S(X1+1)=$P(A(X),U,X2+1),S(X1+2)=$P(A(X),U,X2+2),S(X1+3)=$P(A(X),U,X2+3)_$S($D(^DIC(5,+$P(A(X),U,X2+4),0)):", "_$P(^(0),U,2),1:"")_" "_$P(A(X),U,X2+5)
27 S:S(X1+2)="" S(X1+2)=S(X1+3),S(X1+3)="" S:S(X1+1)="" S(X1+1)=S(X1+2),S(X1+2)=S(X1+3),S(X1+3)="" S:S(X1)="" S(X1)=S(X1+1),S(X1+1)=S(X1+2),S(X1+2)=S(X1+3),S(X1+3)=""
28 Q
29 ;
30CFL(DFN) ; Claim Folder Location
31 QUIT:$G(DFN)'>0 "" ;->
32 N YSDATA
33 ;
34 ; Get NEW Claim Folder Location...
35 K YSDATA
36 S DIC=2,DR=.314,DA=+DFN,DIQ="YSDATA",DIQ(0)="E"
37 D EN^DIQ1
38 S X=$G(YSDATA(2,+DFN,.314,"E")) I X]"" QUIT X
39 ;
40 ; Still here? must not be a NEW Claim Folder Location...
41 ; Get the old Claim Folder Location
42 K YSDATA
43 S DIC=2,DR=.312,DA=+DFN,DIQ="YSDATA",DIQ(0)="E"
44 D EN^DIQ1
45 S X=$G(YSDATA(2,+DFN,.312,"E"))
46 QUIT X
47 ;
Note: See TracBrowser for help on using the repository browser.