DGMFR11 ;DAL/JCH - NDS DEMOGRAPHICS MASTER MARITAL STATUS 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 ; MMS 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,DGSMS,DGOUTP
S DGSMS=0
;
D INFO
; Select (M)apped, (U)nmapped, or (A)ll entries from Marital Status (#11) file.
D MUA(.DGMUA) I '$D(DGMUA)!$G(DGOUT) S DGOUT=1 Q
S DGSUM=$$SUMMARY I 'DGSUM Q
;
; Select output format
S DGOUTP=$$OUT I DGSMS Q
;
; Select device
I $$SELDEV()!DGSMS Q
;
I DGOUTP="R" W !!,"<*> please wait <*>"
U IO D DQ
Q
;
DQ ; report (queue) starts here
N DGMSI,DGMMSI,DGMS0,DGMMS0
;
K ^TMP($J,"DGMFR11")
; build list of Marital Statuses
S DGMSI=0 F S DGMSI=$O(^DIC(11,DGMSI)) Q:'DGMSI D
.S DGMS0=$G(^DIC(11,DGMSI,0))
.S DGMSP02=+$G(^DIC(11,DGMSI,.02))
.S DGMMSI=+$G(^DIC(11,DGMSI,"MASTER"))
.I $G(DGMUA)="U",$G(DGMMSI) Q
.I $G(DGMUA)="M",'$G(DGMMSI) Q
.S DGMMS0=$S($G(DGMMSI):$G(^DGMMS(11.99,+DGMMSI,0)),1:"Not Mapped")
.I DGMMSI S $P(DGMMS0,"^",4)=DGMMSI
.S ^TMP($J,"DGMFR11",DGMS0,DGMSI,"MS")=$G(DGMS0)
.S ^TMP($J,"DGMFR11",DGMS0,DGMSI,"STATUS")=DGMSP02
.S ^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE")=$G(DGMMS0)
;
D PRINT
;
D ^%ZISC
K ^TMP($J,"DGMFR11")
Q
;
PRINT ; Print output
N MAXCNT,DGSMS,DGPGCNT,DGHDR,CRT,DGMS0,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,DGSMS=0
;
I '$D(^TMP($J,"DGMFR11")) D HEADER W !!!?5,"No Data Found" Q
;
S DGMS0="" F S DGMS0=$O(^TMP($J,"DGMFR11",DGMS0)) Q:DGMS0="" D PRINT2(DGMS0)
Q
PRINT2(DGMS0) ; Get details
N DGMSI
S DGMSI=0 F S DGMSI=$O(^TMP($J,"DGMFR11",DGMS0,DGMSI)) Q:'DGMSI!DGSMS D
.N DGMMS0,DGCT,DGCTS,DGCTX,DGMSST
.N DGMTST,DGMTED,DGMMSI,DGMTEDI,DGMPAR,DGMPARX
.N DGMREPL,DGMREPX,DGMV0
.;
.I $G(DGOUTP)="E" D DELIM(DGMS0,DGMSI) Q
.;
.I ($Y+1>MAXCNT)!'DGPGCNT D HEADER Q:DGSMS
.S DGMS0=$G(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MS"))
.S DGMSST=+$G(^TMP($J,"DGMFR11",DGMS0,DGMSI,"STATUS")),DGMSST=$S(DGMSST:"INACTIVE",1:"ACTIVE")
.D PRINMS(DGMSI)
.;
.Q:'DGMMSI
.I $G(DGSUM)=2 D
..S DGMTED=$$NOW^XLFDT,DGMTED=$O(^DGMMS(11.99,DGMMSI,"TERMSTATUS","B",DGMTED),-1)
..I DGMTED D ; This should always be true, if data came from STS MFS process
...S DGMTEDI="",DGMTEDI=$O(^DGMMS(11.99,DGMMSI,"TERMSTATUS","B",DGMTED,DGMTEDI))
...S DGMTST=$P(^DGMMS(11.99,DGMMSI,"TERMSTATUS",DGMTEDI,0),"^",2)
...W ?25,"Master Status: ",$S(DGMTST:"ACTIVE",1:"INACTIVE")
..S DGMV0=$G(^DGMMS(11.99,DGMMSI,"VUID"))
..W !?3,"VUID: ",$P(DGMV0,"^")
Q
;
MUA(DGMUA) ; Select (M)apped, (U)nmapped, or(A)ll - entries from 11 mapped to 11.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 Marital Status 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 DGSMS=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 DGSMS=1 Q ""
Q Y
;
DELIM(DGMS0,DGMSI) ; 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 Marital Status^Mapped/Not Mapped^Master Marital Status"
.I $G(DGSUM)=2 W !,"VA Marital Status^VA Abbreviation^VA Status^VA Code^Mapped/Not Mapped^Master MS Name^Master MS Code^Master Status^VUID"
S DGMSST=$P(DGMS0,"^",4)
S DGMSST=$S(DGMSST:"INACTIVE",1:"ACTIVE")
W !,$P(DGMS0,"^")
I $G(DGSUM)=2 D
.W "^",$P(DGMS0,"^",2)
.W "^",DGMSST
.S DGCT=$P(DGMS0,"^",3) W "^",DGCT
S DGMMS0=$G(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE"))
S DGMMSI=+$P(DGMMS0,"^",4)
W "^",$S(DGMMSI:"MAPPED",1:"NOT MAPPED")
Q:'DGMMSI
W "^",$P(DGMMS0,"^") ; $P(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE"),"^")
I $G(DGSUM)=2 D
.W "^",$P(DGMMS0,"^",2)
.S DGMTED=$$NOW^XLFDT,DGMTED=$O(^DGMMS(11.99,DGMMSI,"TERMSTATUS","B",DGMTED),-1)
.I $G(DGMTED) D
..S DGMTEDI="",DGMTEDI=$O(^DGMMS(11.99,DGMMSI,"TERMSTATUS","B",DGMTED,DGMTEDI))
..S DGMTST=$P(^DGMMS(11.99,DGMMSI,"TERMSTATUS",DGMTEDI,0),"^",2)
..W "^",$S(DGMTST:"ACTIVE",1:"INACTIVE")
.S DGMV0=$G(^DGMMS(11.99,DGMMSI,"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(DGSMS)!$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 DGSMS=1
.S DGDONE=1
I $D(IO("Q")) D Q 1
.N ZTDESC,ZTSAVE,ZTRTN
.S ZTDESC="Marital Status to Master Marital Status Mapping Report",ZTRTN="DQ^DGMFR11"
.S ZTSAVE("DATE*")="",ZTSAVE("DG*")="",ZTSAVE("ZTREQ")="@"
.K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print!" K ZTSK
Q:$G(DGSMS) -1
Q 0
;
N DGHDR,DGTAB,DGSPACE
S DGSMS=0
I CRT,DGPGCNT>0,'$D(ZTQUEUED) D Q:DGSMS
.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 DGSMS=1 Q
S DGPGCNT=DGPGCNT+1
W @IOF,!
S $P(DGSPACE," ",132)=""
S DGHDR=" Marital Status to Master Marital Status Report "
S DGHDR=DGHDR_"Page: "_DGPGCNT,DGTAB=132-$L(DGHDR)-1
W ?DGTAB,DGHDR
Q
;
PRINMS(DGMSI) ; Print Marital Status file (#11) entry
W !!,"Marital Status: ",$P(DGMS0,"^")
N DGCT2
I $G(DGSUM)=2 D
.W !,"Abbreviation: ",$P(DGMS0,"^",2)
.W ?30,"Status: ",DGMSST
.S DGCT=$P(DGMS0,"^",3) I $L(DGCT) W !?3,"Code: ",DGCT
S DGMMS0=$G(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE"))
S DGMMSI=+$P(DGMMS0,"^",4)
W !,"Mapped to Master Marital Status : ",$S(DGMMSI:"YES",1:"NO")
Q:'DGMMSI
W !?3,"Master MS Name: ",$P(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE"),"^")
I $G(DGSUM)=2 W !?3,"Master Code: ",$P(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE"),"^",2)
Q
;
INFO ; Display message, clear screen
N MSG
S MSG(1)=" This report prints Marital Statuses from the MARITAL"
S MSG(2)=" STATUS file (#11), and each Marital Status' relationship"
S MSG(3)=" to the Master Marital Status (#11.99) file."
S MSG(4)=""
D CLEAR^VALM1
D BMES^XPDUTL(.MSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMFR11 7966 printed Sep 23, 2025@20:20:04 Page 2
DGMFR11 ;DAL/JCH - NDS DEMOGRAPHICS MASTER MARITAL STATUS 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 ; MMS 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,DGSMS,DGOUTP
+2 SET DGSMS=0
+3 ;
+4 DO INFO
+5 ; Select (M)apped, (U)nmapped, or (A)ll entries from Marital Status (#11) file.
+6 DO MUA(.DGMUA)
IF '$DATA(DGMUA)!$GET(DGOUT)
SET DGOUT=1
QUIT
+7 SET DGSUM=$$SUMMARY
IF 'DGSUM
QUIT
+8 ;
+9 ; Select output format
+10 SET DGOUTP=$$OUT
IF DGSMS
QUIT
+11 ;
+12 ; Select device
+13 IF $$SELDEV()!DGSMS
QUIT
+14 ;
+15 IF DGOUTP="R"
WRITE !!,"<*> please wait <*>"
+16 USE IO
DO DQ
+17 QUIT
+18 ;
DQ ; report (queue) starts here
+1 NEW DGMSI,DGMMSI,DGMS0,DGMMS0
+2 ;
+3 KILL ^TMP($JOB,"DGMFR11")
+4 ; build list of Marital Statuses
+5 SET DGMSI=0
FOR
SET DGMSI=$ORDER(^DIC(11,DGMSI))
if 'DGMSI
QUIT
Begin DoDot:1
+6 SET DGMS0=$GET(^DIC(11,DGMSI,0))
+7 SET DGMSP02=+$GET(^DIC(11,DGMSI,.02))
+8 SET DGMMSI=+$GET(^DIC(11,DGMSI,"MASTER"))
+9 IF $GET(DGMUA)="U"
IF $GET(DGMMSI)
QUIT
+10 IF $GET(DGMUA)="M"
IF '$GET(DGMMSI)
QUIT
+11 SET DGMMS0=$SELECT($GET(DGMMSI):$GET(^DGMMS(11.99,+DGMMSI,0)),1:"Not Mapped")
+12 IF DGMMSI
SET $PIECE(DGMMS0,"^",4)=DGMMSI
+13 SET ^TMP($JOB,"DGMFR11",DGMS0,DGMSI,"MS")=$GET(DGMS0)
+14 SET ^TMP($JOB,"DGMFR11",DGMS0,DGMSI,"STATUS")=DGMSP02
+15 SET ^TMP($JOB,"DGMFR11",DGMS0,DGMSI,"MMSE")=$GET(DGMMS0)
End DoDot:1
+16 ;
+17 DO PRINT
+18 ;
+19 DO ^%ZISC
+20 KILL ^TMP($JOB,"DGMFR11")
+21 QUIT
+22 ;
PRINT ; Print output
+1 NEW MAXCNT,DGSMS,DGPGCNT,DGHDR,CRT,DGMS0,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 DGSMS=0
+6 ;
+7 IF '$DATA(^TMP($JOB,"DGMFR11"))
DO HEADER
WRITE !!!?5,"No Data Found"
QUIT
+8 ;
+9 SET DGMS0=""
FOR
SET DGMS0=$ORDER(^TMP($JOB,"DGMFR11",DGMS0))
if DGMS0=""
QUIT
DO PRINT2(DGMS0)
+10 QUIT
PRINT2(DGMS0) ; Get details
+1 NEW DGMSI
+2 SET DGMSI=0
FOR
SET DGMSI=$ORDER(^TMP($JOB,"DGMFR11",DGMS0,DGMSI))
if 'DGMSI!DGSMS
QUIT
Begin DoDot:1
+3 NEW DGMMS0,DGCT,DGCTS,DGCTX,DGMSST
+4 NEW DGMTST,DGMTED,DGMMSI,DGMTEDI,DGMPAR,DGMPARX
+5 NEW DGMREPL,DGMREPX,DGMV0
+6 ;
+7 IF $GET(DGOUTP)="E"
DO DELIM(DGMS0,DGMSI)
QUIT
+8 ;
+9 IF ($Y+1>MAXCNT)!'DGPGCNT
DO HEADER
if DGSMS
QUIT
+10 SET DGMS0=$GET(^TMP($JOB,"DGMFR11",DGMS0,DGMSI,"MS"))
+11 SET DGMSST=+$GET(^TMP($JOB,"DGMFR11",DGMS0,DGMSI,"STATUS"))
SET DGMSST=$SELECT(DGMSST:"INACTIVE",1:"ACTIVE")
+12 DO PRINMS(DGMSI)
+13 ;
+14 if 'DGMMSI
QUIT
+15 IF $GET(DGSUM)=2
Begin DoDot:2
+16 SET DGMTED=$$NOW^XLFDT
SET DGMTED=$ORDER(^DGMMS(11.99,DGMMSI,"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(^DGMMS(11.99,DGMMSI,"TERMSTATUS","B",DGMTED,DGMTEDI))
+19 SET DGMTST=$PIECE(^DGMMS(11.99,DGMMSI,"TERMSTATUS",DGMTEDI,0),"^",2)
+20 WRITE ?25,"Master Status: ",$SELECT(DGMTST:"ACTIVE",1:"INACTIVE")
End DoDot:3
+21 SET DGMV0=$GET(^DGMMS(11.99,DGMMSI,"VUID"))
+22 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 11 mapped to 11.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 Marital Status 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 DGSMS=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 DGSMS=1
QUIT ""
+7 QUIT Y
+8 ;
DELIM(DGMS0,DGMSI) ; 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 Marital Status^Mapped/Not Mapped^Master Marital Status"
+4 IF $GET(DGSUM)=2
WRITE !,"VA Marital Status^VA Abbreviation^VA Status^VA Code^Mapped/Not Mapped^Master MS Name^Master MS Code^Master Status^VUID"
End DoDot:1
+5 SET DGMSST=$PIECE(DGMS0,"^",4)
+6 SET DGMSST=$SELECT(DGMSST:"INACTIVE",1:"ACTIVE")
+7 WRITE !,$PIECE(DGMS0,"^")
+8 IF $GET(DGSUM)=2
Begin DoDot:1
+9 WRITE "^",$PIECE(DGMS0,"^",2)
+10 WRITE "^",DGMSST
+11 SET DGCT=$PIECE(DGMS0,"^",3)
WRITE "^",DGCT
End DoDot:1
+12 SET DGMMS0=$GET(^TMP($JOB,"DGMFR11",DGMS0,DGMSI,"MMSE"))
+13 SET DGMMSI=+$PIECE(DGMMS0,"^",4)
+14 WRITE "^",$SELECT(DGMMSI:"MAPPED",1:"NOT MAPPED")
+15 if 'DGMMSI
QUIT
+16 ; $P(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE"),"^")
WRITE "^",$PIECE(DGMMS0,"^")
+17 IF $GET(DGSUM)=2
Begin DoDot:1
+18 WRITE "^",$PIECE(DGMMS0,"^",2)
+19 SET DGMTED=$$NOW^XLFDT
SET DGMTED=$ORDER(^DGMMS(11.99,DGMMSI,"TERMSTATUS","B",DGMTED),-1)
+20 IF $GET(DGMTED)
Begin DoDot:2
+21 SET DGMTEDI=""
SET DGMTEDI=$ORDER(^DGMMS(11.99,DGMMSI,"TERMSTATUS","B",DGMTED,DGMTEDI))
+22 SET DGMTST=$PIECE(^DGMMS(11.99,DGMMSI,"TERMSTATUS",DGMTEDI,0),"^",2)
+23 WRITE "^",$SELECT(DGMTST:"ACTIVE",1:"INACTIVE")
End DoDot:2
+24 SET DGMV0=$GET(^DGMMS(11.99,DGMMSI,"VUID"))
+25 WRITE "^",$PIECE(DGMV0,"^")
End DoDot:1
+26 QUIT
+27 ;
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(DGSMS)!$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 DGSMS=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="Marital Status to Master Marital Status Mapping Report"
SET ZTRTN="DQ^DGMFR11"
+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(DGSMS)
QUIT -1
+33 QUIT 0
+34 ;
+1 NEW DGHDR,DGTAB,DGSPACE
+2 SET DGSMS=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 DGSMS=1
QUIT
End DoDot:1
if DGSMS
QUIT
+9 SET DGPGCNT=DGPGCNT+1
+10 WRITE @IOF,!
+11 SET $PIECE(DGSPACE," ",132)=""
+12 SET DGHDR=" Marital Status to Master Marital Status Report "
+13 SET DGHDR=DGHDR_"Page: "_DGPGCNT
SET DGTAB=132-$LENGTH(DGHDR)-1
+14 WRITE ?DGTAB,DGHDR
+15 QUIT
+16 ;
PRINMS(DGMSI) ; Print Marital Status file (#11) entry
+1 WRITE !!,"Marital Status: ",$PIECE(DGMS0,"^")
+2 NEW DGCT2
+3 IF $GET(DGSUM)=2
Begin DoDot:1
+4 WRITE !,"Abbreviation: ",$PIECE(DGMS0,"^",2)
+5 WRITE ?30,"Status: ",DGMSST
+6 SET DGCT=$PIECE(DGMS0,"^",3)
IF $LENGTH(DGCT)
WRITE !?3,"Code: ",DGCT
End DoDot:1
+7 SET DGMMS0=$GET(^TMP($JOB,"DGMFR11",DGMS0,DGMSI,"MMSE"))
+8 SET DGMMSI=+$PIECE(DGMMS0,"^",4)
+9 WRITE !,"Mapped to Master Marital Status : ",$SELECT(DGMMSI:"YES",1:"NO")
+10 if 'DGMMSI
QUIT
+11 WRITE !?3,"Master MS Name: ",$PIECE(^TMP($JOB,"DGMFR11",DGMS0,DGMSI,"MMSE"),"^")
+12 IF $GET(DGSUM)=2
WRITE !?3,"Master Code: ",$PIECE(^TMP($JOB,"DGMFR11",DGMS0,DGMSI,"MMSE"),"^",2)
+13 QUIT
+14 ;
INFO ; Display message, clear screen
+1 NEW MSG
+2 SET MSG(1)=" This report prints Marital Statuses from the MARITAL"
+3 SET MSG(2)=" STATUS file (#11), and each Marital Status' relationship"
+4 SET MSG(3)=" to the Master Marital Status (#11.99) file."
+5 SET MSG(4)=""
+6 DO CLEAR^VALM1
+7 DO BMES^XPDUTL(.MSG)
+8 QUIT
