DGRRPSID.m

DGRRPSID ; ALB/SGG - rtnDGRR PatientServices Identifier ;09/30/03  ; Compiled October 2, 2003 12:41:01

 ;;5.3;Registration;**557**;Aug 13, 1993

 ;

DOC ;<Identifier>

 ;PatientICN - patient's ICN is set from initial PARAMS()

 ;PatientDFN - patient's DFN is set up as PTID from initial PARAMS()

 ;.01       NAME (RFXa), [0;1]

 ;.09       SOCIAL SECURITY NUMBER (RFXa), [0;9]

 ;.03       DATE OF BIRTH (RDXOa), [0;3]

 ;.363      PRIMARY LONG ID (F), [.36;3]

 ;.364      PRIMARY SHORT ID (F), [.36;4]

 ;

GETPSARY(PSARRAY) ;

 NEW CNT

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="<Identifier"

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^ICN^"_$$PATICN()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DFN^"_$$PATDFN()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^FullName^"_$$FULLNAME()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^SSN^"_$$PATSSN()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DateOfBirth^"_$$PATDOB()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^PrimaryLongID^"_$$PRMLNID()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="^PrimaryShortID^"_$$PRMSHID()

 SET CNT=$G(CNT)+1,PSARRAY(CNT)="></Identifier>"_"^^^1"

 QUIT

 ;

PATICN() ;

 QUIT $G(ICN)

 ;

PATDFN() ;

 QUIT $G(PTID)

 ;

FULLNAME() ;

 QUIT $P(GLOB(0),"^",1)

 ;

PATSSN() ;

 QUIT $P(GLOB(0),"^",9)

 ;

PATDOB() ;

 QUIT $P(GLOB(0),"^",3)

 ;

PRMLNID() ;

 QUIT $P(GLOB(.36),"^",3)

 ;

PRMSHID() ;

 QUIT $P(GLOB(.36),"^",4)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGRRPSID   1331     printed  Apr 09, 2024@21:39:57                                                                                                                                                                                                    Page 2

DGRRPSID  ; ALB/SGG - rtnDGRR PatientServices Identifier ;09/30/03  ; Compiled October 2, 2003 12:41:01

 +1       ;;5.3;Registration;**557**;Aug 13, 1993

 +2       ;

DOC       ;<Identifier>

 +1       ;PatientICN - patient's ICN is set from initial PARAMS()

 +2       ;PatientDFN - patient's DFN is set up as PTID from initial PARAMS()

 +3       ;.01       NAME (RFXa), [0;1]

 +4       ;.09       SOCIAL SECURITY NUMBER (RFXa), [0;9]

 +5       ;.03       DATE OF BIRTH (RDXOa), [0;3]

 +6       ;.363      PRIMARY LONG ID (F), [.36;3]

 +7       ;.364      PRIMARY SHORT ID (F), [.36;4]

 +8       ;

GETPSARY(PSARRAY) ;

 +1        NEW CNT

 +2        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="<Identifier"

 +3        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="^ICN^"_$$PATICN()

 +4        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="^DFN^"_$$PATDFN()

 +5        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="^FullName^"_$$FULLNAME()

 +6        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="^SSN^"_$$PATSSN()

 +7        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="^DateOfBirth^"_$$PATDOB()

 +8        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="^PrimaryLongID^"_$$PRMLNID()

 +9        SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="^PrimaryShortID^"_$$PRMSHID()

 +10       SET CNT=$GET(CNT)+1

           SET PSARRAY(CNT)="></Identifier>"_"^^^1"

 +11       QUIT 

 +12      ;

PATICN()  ;

 +1        QUIT $GET(ICN)

 +2       ;

PATDFN()  ;

 +1        QUIT $GET(PTID)

 +2       ;

FULLNAME() ;

 +1        QUIT $PIECE(GLOB(0),"^",1)

 +2       ;

PATSSN()  ;

 +1        QUIT $PIECE(GLOB(0),"^",9)

 +2       ;

PATDOB()  ;

 +1        QUIT $PIECE(GLOB(0),"^",3)

 +2       ;

PRMLNID() ;

 +1        QUIT $PIECE(GLOB(.36),"^",3)

 +2       ;

PRMSHID() ;

 +1        QUIT $PIECE(GLOB(.36),"^",4)