DGRRPSIC ; ALB/SGG - rtnDGRR PatientServices Incompetent ;09/30/03 ; Compiled October 21, 2003 15:06:51
;;5.3;Registration;**557**;Aug 13, 1993
;
DOC ;<DataSet Name='Incompetent'
;
;.293 RATED INCOMPETENT? (S), [.29;12]
; '0' FOR NO
; '1' FOR YES
;
;.291 DATE RULED INCOMPETENT (VA) (D), [.29;1]
;.2911 INSTITUTION (VA) (P4'), [.29;3]
;.2912 GUARDIAN (VA) (F), [.29;4]
;.2913 RELATIONSHIP (VA) (F), [.29;5]
;.2914 STREET ADDRESS 1 (VA) (F), [.29;6]
;.2915 STREET ADDRESS 2 (VA) (F), [.29;7]
;.2916 CITY (VA) (F), [.29;8]
;.2917 STATE (VA) (P5'), [.29;9]
;.2918 ZIP (VA) (F), [.29;10]
;.29013 ZIP+4 (VA) (FOX), [.29;13]
;.2919 PHONE (VA) (F), [.29;11]
;
;.292 DATE RULED INCOMPETENT (CIVIL) (D), [.29;2]
;.2921 INSTITUTION (CIVIL) (F), [.291;3]
;.2922 GUARDIAN (CIVIL) (F), [.291;4]
;.2923 RELATIONSHIP (CIVIL) (F), [.291;5]
;.2924 STREET ADDRESS 1 (CIVIL) (F), [.291;6]
;.2925 STREET ADDRESS 2 (CIVIL) (F), [.291;7]
;.2926 CITY (CIVIL) (F), [.291;8]
;.2927 STATE (CIVIL) (P5'), [.291;9]
;.2928 ZIP (CIVIL) (F), [.291;10]
;.290012 ZIP+4 (CIVIL) (FOX), [.291;12]
;.2929 PHONE (CIVIL) (F), [.291;11]
;
GETPSARY(PSARRAY) ;
NEW CNT
SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='Incompetent'"
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RatedIncompetent^"_$$RATEDIC()
DO INCOMP("VETERAN",GLOB(.29),1,13) ; VA
DO INCOMP("CIVIL",GLOB(.291),2,12) ; Civil
SET CNT=$G(CNT)+1,PSARRAY(CNT)="></DataSet>"_"^^^1"
QUIT
;
INCOMP(ICTYPE,ADGLOB,DTPIECE,ZIP4) ;
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DateRuledIncompetent"_$E(ICTYPE,1)_"^"_$P(GLOB(.29),"^",DTPIECE)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Institution"_$E(ICTYPE,1)_"^"_$$ADINST()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Guardian"_$E(ICTYPE,1)_"^"_$P(ADGLOB,"^",4)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^RelationshipToPatient"_$E(ICTYPE,1)_"^"_$P(ADGLOB,"^",5)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street1"_$E(ICTYPE,1)_"^"_$P(ADGLOB,"^",6)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Street2"_$E(ICTYPE,1)_"^"_$P(ADGLOB,"^",7)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^City"_$E(ICTYPE,1)_"^"_$P(ADGLOB,"^",8)
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^State"_$E(ICTYPE,1)_"^"_$$ADSTATE()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Zip"_$E(ICTYPE,1)_"^"_$$ADZIP()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^PhoneNumber"_$E(ICTYPE,1)_"^"_$P(ADGLOB,"^",11)
QUIT
;
RATEDIC() ;
NEW DATA
SET DATA=$P(GLOB(.29),"^",12)
SET DATA=$S(DATA=1:"YES",DATA=0:"NO",1:"")
QUIT DATA
;
;
ADINST() ;
NEW DATA
SET DATA=$P(ADGLOB,"^",3)
IF ICTYPE="VETERAN",DATA'="" SET DATA=$P($$NS^XUAF4(+DATA),"^",1)
QUIT DATA
;
ADSTATE() ;
NEW DATA
SET DATA=$P(ADGLOB,"^",9)
IF DATA'="" SET DATA=$P($G(^DIC(5,DATA,0)),"^",2)
QUIT DATA
;
Q
ADZIP() ;
NEW DATA
SET DATA=$P(ADGLOB,"^",ZIP4)
IF DATA="" SET DATA=$P(ADGLOB,"^",10)
QUIT DATA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRRPSIC 2927 printed Dec 13, 2024@02:57:52 Page 2
DGRRPSIC ; ALB/SGG - rtnDGRR PatientServices Incompetent ;09/30/03 ; Compiled October 21, 2003 15:06:51
+1 ;;5.3;Registration;**557**;Aug 13, 1993
+2 ;
DOC ;<DataSet Name='Incompetent'
+1 ;
+2 ;.293 RATED INCOMPETENT? (S), [.29;12]
+3 ; '0' FOR NO
+4 ; '1' FOR YES
+5 ;
+6 ;.291 DATE RULED INCOMPETENT (VA) (D), [.29;1]
+7 ;.2911 INSTITUTION (VA) (P4'), [.29;3]
+8 ;.2912 GUARDIAN (VA) (F), [.29;4]
+9 ;.2913 RELATIONSHIP (VA) (F), [.29;5]
+10 ;.2914 STREET ADDRESS 1 (VA) (F), [.29;6]
+11 ;.2915 STREET ADDRESS 2 (VA) (F), [.29;7]
+12 ;.2916 CITY (VA) (F), [.29;8]
+13 ;.2917 STATE (VA) (P5'), [.29;9]
+14 ;.2918 ZIP (VA) (F), [.29;10]
+15 ;.29013 ZIP+4 (VA) (FOX), [.29;13]
+16 ;.2919 PHONE (VA) (F), [.29;11]
+17 ;
+18 ;.292 DATE RULED INCOMPETENT (CIVIL) (D), [.29;2]
+19 ;.2921 INSTITUTION (CIVIL) (F), [.291;3]
+20 ;.2922 GUARDIAN (CIVIL) (F), [.291;4]
+21 ;.2923 RELATIONSHIP (CIVIL) (F), [.291;5]
+22 ;.2924 STREET ADDRESS 1 (CIVIL) (F), [.291;6]
+23 ;.2925 STREET ADDRESS 2 (CIVIL) (F), [.291;7]
+24 ;.2926 CITY (CIVIL) (F), [.291;8]
+25 ;.2927 STATE (CIVIL) (P5'), [.291;9]
+26 ;.2928 ZIP (CIVIL) (F), [.291;10]
+27 ;.290012 ZIP+4 (CIVIL) (FOX), [.291;12]
+28 ;.2929 PHONE (CIVIL) (F), [.291;11]
+29 ;
GETPSARY(PSARRAY) ;
+1 NEW CNT
+2 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="<DataSet Name='Incompetent'"
+3 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^RatedIncompetent^"_$$RATEDIC()
+4 ; VA
DO INCOMP("VETERAN",GLOB(.29),1,13)
+5 ; Civil
DO INCOMP("CIVIL",GLOB(.291),2,12)
+6 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="></DataSet>"_"^^^1"
+7 QUIT
+8 ;
INCOMP(ICTYPE,ADGLOB,DTPIECE,ZIP4) ;
+1 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^DateRuledIncompetent"_$EXTRACT(ICTYPE,1)_"^"_$PIECE(GLOB(.29),"^",DTPIECE)
+2 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Institution"_$EXTRACT(ICTYPE,1)_"^"_$$ADINST()
+3 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Guardian"_$EXTRACT(ICTYPE,1)_"^"_$PIECE(ADGLOB,"^",4)
+4 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^RelationshipToPatient"_$EXTRACT(ICTYPE,1)_"^"_$PIECE(ADGLOB,"^",5)
+5 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Street1"_$EXTRACT(ICTYPE,1)_"^"_$PIECE(ADGLOB,"^",6)
+6 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Street2"_$EXTRACT(ICTYPE,1)_"^"_$PIECE(ADGLOB,"^",7)
+7 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^City"_$EXTRACT(ICTYPE,1)_"^"_$PIECE(ADGLOB,"^",8)
+8 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^State"_$EXTRACT(ICTYPE,1)_"^"_$$ADSTATE()
+9 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Zip"_$EXTRACT(ICTYPE,1)_"^"_$$ADZIP()
+10 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^PhoneNumber"_$EXTRACT(ICTYPE,1)_"^"_$PIECE(ADGLOB,"^",11)
+11 QUIT
+12 ;
RATEDIC() ;
+1 NEW DATA
+2 SET DATA=$PIECE(GLOB(.29),"^",12)
+3 SET DATA=$SELECT(DATA=1:"YES",DATA=0:"NO",1:"")
+4 QUIT DATA
+5 ;
+6 ;
ADINST() ;
+1 NEW DATA
+2 SET DATA=$PIECE(ADGLOB,"^",3)
+3 IF ICTYPE="VETERAN"
IF DATA'=""
SET DATA=$PIECE($$NS^XUAF4(+DATA),"^",1)
+4 QUIT DATA
+5 ;
ADSTATE() ;
+1 NEW DATA
+2 SET DATA=$PIECE(ADGLOB,"^",9)
+3 IF DATA'=""
SET DATA=$PIECE($GET(^DIC(5,DATA,0)),"^",2)
+4 QUIT DATA
+5 ;
+6 QUIT
ADZIP() ;
+1 NEW DATA
+2 SET DATA=$PIECE(ADGLOB,"^",ZIP4)
+3 IF DATA=""
SET DATA=$PIECE(ADGLOB,"^",10)
+4 QUIT DATA
+5 QUIT
