DGRRPSD1 ; ALB/SGG - rtnDGRR PatientServices Demographics Primary ;09/30/03 ; Compiled February 3, 2004 17:14:03
;;5.3;Registration;**557**;Aug 13, 1993
;
DOC ;<DataSet Name='PrimaryDemographics'
;[2] .02 SEX (RSa), [0;2]
;[2] .05 MARITAL STATUS (RP11'a), [0;5]
;[2] .351 DATE OF DEATH (DXa), [.35;1]
;[2] .352 DEATH ENTERED BY (P200'), [.35;2]
;[38.1] 2 SECURITY LEVEL (RSX), [0;2]
;[2] .08 RELIGIOUS PREFERENCE (P13'a), [0;8]
;[2] .091 REMARKS (F), [0;10]
;
GETPSARY(PSARRAY) ;
NEW CNT
SET CNT=$G(CNT)+1,PSARRAY(CNT)="<DataSet Name='PrimaryDemographics'"
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Gender^"_$$GENDER()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^MaritalStatus^"_$$MARISTAT()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DateOfDeath^"_$$PATDOD()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DeathEnteredBy^"_$$DODENTBY()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^DeathEnteredByVPID^"_$$DODVPID()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^SecurityLevel^"_$$SECURLVL()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^ReligiousPreference^"_$$RELIPREF()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="^Remarks^"_$$REMARKS()
SET CNT=$G(CNT)+1,PSARRAY(CNT)="></DataSet>"_"^^^1"
QUIT
;
GENDER() ;
NEW DATA
SET DATA=$P(GLOB(0),"^",2)
QUIT $S(DATA="M":"MALE",DATA="F":"FEMALE",1:"")
;
MARISTAT() ;
NEW DATA
SET DATA=$P(GLOB(0),"^",5)
QUIT $S(DATA="":"",1:$P($G(^DIC(11,DATA,0)),"^",1))
;
PATDOD() ;
QUIT $P(GLOB(.35),"^",1)
;
DODENTBY() ;
NEW DATA
SET DATA=$P(GLOB(.35),"^",2)
IF DATA'="" SET DATA=$P($G(^VA(200,DATA,0)),"^",1)
QUIT DATA
;
DODVPID() ;
QUIT $$VPID^XUPS($P(GLOB(.35),"^",2))
;
SECURLVL() ;
QUIT $S($P($G(^DGSL(38.1,PTID,0)),"^",2)=1:"SENSITIVE",1:"NON-SENSITIVE")
;
RELIPREF() ;
NEW DATA
SET DATA=$P(GLOB(0),"^",8)
QUIT $S(DATA="":"",1:$P($G(^DIC(13,DATA,0)),"^",1))
;
QUIT $P(GLOB(0),"^",10)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRRPSD1 1907 printed Dec 13, 2024@02:57:48 Page 2
DGRRPSD1 ; ALB/SGG - rtnDGRR PatientServices Demographics Primary ;09/30/03 ; Compiled February 3, 2004 17:14:03
+1 ;;5.3;Registration;**557**;Aug 13, 1993
+2 ;
DOC ;<DataSet Name='PrimaryDemographics'
+1 ;[2] .02 SEX (RSa), [0;2]
+2 ;[2] .05 MARITAL STATUS (RP11'a), [0;5]
+3 ;[2] .351 DATE OF DEATH (DXa), [.35;1]
+4 ;[2] .352 DEATH ENTERED BY (P200'), [.35;2]
+5 ;[38.1] 2 SECURITY LEVEL (RSX), [0;2]
+6 ;[2] .08 RELIGIOUS PREFERENCE (P13'a), [0;8]
+7 ;[2] .091 REMARKS (F), [0;10]
+8 ;
GETPSARY(PSARRAY) ;
+1 NEW CNT
+2 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="<DataSet Name='PrimaryDemographics'"
+3 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Gender^"_$$GENDER()
+4 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^MaritalStatus^"_$$MARISTAT()
+5 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^DateOfDeath^"_$$PATDOD()
+6 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^DeathEnteredBy^"_$$DODENTBY()
+7 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^DeathEnteredByVPID^"_$$DODVPID()
+8 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^SecurityLevel^"_$$SECURLVL()
+9 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^ReligiousPreference^"_$$RELIPREF()
+10 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="^Remarks^"_$$REMARKS()
+11 SET CNT=$GET(CNT)+1
SET PSARRAY(CNT)="></DataSet>"_"^^^1"
+12 QUIT
+13 ;
GENDER() ;
+1 NEW DATA
+2 SET DATA=$PIECE(GLOB(0),"^",2)
+3 QUIT $SELECT(DATA="M":"MALE",DATA="F":"FEMALE",1:"")
+4 ;
MARISTAT() ;
+1 NEW DATA
+2 SET DATA=$PIECE(GLOB(0),"^",5)
+3 QUIT $SELECT(DATA="":"",1:$PIECE($GET(^DIC(11,DATA,0)),"^",1))
+4 ;
PATDOD() ;
+1 QUIT $PIECE(GLOB(.35),"^",1)
+2 ;
DODENTBY() ;
+1 NEW DATA
+2 SET DATA=$PIECE(GLOB(.35),"^",2)
+3 IF DATA'=""
SET DATA=$PIECE($GET(^VA(200,DATA,0)),"^",1)
+4 QUIT DATA
+5 ;
DODVPID() ;
+1 QUIT $$VPID^XUPS($PIECE(GLOB(.35),"^",2))
+2 ;
SECURLVL() ;
+1 QUIT $SELECT($PIECE($GET(^DGSL(38.1,PTID,0)),"^",2)=1:"SENSITIVE",1:"NON-SENSITIVE")
+2 ;
RELIPREF() ;
+1 NEW DATA
+2 SET DATA=$PIECE(GLOB(0),"^",8)
+3 QUIT $SELECT(DATA="":"",1:$PIECE($GET(^DIC(13,DATA,0)),"^",1))
+4 ;
+1 QUIT $PIECE(GLOB(0),"^",10)
