DGMFA10 ;DAL/JCH - NDS DEMOGRAPHICS RACE ASSOCIATION ;15-AUG-2017
;;5.3;Registration;**933**;Aug 13, 1993;Build 44
;
Q
;
; Available at Master File Association Enter/Edit [DGMF AMAIN] option, at the following menu path:
; Supervisor ADT Menu [DG SUPERVISOR MENU]
; ADT System Definition Menu [DG SYSTEM DEFINITION MENU]
; Master Demographics Files [DGMF MENU]
; Master File Association Enter/Edit [DGMF AMAIN]
;
EN ; Allow users to populate the RACE MASTER field (#90) in RACE file (#10)
D INFO ; Display option info
D KILLTMP ; Kill ^TMP($J,"DGMFR10"
N DGDONE ; Signal from user - Q:DGDONE
S DGDONE=0
; Prompt for RACE file (#10) entries until user quits
F Q:DGDONE D
.N DIE,DA,DR,DIC,X,Y,DIR,DUOUT,DGRACI,DGMISV
.N DGRAC0,DGMRAC0,DGEMRACI,DGMDONE,DGESUM
.;
.S DGRACI=$$GETRACE(.DGDONE) Q:DGDONE ; Get Race IEN
.; Get relevant info from 10 and 10.99, store in ^TMP($J
.D GETDATA(DGRACI,.DGMISV)
.; Use MRAC report to print RACE details
.S DGSUM=2 D PRINRAC^DGMFR10(DGRACI)
.;
.D UPDRACE(DGRACI) ; Update Race file pointer to RACE MASTER (#10.99)
.D GETDATA(DGRACI,.DGMRACI) ; Get updated data
.I $G(DGMRACI)'=$G(DGMISV) D REDISP(DGRACI) ; RACE MASTER pointer changed, re-display updated info
.;
.S DIR(0)="EA",DIR("A",1)="",DIR("A",2)="",DIR("A")="Press Return to continue " D ^DIR
.D INFO
D KILLTMP
Q
;
GETRACE(DGDONE) ; Prompt for race file (#10) entry
N DIC,X,Y
S DIC=10,DIC(0)="QEAMZ"
F Q:$G(Y)>0!$G(DGDONE) D
.W ! D ^DIC I $G(DUOUT)!$G(DTOUT)!($G(Y)<0) S DGDONE=1 Q ; Nothing selected, quit
.N DGONAM
.S DGONAM=$P($G(^DIC(10,+Y,0)),"^")
.Q:'$D(^DGRAM(10.99,"AC",DGONAM))
.; Use MRAC report to print RACE details
.D GETDATA(+Y)
.S DGSUM=2 D PRINRAC^DGMFR10(+Y)
.W !!," * This entry has been associated to the RACE MASTER *",!," * file by Standards & Terminology Services (STS) *"
.W !," * and may only be updated via the Master File Server (MFS). *"
.K Y
S DGRACI=+$G(Y)
Q DGRACI
;
UPDRACE(DGRACI) ; Use DG RACM input template to restrict input to MRAC field
S DIE="^DIC(10,"
S DR="[DGMF ARACE]"
S DA=DGRACI
D ^DIE
Q
;
REDISP(DGRACI) ; Redisplay update RACE file (#10) entry
W !!,"Update Successful...."
S DGSUM=1 D PRINRAC^DGMFR10(DGRACI) ; display summarized TOP entry info
Q
;
INFO ; Display message, clear screen
N MSG
S MSG(1)=" This option allows RACE file entries to be"
S MSG(2)=" associated with the RACE MASTER file to enhance "
S MSG(3)=" interoperablity. The RACE MASTER file contains"
S MSG(4)=" standard Health Level Seven (HL7) races."
S MSG(5)=""
D CLEAR^VALM1
D BMES^XPDUTL(.MSG)
Q
;
GETDATA(DGRACI,DGMRACI) ; Define local variables and set into ^TMP($J
S DGRAC0=$G(^DIC(10,DGRACI,0))
S DGMRACI=+$G(^DIC(10,DGRACI,"MASTER"))
S DGRACST=+$G(^DIC(10,DGRACI,.02)),DGRACST=$S(DGRACST:"INACTIVE",1:"ACTIVE")
S DGMRAC0=$S($G(DGMRACI):$G(^DGRAM(10.99,+DGMRACI,0)),1:"Not Mapped")
I DGMRACI S $P(DGMRAC0,"^",4)=DGMRACI
S ^TMP($J,"DGMFR10",DGRAC0,DGRACI,"RACE")=$G(DGRAC0)
S ^TMP($J,"DGMFR10",DGRAC0,DGRACI,"MRACE")=$G(DGMRAC0)
S ^TMP($J,"DGMFR10",DGRAC0,DGRACI,"STATUS")=DGRACST
Q
;
KILLTMP ; Kill ^TMP global
K ^TMP($J,"DGMFR10")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMFA10 3298 printed Dec 13, 2024@02:44:07 Page 2
DGMFA10 ;DAL/JCH - NDS DEMOGRAPHICS RACE ASSOCIATION ;15-AUG-2017
+1 ;;5.3;Registration;**933**;Aug 13, 1993;Build 44
+2 ;
+3 QUIT
+4 ;
+5 ; Available at Master File Association Enter/Edit [DGMF AMAIN] option, at the following menu path:
+6 ; Supervisor ADT Menu [DG SUPERVISOR MENU]
+7 ; ADT System Definition Menu [DG SYSTEM DEFINITION MENU]
+8 ; Master Demographics Files [DGMF MENU]
+9 ; Master File Association Enter/Edit [DGMF AMAIN]
+10 ;
EN ; Allow users to populate the RACE MASTER field (#90) in RACE file (#10)
+1 ; Display option info
DO INFO
+2 ; Kill ^TMP($J,"DGMFR10"
DO KILLTMP
+3 ; Signal from user - Q:DGDONE
NEW DGDONE
+4 SET DGDONE=0
+5 ; Prompt for RACE file (#10) entries until user quits
+6 FOR
if DGDONE
QUIT
Begin DoDot:1
+7 NEW DIE,DA,DR,DIC,X,Y,DIR,DUOUT,DGRACI,DGMISV
+8 NEW DGRAC0,DGMRAC0,DGEMRACI,DGMDONE,DGESUM
+9 ;
+10 ; Get Race IEN
SET DGRACI=$$GETRACE(.DGDONE)
if DGDONE
QUIT
+11 ; Get relevant info from 10 and 10.99, store in ^TMP($J
+12 DO GETDATA(DGRACI,.DGMISV)
+13 ; Use MRAC report to print RACE details
+14 SET DGSUM=2
DO PRINRAC^DGMFR10(DGRACI)
+15 ;
+16 ; Update Race file pointer to RACE MASTER (#10.99)
DO UPDRACE(DGRACI)
+17 ; Get updated data
DO GETDATA(DGRACI,.DGMRACI)
+18 ; RACE MASTER pointer changed, re-display updated info
IF $GET(DGMRACI)'=$GET(DGMISV)
DO REDISP(DGRACI)
+19 ;
+20 SET DIR(0)="EA"
SET DIR("A",1)=""
SET DIR("A",2)=""
SET DIR("A")="Press Return to continue "
DO ^DIR
+21 DO INFO
End DoDot:1
+22 DO KILLTMP
+23 QUIT
+24 ;
GETRACE(DGDONE) ; Prompt for race file (#10) entry
+1 NEW DIC,X,Y
+2 SET DIC=10
SET DIC(0)="QEAMZ"
+3 FOR
if $GET(Y)>0!$GET(DGDONE)
QUIT
Begin DoDot:1
+4 ; Nothing selected, quit
WRITE !
DO ^DIC
IF $GET(DUOUT)!$GET(DTOUT)!($GET(Y)<0)
SET DGDONE=1
QUIT
+5 NEW DGONAM
+6 SET DGONAM=$PIECE($GET(^DIC(10,+Y,0)),"^")
+7 if '$DATA(^DGRAM(10.99,"AC",DGONAM))
QUIT
+8 ; Use MRAC report to print RACE details
+9 DO GETDATA(+Y)
+10 SET DGSUM=2
DO PRINRAC^DGMFR10(+Y)
+11 WRITE !!," * This entry has been associated to the RACE MASTER *",!," * file by Standards & Terminology Services (STS) *"
+12 WRITE !," * and may only be updated via the Master File Server (MFS). *"
+13 KILL Y
End DoDot:1
+14 SET DGRACI=+$GET(Y)
+15 QUIT DGRACI
+16 ;
UPDRACE(DGRACI) ; Use DG RACM input template to restrict input to MRAC field
+1 SET DIE="^DIC(10,"
+2 SET DR="[DGMF ARACE]"
+3 SET DA=DGRACI
+4 DO ^DIE
+5 QUIT
+6 ;
REDISP(DGRACI) ; Redisplay update RACE file (#10) entry
+1 WRITE !!,"Update Successful...."
+2 ; display summarized TOP entry info
SET DGSUM=1
DO PRINRAC^DGMFR10(DGRACI)
+3 QUIT
+4 ;
INFO ; Display message, clear screen
+1 NEW MSG
+2 SET MSG(1)=" This option allows RACE file entries to be"
+3 SET MSG(2)=" associated with the RACE MASTER file to enhance "
+4 SET MSG(3)=" interoperablity. The RACE MASTER file contains"
+5 SET MSG(4)=" standard Health Level Seven (HL7) races."
+6 SET MSG(5)=""
+7 DO CLEAR^VALM1
+8 DO BMES^XPDUTL(.MSG)
+9 QUIT
+10 ;
GETDATA(DGRACI,DGMRACI) ; Define local variables and set into ^TMP($J
+1 SET DGRAC0=$GET(^DIC(10,DGRACI,0))
+2 SET DGMRACI=+$GET(^DIC(10,DGRACI,"MASTER"))
+3 SET DGRACST=+$GET(^DIC(10,DGRACI,.02))
SET DGRACST=$SELECT(DGRACST:"INACTIVE",1:"ACTIVE")
+4 SET DGMRAC0=$SELECT($GET(DGMRACI):$GET(^DGRAM(10.99,+DGMRACI,0)),1:"Not Mapped")
+5 IF DGMRACI
SET $PIECE(DGMRAC0,"^",4)=DGMRACI
+6 SET ^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"RACE")=$GET(DGRAC0)
+7 SET ^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"MRACE")=$GET(DGMRAC0)
+8 SET ^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"STATUS")=DGRACST
+9 QUIT
+10 ;
KILLTMP ; Kill ^TMP global
+1 KILL ^TMP($JOB,"DGMFR10")
+2 QUIT
