DGMFR10 ;DAL/JCH - NDS DEMOGRAPHICS RACE MASTER ASSOCIATIONS REPORT ;15-AUG-2017
;;5.3;Registration;**933**;Aug 13, 1993;Build 44
;
; Available at Master File Reports [DGMF RMAIN] option, at the following menu path:
; Supervisor ADT Menu [DG SUPERVISOR MENU]
; ADT System Definition Menu [DG SYSTEM DEFINITION MENU]
; Master File Menu [DGMF MNU]
; Master File Reports [DGMF RMAIN]
Q
;
EN ; MRAC Report Entry point
N DGOUT
S DGOUT=0
F Q:$G(DGOUT) D
.D MAIN Q:DGOUT
.N DIR W !!
.S DIR(0)="Y",DIR("B")="Y",DIR("A")="Run report again" D ^DIR
.S:X'="Y" DGOUT=1
Q
;
MAIN ; Driver loop
N DGSUM,DGMUA,DGSRAC,DGOUTP
S DGSRAC=0
;
D INFO
; Select (M)apped, (U)nmapped, or (A)ll entries from RACE (#10) file.
W ! D MUA(.DGMUA) I '$D(DGMUA)!$G(DGOUT) S DGOUT=1 Q
;
; Select summary report or detailed
S DGSUM=$$SUMMARY I 'DGSUM Q
;
; Select output format
S DGOUTP=$$OUT I DGSRAC Q
;
; Select device
I $$SELDEV()!DGSRAC Q
;
I DGOUTP="R" W !!,"<*> please wait <*>"
U IO D DQ
;
Q
;
DQ ; report (queue) starts here
N DGRACI,DGMRACI,DGRAC0,DGMRAC0
;
K ^TMP($J,"DGMFR10")
; build list of races
S DGRACI=0 F S DGRACI=$O(^DIC(10,DGRACI)) Q:'DGRACI D
.S DGRAC0=$G(^DIC(10,DGRACI,0))
.S DGRACP02=+$G(^DIC(10,DGRACI,.02))
.S DGMRACI=+$G(^DIC(10,DGRACI,"MASTER"))
.I $G(DGMUA)="U",$G(DGMRACI) Q
.I $G(DGMUA)="M",'$G(DGMRACI) Q
.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,"RAC")=$G(DGRAC0)
.S ^TMP($J,"DGMFR10",DGRAC0,DGRACI,"STATUS")=DGRACP02
.S ^TMP($J,"DGMFR10",DGRAC0,DGRACI,"MRACE")=$G(DGMRAC0)
;
D PRINT
;
D ^%ZISC
K ^TMP($J,"DGMFR10")
Q
;
PRINT ; Print output
N MAXCNT,DGSRAC,DGPGCNT,DGHDR,CRT,DGDELHD
I IOST["C-" S MAXCNT=IOSL-10,CRT=1
E S MAXCNT=IOSL-6,CRT=0
I DGSUM=1 S MAXCNT=MAXCNT+5
S DGPGCNT=0,DGSRAC=0
;
I '$D(^TMP($J,"DGMFR10")) D HEADER W !!!?5,"No Data Found" Q
;
N DGRACI,DGRAC0
S DGRAC0="" F S DGRAC0=$O(^TMP($J,"DGMFR10",DGRAC0)) Q:DGRAC0="" D PRINT2(DGRAC0)
Q
;
PRINT2(DGRAC0) ; Get details
S DGRACI=0 F S DGRACI=$O(^TMP($J,"DGMFR10",DGRAC0,DGRACI)) Q:'DGRACI!DGSRAC D
.N DGMRAC0,DGCT,DGCTS,DGCTX,DGRACST
.N DGMTST,DGMTED,DGMRACI,DGMTEDI,DGMPAR,DGMPARX
.N DGMREPL,DGMREPX,DGMV0
.;
.I $G(DGOUTP)="E" D DELIM(DGRAC0,DGRACI) Q
.;
.I ($Y+1>MAXCNT)!'DGPGCNT D HEADER Q:DGSRAC
.S DGRAC0=$G(^TMP($J,"DGMFR10",DGRAC0,DGRACI,"RAC"))
.S DGRACST=+$G(^TMP($J,"DGMFR10",DGRAC0,DGRACI,"STATUS")),DGRACST=$S(DGRACST:"INACTIVE",1:"ACTIVE")
.D PRINRAC(DGRACI)
.;
.Q:'DGMRACI
.I $G(DGSUM)=2 D
..W !?3,"Master Code: ",$P(^TMP($J,"DGMFR10",DGRAC0,DGRACI,"MRACE"),"^",2)
..S DGMTED=$$NOW^XLFDT,DGMTED=$O(^DGRAM(10.99,DGMRACI,"TERMSTATUS","B",DGMTED),-1)
..I DGMTED D ; This should always be true, if data came from STS MFS process
...S DGMTEDI="",DGMTEDI=$O(^DGRAM(10.99,DGMRACI,"TERMSTATUS","B",DGMTED,DGMTEDI))
...S DGMTST=$P(^DGRAM(10.99,DGMRACI,"TERMSTATUS",DGMTEDI,0),"^",2)
...W ?25," Master Status: ",$S(DGMTST:"ACTIVE",1:"INACTIVE")
..S DGMV0=$G(^DGRAM(10.99,DGMRACI,"VUID"))
..I $G(DGMV0) W !?3,"VUID: ",$P(DGMV0,"^")
Q
;
MUA(DGMUA) ; Select (M)apped, (U)nmapped, or(A)ll - entries from 10 mapped to 10.99
N DIR,DIRUT,Y
W ! S DIR(0)="SAO^M:(M)apped;U:(U)nmapped;A:(A)ll"
S DIR("?")="Enter ^ to exit"
S DIR("A",1)="Run the report for"
S DIR("A")="(M)apped, (U)nmapped, or (A)ll Race entries: ",DIR("B")="A" D ^DIR
I $D(DIRUT) S DGOUT=1 Q
S DGMUA=Y
Q
;
SUMMARY() ; ask to print detailed or summary report
N DIR,DIRUT,X,Y
S DIR(0)="SOA^D:Detailed;S:Summary;",DIR("B")="Summary"
S DIR("A")="Type of report to print: "
W ! D ^DIR
I $D(DIRUT) S DGSRAC=1 Q 0
Q $S(Y="S":1,Y="D":2,1:0)
;
OUT() ; select Excel or Report format
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
W !
S DIR(0)="SA^E:Excel;R:Report"
S DIR("A")="(E)xcel Format or (R)eport Format: "
S DIR("B")="Report"
D ^DIR I $D(DIRUT) S DGSRAC=1 Q ""
Q Y
;
DELIM(DGRAC0,DGRACI) ; Print output in "^" delimited format
; Print data in (E)xcel format, e.g., "data^data^data"
I '$G(DGDELHD) S DGDELHD=1 D
.I $G(DGSUM)=1 W !,"VA Race^Mapped/Not Mapped^Race Master"
.I $G(DGSUM)=2 W !,"VA Race^VA Race Abbreviation^VA Race Status^VA Race HL7 Code^VA Race PTF Code^Mapped/Not Mapped^Race Master Name^Race Master Code^Race Master Status^VUID"
S DGRACST=$G(^TMP($J,"DGMFR10",DGRAC0,DGRACI,"STATUS"))
S DGRACST=$S(DGRACST:"INACTIVE",1:"ACTIVE")
W !,$P(DGRAC0,"^")
I $G(DGSUM)=2 D
.W "^",$P(DGRAC0,"^",2)
.W "^",DGRACST
.S DGCT=$P(DGRAC0,"^",3) I $L(DGCT) D
..D FIELD^DID(10,90,"","POINTER","DGCTS")
..S DGCTX=$P(DGCTS("POINTER"),+DGCT_":",2),DGCTX=$P(DGCTX,";")
..I $L(DGCTX) W "^",DGCTX
.W "^",$P(DGRAC0,"^",3)
.W "^",$P(DGRAC0,"^",5)
S DGMRAC0=$G(^TMP($J,"DGMFR10",DGRAC0,DGRACI,"MRACE"))
S DGMRACI=+$P(DGMRAC0,"^",4)
W "^",$S(DGMRACI:"MAPPED",1:"NOT MAPPED")
Q:'DGMRACI
W "^",$P(DGMRAC0,"^") ;$P(^TMP($J,"DGMFR10",DGRAC0,DGRACI,"MRACE"),"^")
I $G(DGSUM)=2 D
.W "^",$P(DGMRAC0,"^",2)
.S DGMTED=$$NOW^XLFDT,DGMTED=$O(^DGRAM(10.99,DGMRACI,"TERMSTATUS","B",DGMTED),-1)
.I DGMTED D
..S DGMTEDI="",DGMTEDI=$O(^DGRAM(10.99,DGMRACI,"TERMSTATUS","B",DGMTED,DGMTEDI))
..S DGMTST=$P(^DGRAM(10.99,DGMRACI,"TERMSTATUS",DGMTEDI,0),"^",2)
..W "^",$S(DGMTST:"ACTIVE",1:"INACTIVE")
.S DGMV0=$P($G(^DGRAM(10.99,DGMRACI,"VUID")),"^")
.W "^",$P(DGMV0,"^")
Q
;
SELDEV() ; Propmt for output device, return 1 if queued
I DGOUTP="E" D
.N DIR,X,Y
.S DIR("A",1)=""
.S DIR("A",2)=" ************************************************************"
.S DIR("A",3)=" ** You selected a Delimited report. Please verify you **"
.S DIR("A",4)=" ** you have turned logging on to capture the output. **"
.S DIR("A",5)=" ** **"
.S DIR("A",6)=" ** To avoid undesired wrapping, enter '0;199;999' at **"
.S DIR("A",7)=" ** the 'DEVICE:' prompt. The Terminal Session display **"
.S DIR("A",8)=" ** may need to be set to 199 columns. **"
.S DIR("A",9)=" ************************************************************"
.S DIR("A",10)=""
.S DIR("A",11)="",DIR("A",12)=""
.S DIR("A")=" Press return to continue"
.S DIR(0)="EA" D ^DIR W !
;
N DGDONE
W !,"You may queue this report to print at a later time.",!
F Q:$G(DGSRAC)!$G(DGDONE) D
.K %ZIS,IOP,POP,ZTSK N I S DGION=$I,%ZIS="QM"
.D ^%ZIS K %ZIS
.I POP S IOP=DGION D ^%ZIS K IOP,DGION D Q
..N DIR,X,Y
..S DIR(0)="YA",DIR("A",1)=" ** No Device Selected **",DIR("A")="Select a different device? (Y/N) " D ^DIR
..S:'Y DGSRAC=1
.S DGDONE=1
I $D(IO("Q")) D Q 1
.N ZTDESC,ZTSAVE,ZTRTN
.S ZTDESC="Race to Race Master Mapping Report",ZTRTN="DQ^DGMFR10"
.S ZTSAVE("DATE*")="",ZTSAVE("DG*")="",ZTSAVE("ZTREQ")="@"
.K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print!" K ZTSK
Q:$G(DGSRAC) -1
Q 0
;
N DGHDR,DGTAB,DGSPACE
S DGSRAC=0
I CRT,DGPGCNT>0,'$D(ZTQUEUED) D Q:DGSRAC
.N DIR,LIN
.I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
.W !
.S DIR(0)="E" D ^DIR K DIR
.I 'Y S DGSRAC=1 Q
S DGPGCNT=DGPGCNT+1
W @IOF,!
S $P(DGSPACE," ",132)=""
S DGHDR=" Race to Race Master Report "
S DGHDR=DGHDR_"Page: "_DGPGCNT,DGTAB=132-$L(DGHDR)-1
W ?DGTAB,DGHDR
Q
;
PRINRAC(DGRACI) ; Print Race file (#10) entry
W !!,"Race: ",$P(DGRAC0,"^")
N DGCT2
I $G(DGSUM)=2 D
.W !,"Abbreviation: ",$P(DGRAC0,"^",2)
.W ?30,"Status: ",DGRACST
.S DGCT=$P(DGRAC0,"^",3) I $L(DGCT) W !?3,"HL7 Value: ",DGCT
.S DGCT2=$P(DGRAC0,"^",5) I $L(DGCT2) W ?27,"PTF Value: ",DGCT2
S DGMRAC0=$G(^TMP($J,"DGMFR10",DGRAC0,DGRACI,"MRACE"))
S DGMRACI=+$P(DGMRAC0,"^",4)
W !,"Mapped to Race Master: ",$S(DGMRACI:"YES",1:"NO")
Q:'DGMRACI
W !?3,"Race Master Name: ",$P(^TMP($J,"DGMFR10",DGRAC0,DGRACI,"MRACE"),"^")
Q
;
INFO ; Display message, clear screen
N MSG
S MSG(1)=" This report prints Races from the RACE file (#10) and each"
S MSG(2)=" race's mapping relationship to the RACE MASTER (#10.99) file."
S MSG(3)=""
D CLEAR^VALM1
D BMES^XPDUTL(.MSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMFR10 8300 printed Dec 13, 2024@02:44:11 Page 2
DGMFR10 ;DAL/JCH - NDS DEMOGRAPHICS RACE MASTER ASSOCIATIONS REPORT ;15-AUG-2017
+1 ;;5.3;Registration;**933**;Aug 13, 1993;Build 44
+2 ;
+3 ; Available at Master File Reports [DGMF RMAIN] option, at the following menu path:
+4 ; Supervisor ADT Menu [DG SUPERVISOR MENU]
+5 ; ADT System Definition Menu [DG SYSTEM DEFINITION MENU]
+6 ; Master File Menu [DGMF MNU]
+7 ; Master File Reports [DGMF RMAIN]
+8 QUIT
+9 ;
EN ; MRAC Report Entry point
+1 NEW DGOUT
+2 SET DGOUT=0
+3 FOR
if $GET(DGOUT)
QUIT
Begin DoDot:1
+4 DO MAIN
if DGOUT
QUIT
+5 NEW DIR
WRITE !!
+6 SET DIR(0)="Y"
SET DIR("B")="Y"
SET DIR("A")="Run report again"
DO ^DIR
+7 if X'="Y"
SET DGOUT=1
End DoDot:1
+8 QUIT
+9 ;
MAIN ; Driver loop
+1 NEW DGSUM,DGMUA,DGSRAC,DGOUTP
+2 SET DGSRAC=0
+3 ;
+4 DO INFO
+5 ; Select (M)apped, (U)nmapped, or (A)ll entries from RACE (#10) file.
+6 WRITE !
DO MUA(.DGMUA)
IF '$DATA(DGMUA)!$GET(DGOUT)
SET DGOUT=1
QUIT
+7 ;
+8 ; Select summary report or detailed
+9 SET DGSUM=$$SUMMARY
IF 'DGSUM
QUIT
+10 ;
+11 ; Select output format
+12 SET DGOUTP=$$OUT
IF DGSRAC
QUIT
+13 ;
+14 ; Select device
+15 IF $$SELDEV()!DGSRAC
QUIT
+16 ;
+17 IF DGOUTP="R"
WRITE !!,"<*> please wait <*>"
+18 USE IO
DO DQ
+19 ;
+20 QUIT
+21 ;
DQ ; report (queue) starts here
+1 NEW DGRACI,DGMRACI,DGRAC0,DGMRAC0
+2 ;
+3 KILL ^TMP($JOB,"DGMFR10")
+4 ; build list of races
+5 SET DGRACI=0
FOR
SET DGRACI=$ORDER(^DIC(10,DGRACI))
if 'DGRACI
QUIT
Begin DoDot:1
+6 SET DGRAC0=$GET(^DIC(10,DGRACI,0))
+7 SET DGRACP02=+$GET(^DIC(10,DGRACI,.02))
+8 SET DGMRACI=+$GET(^DIC(10,DGRACI,"MASTER"))
+9 IF $GET(DGMUA)="U"
IF $GET(DGMRACI)
QUIT
+10 IF $GET(DGMUA)="M"
IF '$GET(DGMRACI)
QUIT
+11 SET DGMRAC0=$SELECT($GET(DGMRACI):$GET(^DGRAM(10.99,+DGMRACI,0)),1:"Not Mapped")
+12 IF DGMRACI
SET $PIECE(DGMRAC0,"^",4)=DGMRACI
+13 SET ^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"RAC")=$GET(DGRAC0)
+14 SET ^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"STATUS")=DGRACP02
+15 SET ^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"MRACE")=$GET(DGMRAC0)
End DoDot:1
+16 ;
+17 DO PRINT
+18 ;
+19 DO ^%ZISC
+20 KILL ^TMP($JOB,"DGMFR10")
+21 QUIT
+22 ;
PRINT ; Print output
+1 NEW MAXCNT,DGSRAC,DGPGCNT,DGHDR,CRT,DGDELHD
+2 IF IOST["C-"
SET MAXCNT=IOSL-10
SET CRT=1
+3 IF '$TEST
SET MAXCNT=IOSL-6
SET CRT=0
+4 IF DGSUM=1
SET MAXCNT=MAXCNT+5
+5 SET DGPGCNT=0
SET DGSRAC=0
+6 ;
+7 IF '$DATA(^TMP($JOB,"DGMFR10"))
DO HEADER
WRITE !!!?5,"No Data Found"
QUIT
+8 ;
+9 NEW DGRACI,DGRAC0
+10 SET DGRAC0=""
FOR
SET DGRAC0=$ORDER(^TMP($JOB,"DGMFR10",DGRAC0))
if DGRAC0=""
QUIT
DO PRINT2(DGRAC0)
+11 QUIT
+12 ;
PRINT2(DGRAC0) ; Get details
+1 SET DGRACI=0
FOR
SET DGRACI=$ORDER(^TMP($JOB,"DGMFR10",DGRAC0,DGRACI))
if 'DGRACI!DGSRAC
QUIT
Begin DoDot:1
+2 NEW DGMRAC0,DGCT,DGCTS,DGCTX,DGRACST
+3 NEW DGMTST,DGMTED,DGMRACI,DGMTEDI,DGMPAR,DGMPARX
+4 NEW DGMREPL,DGMREPX,DGMV0
+5 ;
+6 IF $GET(DGOUTP)="E"
DO DELIM(DGRAC0,DGRACI)
QUIT
+7 ;
+8 IF ($Y+1>MAXCNT)!'DGPGCNT
DO HEADER
if DGSRAC
QUIT
+9 SET DGRAC0=$GET(^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"RAC"))
+10 SET DGRACST=+$GET(^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"STATUS"))
SET DGRACST=$SELECT(DGRACST:"INACTIVE",1:"ACTIVE")
+11 DO PRINRAC(DGRACI)
+12 ;
+13 if 'DGMRACI
QUIT
+14 IF $GET(DGSUM)=2
Begin DoDot:2
+15 WRITE !?3,"Master Code: ",$PIECE(^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"MRACE"),"^",2)
+16 SET DGMTED=$$NOW^XLFDT
SET DGMTED=$ORDER(^DGRAM(10.99,DGMRACI,"TERMSTATUS","B",DGMTED),-1)
+17 ; This should always be true, if data came from STS MFS process
IF DGMTED
Begin DoDot:3
+18 SET DGMTEDI=""
SET DGMTEDI=$ORDER(^DGRAM(10.99,DGMRACI,"TERMSTATUS","B",DGMTED,DGMTEDI))
+19 SET DGMTST=$PIECE(^DGRAM(10.99,DGMRACI,"TERMSTATUS",DGMTEDI,0),"^",2)
+20 WRITE ?25," Master Status: ",$SELECT(DGMTST:"ACTIVE",1:"INACTIVE")
End DoDot:3
+21 SET DGMV0=$GET(^DGRAM(10.99,DGMRACI,"VUID"))
+22 IF $GET(DGMV0)
WRITE !?3,"VUID: ",$PIECE(DGMV0,"^")
End DoDot:2
End DoDot:1
+23 QUIT
+24 ;
MUA(DGMUA) ; Select (M)apped, (U)nmapped, or(A)ll - entries from 10 mapped to 10.99
+1 NEW DIR,DIRUT,Y
+2 WRITE !
SET DIR(0)="SAO^M:(M)apped;U:(U)nmapped;A:(A)ll"
+3 SET DIR("?")="Enter ^ to exit"
+4 SET DIR("A",1)="Run the report for"
+5 SET DIR("A")="(M)apped, (U)nmapped, or (A)ll Race entries: "
SET DIR("B")="A"
DO ^DIR
+6 IF $DATA(DIRUT)
SET DGOUT=1
QUIT
+7 SET DGMUA=Y
+8 QUIT
+9 ;
SUMMARY() ; ask to print detailed or summary report
+1 NEW DIR,DIRUT,X,Y
+2 SET DIR(0)="SOA^D:Detailed;S:Summary;"
SET DIR("B")="Summary"
+3 SET DIR("A")="Type of report to print: "
+4 WRITE !
DO ^DIR
+5 IF $DATA(DIRUT)
SET DGSRAC=1
QUIT 0
+6 QUIT $SELECT(Y="S":1,Y="D":2,1:0)
+7 ;
OUT() ; select Excel or Report format
+1 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 WRITE !
+3 SET DIR(0)="SA^E:Excel;R:Report"
+4 SET DIR("A")="(E)xcel Format or (R)eport Format: "
+5 SET DIR("B")="Report"
+6 DO ^DIR
IF $DATA(DIRUT)
SET DGSRAC=1
QUIT ""
+7 QUIT Y
+8 ;
DELIM(DGRAC0,DGRACI) ; Print output in "^" delimited format
+1 ; Print data in (E)xcel format, e.g., "data^data^data"
+2 IF '$GET(DGDELHD)
SET DGDELHD=1
Begin DoDot:1
+3 IF $GET(DGSUM)=1
WRITE !,"VA Race^Mapped/Not Mapped^Race Master"
+4 IF $GET(DGSUM)=2
WRITE !,"VA Race^VA Race Abbreviation^VA Race Status^VA Race HL7 Code^VA Race PTF Code^Mapped/Not Mapped^Race Master Name^Race Master Code^Race Master Status^VUID"
End DoDot:1
+5 SET DGRACST=$GET(^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"STATUS"))
+6 SET DGRACST=$SELECT(DGRACST:"INACTIVE",1:"ACTIVE")
+7 WRITE !,$PIECE(DGRAC0,"^")
+8 IF $GET(DGSUM)=2
Begin DoDot:1
+9 WRITE "^",$PIECE(DGRAC0,"^",2)
+10 WRITE "^",DGRACST
+11 SET DGCT=$PIECE(DGRAC0,"^",3)
IF $LENGTH(DGCT)
Begin DoDot:2
+12 DO FIELD^DID(10,90,"","POINTER","DGCTS")
+13 SET DGCTX=$PIECE(DGCTS("POINTER"),+DGCT_":",2)
SET DGCTX=$PIECE(DGCTX,";")
+14 IF $LENGTH(DGCTX)
WRITE "^",DGCTX
End DoDot:2
+15 WRITE "^",$PIECE(DGRAC0,"^",3)
+16 WRITE "^",$PIECE(DGRAC0,"^",5)
End DoDot:1
+17 SET DGMRAC0=$GET(^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"MRACE"))
+18 SET DGMRACI=+$PIECE(DGMRAC0,"^",4)
+19 WRITE "^",$SELECT(DGMRACI:"MAPPED",1:"NOT MAPPED")
+20 if 'DGMRACI
QUIT
+21 ;$P(^TMP($J,"DGMFR10",DGRAC0,DGRACI,"MRACE"),"^")
WRITE "^",$PIECE(DGMRAC0,"^")
+22 IF $GET(DGSUM)=2
Begin DoDot:1
+23 WRITE "^",$PIECE(DGMRAC0,"^",2)
+24 SET DGMTED=$$NOW^XLFDT
SET DGMTED=$ORDER(^DGRAM(10.99,DGMRACI,"TERMSTATUS","B",DGMTED),-1)
+25 IF DGMTED
Begin DoDot:2
+26 SET DGMTEDI=""
SET DGMTEDI=$ORDER(^DGRAM(10.99,DGMRACI,"TERMSTATUS","B",DGMTED,DGMTEDI))
+27 SET DGMTST=$PIECE(^DGRAM(10.99,DGMRACI,"TERMSTATUS",DGMTEDI,0),"^",2)
+28 WRITE "^",$SELECT(DGMTST:"ACTIVE",1:"INACTIVE")
End DoDot:2
+29 SET DGMV0=$PIECE($GET(^DGRAM(10.99,DGMRACI,"VUID")),"^")
+30 WRITE "^",$PIECE(DGMV0,"^")
End DoDot:1
+31 QUIT
+32 ;
SELDEV() ; Propmt for output device, return 1 if queued
+1 IF DGOUTP="E"
Begin DoDot:1
+2 NEW DIR,X,Y
+3 SET DIR("A",1)=""
+4 SET DIR("A",2)=" ************************************************************"
+5 SET DIR("A",3)=" ** You selected a Delimited report. Please verify you **"
+6 SET DIR("A",4)=" ** you have turned logging on to capture the output. **"
+7 SET DIR("A",5)=" ** **"
+8 SET DIR("A",6)=" ** To avoid undesired wrapping, enter '0;199;999' at **"
+9 SET DIR("A",7)=" ** the 'DEVICE:' prompt. The Terminal Session display **"
+10 SET DIR("A",8)=" ** may need to be set to 199 columns. **"
+11 SET DIR("A",9)=" ************************************************************"
+12 SET DIR("A",10)=""
+13 SET DIR("A",11)=""
SET DIR("A",12)=""
+14 SET DIR("A")=" Press return to continue"
+15 SET DIR(0)="EA"
DO ^DIR
WRITE !
End DoDot:1
+16 ;
+17 NEW DGDONE
+18 WRITE !,"You may queue this report to print at a later time.",!
+19 FOR
if $GET(DGSRAC)!$GET(DGDONE)
QUIT
Begin DoDot:1
+20 KILL %ZIS,IOP,POP,ZTSK
NEW I
SET DGION=$IO
SET %ZIS="QM"
+21 DO ^%ZIS
KILL %ZIS
+22 IF POP
SET IOP=DGION
DO ^%ZIS
KILL IOP,DGION
Begin DoDot:2
+23 NEW DIR,X,Y
+24 SET DIR(0)="YA"
SET DIR("A",1)=" ** No Device Selected **"
SET DIR("A")="Select a different device? (Y/N) "
DO ^DIR
+25 if 'Y
SET DGSRAC=1
End DoDot:2
QUIT
+26 SET DGDONE=1
End DoDot:1
+27 IF $DATA(IO("Q"))
Begin DoDot:1
+28 NEW ZTDESC,ZTSAVE,ZTRTN
+29 SET ZTDESC="Race to Race Master Mapping Report"
SET ZTRTN="DQ^DGMFR10"
+30 SET ZTSAVE("DATE*")=""
SET ZTSAVE("DG*")=""
SET ZTSAVE("ZTREQ")="@"
+31 KILL IO("Q")
DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"Report is Queued to print!"
KILL ZTSK
End DoDot:1
QUIT 1
+32 if $GET(DGSRAC)
QUIT -1
+33 QUIT 0
+34 ;
+1 NEW DGHDR,DGTAB,DGSPACE
+2 SET DGSRAC=0
+3 IF CRT
IF DGPGCNT>0
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+4 NEW DIR,LIN
+5 IF MAXCNT<51
FOR LIN=1:1:(MAXCNT-$Y)
WRITE !
+6 WRITE !
+7 SET DIR(0)="E"
DO ^DIR
KILL DIR
+8 IF 'Y
SET DGSRAC=1
QUIT
End DoDot:1
if DGSRAC
QUIT
+9 SET DGPGCNT=DGPGCNT+1
+10 WRITE @IOF,!
+11 SET $PIECE(DGSPACE," ",132)=""
+12 SET DGHDR=" Race to Race Master Report "
+13 SET DGHDR=DGHDR_"Page: "_DGPGCNT
SET DGTAB=132-$LENGTH(DGHDR)-1
+14 WRITE ?DGTAB,DGHDR
+15 QUIT
+16 ;
PRINRAC(DGRACI) ; Print Race file (#10) entry
+1 WRITE !!,"Race: ",$PIECE(DGRAC0,"^")
+2 NEW DGCT2
+3 IF $GET(DGSUM)=2
Begin DoDot:1
+4 WRITE !,"Abbreviation: ",$PIECE(DGRAC0,"^",2)
+5 WRITE ?30,"Status: ",DGRACST
+6 SET DGCT=$PIECE(DGRAC0,"^",3)
IF $LENGTH(DGCT)
WRITE !?3,"HL7 Value: ",DGCT
+7 SET DGCT2=$PIECE(DGRAC0,"^",5)
IF $LENGTH(DGCT2)
WRITE ?27,"PTF Value: ",DGCT2
End DoDot:1
+8 SET DGMRAC0=$GET(^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"MRACE"))
+9 SET DGMRACI=+$PIECE(DGMRAC0,"^",4)
+10 WRITE !,"Mapped to Race Master: ",$SELECT(DGMRACI:"YES",1:"NO")
+11 if 'DGMRACI
QUIT
+12 WRITE !?3,"Race Master Name: ",$PIECE(^TMP($JOB,"DGMFR10",DGRAC0,DGRACI,"MRACE"),"^")
+13 QUIT
+14 ;
INFO ; Display message, clear screen
+1 NEW MSG
+2 SET MSG(1)=" This report prints Races from the RACE file (#10) and each"
+3 SET MSG(2)=" race's mapping relationship to the RACE MASTER (#10.99) file."
+4 SET MSG(3)=""
+5 DO CLEAR^VALM1
+6 DO BMES^XPDUTL(.MSG)
+7 QUIT
