DGRRPSIC.m

DGRRPSIC ; ALB/SGG - rtnDGRR PatientServices Incompetent ;09/30/03  ; Compiled October 21, 2003 15:06:51

 ;;5.3;Registration;**557,1015**;Aug 13, 1993;Build 21

 ;

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

DGRRPSIC  ; ALB/SGG - rtnDGRR PatientServices Incompetent ;09/30/03  ; Compiled October 21, 2003 15:06:51

 +1       ;;5.3;Registration;**557,1015**;Aug 13, 1993;Build 21

 +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