DGRRPSAC() ; ALB/SGG rtnDGRR PatientServices Address Confidential ; 09/30/03 ; Compiled October 2, 2003 12:40:53
;;5.3;Registration;**557**;Aug 13, 1993
;
DOC ;<DataSet Name='ConfidentialAddress'
;.1411 CONFIDENTIAL STREET [LINE 1] (FX), [.141;1]
;.1412 CONFIDENTIAL STREET [LINE 2] (FX) [.141;2]
;.1413 CONFIDENTIAL STREET [LINE 3] (FX) [.141;3]
;.1414 CONFIDENTIAL ADDRESS CITY (FX) [.141;4]
;.1415 CONFIDENTIAL ADDRESS STATE (P5'X) [.141;5]
;.1416 CONFIDENTIAL ADDRESS ZIP CODE (FXO) [.141;6]
;.14111 CONFIDENTIAL ADDRESS COUNTY (NJ3,0OX) [.141;11]
;.1417 CONFIDENTIAL START DATE (DX) [.141;7]
;.1418 CONFIDENTIAL END DATE (DX) [.141;8]
;.141 CONFIDENTIAL ADDRESS CATEGORY (Multiple-2.141) [.14;0]
; .01 CONFIDENTIAL ADDRESS CATEGORY (MS), [0;1]
; 1 CONFIDENTIAL CATEGORY ACTIVE (S), [0;2]
; 1 CONFIDENTIAL CATEGORY ACTIVE (S) [0;2]
; 'Y' FOR YES;
; 'N' FOR NO;
; .01 CONFIDENTIAL ADDRESS CATEGORY (MS) [0;1]
; '1' FOR ELIGIBILITY/ENROLLMENT
; '2' FOR APPOINTMENT/SCHEDULING
; '3' FOR COPAYMENTS/VETERAN BILLING
; '4' FOR MEDICAL RECORDS
; '5' FOR ALL OTHERS
;
GETPSARY(PSARRAY) ;
NEW CNT
SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='ConfidentialAddress'"
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street1^"_$$ACSTRE1()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street2^"_$$ACSTRE2()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street3^"_$$ACSTRE3()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^City^"_$$ACCITY()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^State^"_$$ACSTATE()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Zip^"_$$ACZIP()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^County^"_$$ACCOUNTY()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^StartDate^"_$$ACSTDATE()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^EndDate^"_$$ACENDATE()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^BadAddressIndicator^"
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^ConfidentialAddressActive^"
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^PhoneNumber^"
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^HomePhoneNumber^"
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^WorkPhoneNumber^"
SET CNT=$G(CNT)+1,PSARRAY(CNT)=">"
DO ACCAC
SET CNT=$G(CNT)+1,PSARRAY(CNT)="</DataSet>"_"^^^1"
QUIT
;
ACSTRE1() ;
QUIT $P(GLOB(.141),"^",1)
;
ACSTRE2() ;
QUIT $P(GLOB(.141),"^",2)
;
ACSTRE3() ;
QUIT $P(GLOB(.141),"^",3)
;
ACCITY() ;
QUIT $P(GLOB(.141),"^",4)
;
ACSTATE() ;
NEW DATA
SET DATA=$P(GLOB(.141),"^",5)
QUIT $S(DATA="":"",1:$P($G(^DIC(5,DATA,0)),"^",2))
;
ACZIP() ;
QUIT $P(GLOB(.141),"^",6)
;
ACCOUNTY() ;
N DATA,STATE
SET STATE=$P(GLOB(.141),"^",5)
SET DATA=$P(GLOB(.141),"^",11)
IF DATA'="",STATE'="" SET DATA=$P($G(^DIC(5,STATE,1,DATA,0)),"^",1)
QUIT DATA
;
ACSTDATE() ;
QUIT $P(GLOB(.141),"^",7)
;
ACENDATE() ;
QUIT $P(GLOB(.141),"^",8)
;
ACCAC ;
NEW CACCNT,ROWCNT,CAC,CACACT,DATA
SET CACCNT=0,ROWCNT=0
FOR SET CACCNT=$O(GLOB(.14,CACCNT)) QUIT:'+CACCNT DO
.SET DATA=$P($G(GLOB(.14,CACCNT,0)),"^",1)
.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:"")
.SET CACACT=$S($P($G(GLOB(.14,CACCNT,0)),"^",2)="Y":"TRUE",$P($G(GLOB(.14,CACCNT,0)),"^",2)="N":"FALSE",1:"")
.SET ROWCNT=ROWCNT+1
.SET CNT=$G(CNT)+1,PSARRAY(CNT)="<ConfidentialAddressCategory Row='"_ROWCNT_"'"
.SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Category^"_CAC
.SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Active^"_CACACT
.SET CNT=$G(CNT)+1,PSARRAY(CNT)="></ConfidentialAddressCategory>"
IF ROWCNT=0 DO
.SET CNT=$G(CNT)+1,PSARRAY(CNT)="<ConfidentialAddressCategory Row='1' Category='' Active=''></ConfidentialAddressCategory>"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRRPSAC 3929 printed Dec 13, 2024@02:57:44 Page 2
DGRRPSAC() ; ALB/SGG rtnDGRR PatientServices Address Confidential ; 09/30/03 ; Compiled October 2, 2003 12:40:53
+1 ;;5.3;Registration;**557**;Aug 13, 1993
+2 ;
DOC ;<DataSet Name='ConfidentialAddress'
+1 ;.1411 CONFIDENTIAL STREET [LINE 1] (FX), [.141;1]
+2 ;.1412 CONFIDENTIAL STREET [LINE 2] (FX) [.141;2]
+3 ;.1413 CONFIDENTIAL STREET [LINE 3] (FX) [.141;3]
+4 ;.1414 CONFIDENTIAL ADDRESS CITY (FX) [.141;4]
+5 ;.1415 CONFIDENTIAL ADDRESS STATE (P5'X) [.141;5]
+6 ;.1416 CONFIDENTIAL ADDRESS ZIP CODE (FXO) [.141;6]
+7 ;.14111 CONFIDENTIAL ADDRESS COUNTY (NJ3,0OX) [.141;11]
+8 ;.1417 CONFIDENTIAL START DATE (DX) [.141;7]
+9 ;.1418 CONFIDENTIAL END DATE (DX) [.141;8]
+10 ;.141 CONFIDENTIAL ADDRESS CATEGORY (Multiple-2.141) [.14;0]
+11 ; .01 CONFIDENTIAL ADDRESS CATEGORY (MS), [0;1]
+12 ; 1 CONFIDENTIAL CATEGORY ACTIVE (S), [0;2]
+13 ; 1 CONFIDENTIAL CATEGORY ACTIVE (S) [0;2]
+14 ; 'Y' FOR YES;
+15 ; 'N' FOR NO;
+16 ; .01 CONFIDENTIAL ADDRESS CATEGORY (MS) [0;1]
+17 ; '1' FOR ELIGIBILITY/ENROLLMENT
+18 ; '2' FOR APPOINTMENT/SCHEDULING
+19 ; '3' FOR COPAYMENTS/VETERAN BILLING
+20 ; '4' FOR MEDICAL RECORDS
+21 ; '5' FOR ALL OTHERS
+22 ;
GETPSARY(PSARRAY) ;
+1 NEW CNT
+2 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="<DataSet Name='ConfidentialAddress'"
+3 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Street1^"_$$ACSTRE1()
+4 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Street2^"_$$ACSTRE2()
+5 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Street3^"_$$ACSTRE3()
+6 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^City^"_$$ACCITY()
+7 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^State^"_$$ACSTATE()
+8 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Zip^"_$$ACZIP()
+9 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^County^"_$$ACCOUNTY()
+10 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^StartDate^"_$$ACSTDATE()
+11 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^EndDate^"_$$ACENDATE()
+12 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^BadAddressIndicator^"
+13 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^ConfidentialAddressActive^"
+14 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^PhoneNumber^"
+15 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^HomePhoneNumber^"
+16 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^WorkPhoneNumber^"
+17 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)=">"
+18 DO ACCAC
+19 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="</DataSet>"_"^^^1"
+20 QUIT
+21 ;
ACSTRE1() ;
+1 QUIT $PIECE(GLOB(.141),"^",1)
+2 ;
ACSTRE2() ;
+1 QUIT $PIECE(GLOB(.141),"^",2)
+2 ;
ACSTRE3() ;
+1 QUIT $PIECE(GLOB(.141),"^",3)
+2 ;
ACCITY() ;
+1 QUIT $PIECE(GLOB(.141),"^",4)
+2 ;
ACSTATE() ;
+1 NEW DATA
+2 SET DATA=$PIECE(GLOB(.141),"^",5)
+3 QUIT $SELECT(DATA="":"",1:$PIECE($GET(^DIC(5,DATA,0)),"^",2))
+4 ;
ACZIP() ;
+1 QUIT $PIECE(GLOB(.141),"^",6)
+2 ;
ACCOUNTY() ;
+1 NEW DATA,STATE
+2 SET STATE=$PIECE(GLOB(.141),"^",5)
+3 SET DATA=$PIECE(GLOB(.141),"^",11)
+4 IF DATA'=""
IF STATE'=""
SET DATA=$PIECE($GET(^DIC(5,STATE,1,DATA,0)),"^",1)
+5 QUIT DATA
+6 ;
ACSTDATE() ;
+1 QUIT $PIECE(GLOB(.141),"^",7)
+2 ;
ACENDATE() ;
+1 QUIT $PIECE(GLOB(.141),"^",8)
+2 ;
ACCAC ;
+1 NEW CACCNT,ROWCNT,CAC,CACACT,DATA
+2 SET CACCNT=0
SET ROWCNT=0
+3 FOR
SET CACCNT=$ORDER(GLOB(.14,CACCNT))
if '+CACCNT
QUIT
Begin DoDot:1
+4 SET DATA=$PIECE($GET(GLOB(.14,CACCNT,0)),"^",1)
+5 SET CAC=$SELECT(DATA=1:"ELIGIBILITY/ENROLLMENT",DATA=2:"APPOINTMENT/SCHEDULING",DATA=3:"COPAYMENTS/VETERAN BILLING",DATA=4:"MEDICAL RECORDS",DATA=5:"ALL OTHERS",1:"")
+6 SET CACACT=$SELECT($PIECE($GET(GLOB(.14,CACCNT,0)),"^",2)="Y":"TRUE",$PIECE($GET(GLOB(.14,CACCNT,0)),"^",2)="N":"FALSE",1:"")
+7 SET ROWCNT=ROWCNT+1
+8 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="<ConfidentialAddressCategory Row='"_ROWCNT_"'"
+9 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Category^"_CAC
+10 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Active^"_CACACT
+11 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="></ConfidentialAddressCategory>"
End DoDot:1
+12 IF ROWCNT=0
Begin DoDot:1
+13 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="<ConfidentialAddressCategory Row='1' Category='' Active=''></ConfidentialAddressCategory>"
End DoDot:1
+14 QUIT
