source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRRPSIC.m@ 862

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

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1DGRRPSIC ; ALB/SGG - rtnDGRR PatientServices Incompetent ;09/30/03 ; Compiled October 21, 2003 15:06:51
2 ;;5.3;Registration;**557**;Aug 13, 1993
3 ;
4DOC ;<DataSet Name='Incompetent'
5 ;
6 ;.293 RATED INCOMPETENT? (S), [.29;12]
7 ; '0' FOR NO
8 ; '1' FOR YES
9 ;
10 ;.291 DATE RULED INCOMPETENT (VA) (D), [.29;1]
11 ;.2911 INSTITUTION (VA) (P4'), [.29;3]
12 ;.2912 GUARDIAN (VA) (F), [.29;4]
13 ;.2913 RELATIONSHIP (VA) (F), [.29;5]
14 ;.2914 STREET ADDRESS 1 (VA) (F), [.29;6]
15 ;.2915 STREET ADDRESS 2 (VA) (F), [.29;7]
16 ;.2916 CITY (VA) (F), [.29;8]
17 ;.2917 STATE (VA) (P5'), [.29;9]
18 ;.2918 ZIP (VA) (F), [.29;10]
19 ;.29013 ZIP+4 (VA) (FOX), [.29;13]
20 ;.2919 PHONE (VA) (F), [.29;11]
21 ;
22 ;.292 DATE RULED INCOMPETENT (CIVIL) (D), [.29;2]
23 ;.2921 INSTITUTION (CIVIL) (F), [.291;3]
24 ;.2922 GUARDIAN (CIVIL) (F), [.291;4]
25 ;.2923 RELATIONSHIP (CIVIL) (F), [.291;5]
26 ;.2924 STREET ADDRESS 1 (CIVIL) (F), [.291;6]
27 ;.2925 STREET ADDRESS 2 (CIVIL) (F), [.291;7]
28 ;.2926 CITY (CIVIL) (F), [.291;8]
29 ;.2927 STATE (CIVIL) (P5'), [.291;9]
30 ;.2928 ZIP (CIVIL) (F), [.291;10]
31 ;.290012 ZIP+4 (CIVIL) (FOX), [.291;12]
32 ;.2929 PHONE (CIVIL) (F), [.291;11]
33 ;
34GETPSARY(PSARRAY) ;
35 NEW CNT
36 SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='Incompetent'"
37 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RatedIncompetent^"_$$RATEDIC()
38 DO INCOMP("VETERAN",GLOB(.29),1,13) ; VA
39 DO INCOMP("CIVIL",GLOB(.291),2,12) ; Civil
40 SET CNT=$G(CNT)+1,PSARRAY(CNT)="></DataSet>"_"^^^1"
41 QUIT
42 ;
43INCOMP(ICTYPE,ADGLOB,DTPIECE,ZIP4) ;
44 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DateRuledIncompetent"_$E(ICTYPE,1)_"^"_$P(GLOB(.29),"^",DTPIECE)
45 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Institution"_$E(ICTYPE,1)_"^"_$$ADINST()
46 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Guardian"_$E(ICTYPE,1)_"^"_$P(ADGLOB,"^",4)
47 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RelationshipToPatient"_$E(ICTYPE,1)_"^"_$P(ADGLOB,"^",5)
48 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street1"_$E(ICTYPE,1)_"^"_$P(ADGLOB,"^",6)
49 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street2"_$E(ICTYPE,1)_"^"_$P(ADGLOB,"^",7)
50 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^City"_$E(ICTYPE,1)_"^"_$P(ADGLOB,"^",8)
51 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^State"_$E(ICTYPE,1)_"^"_$$ADSTATE()
52 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Zip"_$E(ICTYPE,1)_"^"_$$ADZIP()
53 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^PhoneNumber"_$E(ICTYPE,1)_"^"_$P(ADGLOB,"^",11)
54 QUIT
55 ;
56RATEDIC() ;
57 NEW DATA
58 SET DATA=$P(GLOB(.29),"^",12)
59 SET DATA=$S(DATA=1:"YES",DATA=0:"NO",1:"")
60 QUIT DATA
61 ;
62 ;
63ADINST() ;
64 NEW DATA
65 SET DATA=$P(ADGLOB,"^",3)
66 IF ICTYPE="VETERAN",DATA'="" SET DATA=$P($$NS^XUAF4(+DATA),"^",1)
67 QUIT DATA
68 ;
69ADSTATE() ;
70 NEW DATA
71 SET DATA=$P(ADGLOB,"^",9)
72 IF DATA'="" SET DATA=$P($G(^DIC(5,DATA,0)),"^",2)
73 QUIT DATA
74 ;
75 Q
76ADZIP() ;
77 NEW DATA
78 SET DATA=$P(ADGLOB,"^",ZIP4)
79 IF DATA="" SET DATA=$P(ADGLOB,"^",10)
80 QUIT DATA
81 Q
Note: See TracBrowser for help on using the repository browser.