source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRRPSAC.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: 3.7 KB
Line 
1DGRRPSAC() ; ALB/SGG rtnDGRR PatientServices Address Confidential ; 09/30/03 ; Compiled October 2, 2003 12:40:53
2 ;;5.3;Registration;**557**;Aug 13, 1993
3 ;
4DOC ;<DataSet Name='ConfidentialAddress'
5 ;.1411 CONFIDENTIAL STREET [LINE 1] (FX), [.141;1]
6 ;.1412 CONFIDENTIAL STREET [LINE 2] (FX) [.141;2]
7 ;.1413 CONFIDENTIAL STREET [LINE 3] (FX) [.141;3]
8 ;.1414 CONFIDENTIAL ADDRESS CITY (FX) [.141;4]
9 ;.1415 CONFIDENTIAL ADDRESS STATE (P5'X) [.141;5]
10 ;.1416 CONFIDENTIAL ADDRESS ZIP CODE (FXO) [.141;6]
11 ;.14111 CONFIDENTIAL ADDRESS COUNTY (NJ3,0OX) [.141;11]
12 ;.1417 CONFIDENTIAL START DATE (DX) [.141;7]
13 ;.1418 CONFIDENTIAL END DATE (DX) [.141;8]
14 ;.141 CONFIDENTIAL ADDRESS CATEGORY (Multiple-2.141) [.14;0]
15 ; .01 CONFIDENTIAL ADDRESS CATEGORY (MS), [0;1]
16 ; 1 CONFIDENTIAL CATEGORY ACTIVE (S), [0;2]
17 ; 1 CONFIDENTIAL CATEGORY ACTIVE (S) [0;2]
18 ; 'Y' FOR YES;
19 ; 'N' FOR NO;
20 ; .01 CONFIDENTIAL ADDRESS CATEGORY (MS) [0;1]
21 ; '1' FOR ELIGIBILITY/ENROLLMENT
22 ; '2' FOR APPOINTMENT/SCHEDULING
23 ; '3' FOR COPAYMENTS/VETERAN BILLING
24 ; '4' FOR MEDICAL RECORDS
25 ; '5' FOR ALL OTHERS
26 ;
27GETPSARY(PSARRAY) ;
28 NEW CNT
29 SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='ConfidentialAddress'"
30 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street1^"_$$ACSTRE1()
31 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street2^"_$$ACSTRE2()
32 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street3^"_$$ACSTRE3()
33 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^City^"_$$ACCITY()
34 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^State^"_$$ACSTATE()
35 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Zip^"_$$ACZIP()
36 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^County^"_$$ACCOUNTY()
37 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^StartDate^"_$$ACSTDATE()
38 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^EndDate^"_$$ACENDATE()
39 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^BadAddressIndicator^"
40 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^ConfidentialAddressActive^"
41 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^PhoneNumber^"
42 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^HomePhoneNumber^"
43 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^WorkPhoneNumber^"
44 SET CNT=$G(CNT)+1,PSARRAY(CNT)=">"
45 DO ACCAC
46 SET CNT=$G(CNT)+1,PSARRAY(CNT)="</DataSet>"_"^^^1"
47 QUIT
48 ;
49ACSTRE1() ;
50 QUIT $P(GLOB(.141),"^",1)
51 ;
52ACSTRE2() ;
53 QUIT $P(GLOB(.141),"^",2)
54 ;
55ACSTRE3() ;
56 QUIT $P(GLOB(.141),"^",3)
57 ;
58ACCITY() ;
59 QUIT $P(GLOB(.141),"^",4)
60 ;
61ACSTATE() ;
62 NEW DATA
63 SET DATA=$P(GLOB(.141),"^",5)
64 QUIT $S(DATA="":"",1:$P($G(^DIC(5,DATA,0)),"^",2))
65 ;
66ACZIP() ;
67 QUIT $P(GLOB(.141),"^",6)
68 ;
69ACCOUNTY() ;
70 N DATA,STATE
71 SET STATE=$P(GLOB(.141),"^",5)
72 SET DATA=$P(GLOB(.141),"^",11)
73 IF DATA'="",STATE'="" SET DATA=$P($G(^DIC(5,STATE,1,DATA,0)),"^",1)
74 QUIT DATA
75 ;
76ACSTDATE() ;
77 QUIT $P(GLOB(.141),"^",7)
78 ;
79ACENDATE() ;
80 QUIT $P(GLOB(.141),"^",8)
81 ;
82ACCAC ;
83 NEW CACCNT,ROWCNT,CAC,CACACT,DATA
84 SET CACCNT=0,ROWCNT=0
85 FOR SET CACCNT=$O(GLOB(.14,CACCNT)) QUIT:'+CACCNT DO
86 .SET DATA=$P($G(GLOB(.14,CACCNT,0)),"^",1)
87 .SET CAC=$S(DATA=1:"ELIGIBILITY/ENROLLMENT",DATA=2:"APPOINTMENT/SCHEDULING",DATA=3:"COPAYMENTS/VETERAN BILLING",DATA=4:"MEDICAL RECORDS",DATA=5:"ALL OTHERS",1:"")
88 .SET CACACT=$S($P($G(GLOB(.14,CACCNT,0)),"^",2)="Y":"TRUE",$P($G(GLOB(.14,CACCNT,0)),"^",2)="N":"FALSE",1:"")
89 .SET ROWCNT=ROWCNT+1
90 .SET CNT=$G(CNT)+1,PSARRAY(CNT)="<ConfidentialAddressCategory Row='"_ROWCNT_"'"
91 .SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Category^"_CAC
92 .SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Active^"_CACACT
93 .SET CNT=$G(CNT)+1,PSARRAY(CNT)="></ConfidentialAddressCategory>"
94 IF ROWCNT=0 DO
95 .SET CNT=$G(CNT)+1,PSARRAY(CNT)="<ConfidentialAddressCategory Row='1' Category='' Active=''></ConfidentialAddressCategory>"
96 QUIT
Note: See TracBrowser for help on using the repository browser.