- 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 Feb 19, 2025@00:23:55 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)