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 ---[H[J[2J[HDGRRPSID 1331 printed Sep 23, 2025@20:33:46 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)
