Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGMFR11

DGMFR11.m

Go to the documentation of this file. 
  1. DGMFR11 ;DAL/JCH - NDS DEMOGRAPHICS MASTER MARITAL STATUS ASSOCIATIONS REPORT ;15-AUG-2017
  1.  ;;5.3;Registration;**933**;Aug 13, 1993;Build 44
  1.  ;
  1.  ; Available at Master File Reports [DGMF RMAIN] option, at the following menu path:
  1.  ;    Supervisor ADT Menu [DG SUPERVISOR MENU]
  1.  ;      ADT System Definition Menu [DG SYSTEM DEFINITION MENU]
  1.  ;        Master File Menu [DGMF MNU]
  1.  ;          Master File Reports [DGMF RMAIN]
  1.  Q
  1.  ;
  1. EN ; MMS Report Entry point
  1.  N DGOUT
  1.  S DGOUT=0
  1.  F  Q:$G(DGOUT)  D
  1.  .D MAIN Q:DGOUT
  1.  .N DIR W !!
  1.  .S DIR(0)="Y",DIR("B")="Y",DIR("A")="Run report again" D ^DIR
  1.  .S:X'="Y" DGOUT=1
  1.  Q
  1.  ;
  1. MAIN ; Driver loop
  1.  N DGSUM,DGMUA,DGSMS,DGOUTP
  1.  S DGSMS=0
  1.  ;
  1.  D INFO
  1.  ; Select (M)apped, (U)nmapped, or (A)ll entries from Marital Status (#11) file.
  1.  D MUA(.DGMUA) I '$D(DGMUA)!$G(DGOUT) S DGOUT=1 Q
  1.  S DGSUM=$$SUMMARY I 'DGSUM Q
  1.  ;
  1.  ; Select output format
  1.  S DGOUTP=$$OUT I DGSMS Q
  1.  ;
  1.  ; Select device
  1.  I $$SELDEV()!DGSMS Q
  1.  ;
  1.  I DGOUTP="R" W !!,"<*> please wait <*>"
  1.  U IO D DQ
  1.  Q
  1.  ;
  1. DQ ;  report (queue) starts here
  1.  N DGMSI,DGMMSI,DGMS0,DGMMS0
  1.  ;
  1.  K ^TMP($J,"DGMFR11")
  1.  ;  build list of Marital Statuses
  1.  S DGMSI=0 F  S DGMSI=$O(^DIC(11,DGMSI)) Q:'DGMSI  D
  1.  .S DGMS0=$G(^DIC(11,DGMSI,0))
  1.  .S DGMSP02=+$G(^DIC(11,DGMSI,.02))
  1.  .S DGMMSI=+$G(^DIC(11,DGMSI,"MASTER"))
  1.  .I $G(DGMUA)="U",$G(DGMMSI) Q
  1.  .I $G(DGMUA)="M",'$G(DGMMSI) Q
  1.  .S DGMMS0=$S($G(DGMMSI):$G(^DGMMS(11.99,+DGMMSI,0)),1:"Not Mapped")
  1.  .I DGMMSI S $P(DGMMS0,"^",4)=DGMMSI
  1.  .S ^TMP($J,"DGMFR11",DGMS0,DGMSI,"MS")=$G(DGMS0)
  1.  .S ^TMP($J,"DGMFR11",DGMS0,DGMSI,"STATUS")=DGMSP02
  1.  .S ^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE")=$G(DGMMS0)
  1.  ;
  1.  D PRINT
  1.  ;
  1.  D ^%ZISC
  1.  K ^TMP($J,"DGMFR11")
  1.  Q
  1.  ;
  1. PRINT ; Print output
  1.  N MAXCNT,DGSMS,DGPGCNT,DGHDR,CRT,DGMS0,DGDELHD
  1.  I IOST["C-" S MAXCNT=IOSL-10,CRT=1
  1.  E  S MAXCNT=IOSL-6,CRT=0
  1.  I DGSUM=1 S MAXCNT=MAXCNT+5
  1.  S DGPGCNT=0,DGSMS=0
  1.  ;
  1.  I '$D(^TMP($J,"DGMFR11")) D HEADER W !!!?5,"No Data Found" Q
  1.  ;
  1.  S DGMS0="" F  S DGMS0=$O(^TMP($J,"DGMFR11",DGMS0)) Q:DGMS0=""  D PRINT2(DGMS0)
  1.  Q
  1. PRINT2(DGMS0) ; Get details
  1.  N DGMSI
  1.  S DGMSI=0 F  S DGMSI=$O(^TMP($J,"DGMFR11",DGMS0,DGMSI)) Q:'DGMSI!DGSMS  D
  1.  .N DGMMS0,DGCT,DGCTS,DGCTX,DGMSST
  1.  .N DGMTST,DGMTED,DGMMSI,DGMTEDI,DGMPAR,DGMPARX
  1.  .N DGMREPL,DGMREPX,DGMV0
  1.  .;
  1.  .I $G(DGOUTP)="E" D DELIM(DGMS0,DGMSI) Q
  1.  .;
  1.  .I ($Y+1>MAXCNT)!'DGPGCNT D HEADER Q:DGSMS
  1.  .S DGMS0=$G(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MS"))
  1.  .S DGMSST=+$G(^TMP($J,"DGMFR11",DGMS0,DGMSI,"STATUS")),DGMSST=$S(DGMSST:"INACTIVE",1:"ACTIVE")
  1.  .D PRINMS(DGMSI)
  1.  .;
  1.  .Q:'DGMMSI
  1.  .I $G(DGSUM)=2 D
  1.  ..S DGMTED=$$NOW^XLFDT,DGMTED=$O(^DGMMS(11.99,DGMMSI,"TERMSTATUS","B",DGMTED),-1)
  1.  ..I DGMTED D  ; This should always be true, if data came from STS MFS process
  1.  ...S DGMTEDI="",DGMTEDI=$O(^DGMMS(11.99,DGMMSI,"TERMSTATUS","B",DGMTED,DGMTEDI))
  1.  ...S DGMTST=$P(^DGMMS(11.99,DGMMSI,"TERMSTATUS",DGMTEDI,0),"^",2)
  1.  ...W ?25,"Master Status: ",$S(DGMTST:"ACTIVE",1:"INACTIVE")
  1.  ..S DGMV0=$G(^DGMMS(11.99,DGMMSI,"VUID"))
  1.  ..W !?3,"VUID: ",$P(DGMV0,"^")
  1.  Q
  1.  ;
  1. MUA(DGMUA) ; Select (M)apped, (U)nmapped, or(A)ll - entries from 11 mapped to 11.99
  1.  N DIR,DIRUT,Y
  1.  W ! S DIR(0)="SAO^M:(M)apped;U:(U)nmapped;A:(A)ll"
  1.  S DIR("?")="Enter ^ to exit"
  1.  S DIR("A",1)="Run the report for"
  1.  S DIR("A")="(M)apped, (U)nmapped, or (A)ll Marital Status entries: ",DIR("B")="A" D ^DIR
  1.  I $D(DIRUT) S DGOUT=1 Q
  1.  S DGMUA=Y
  1.  Q
  1.  ;
  1. SUMMARY() ;  ask to print detailed or summary report
  1.  N DIR,DIRUT,X,Y
  1.  S DIR(0)="SOA^D:Detailed;S:Summary;",DIR("B")="Summary"
  1.  S DIR("A")="Type of report to print: "
  1.  W ! D ^DIR
  1.  I $D(DIRUT) S DGSMS=1 Q 0
  1.  Q $S(Y="S":1,Y="D":2,1:0)
  1.  ;
  1. OUT() ; select Excel or Report format
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  W !
  1.  S DIR(0)="SA^E:Excel;R:Report"
  1.  S DIR("A")="(E)xcel Format or (R)eport Format: "
  1.  S DIR("B")="Report"
  1.  D ^DIR I $D(DIRUT) S DGSMS=1 Q ""
  1.  Q Y
  1.  ;
  1. DELIM(DGMS0,DGMSI)  ; Print output in "^" delimited format
  1.  ; Print data in (E)xcel format, e.g., "data^data^data"
  1.  I '$G(DGDELHD) S DGDELHD=1 D
  1.  .I $G(DGSUM)=1 W !,"VA Marital Status^Mapped/Not Mapped^Master Marital Status"
  1.  .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"
  1.  S DGMSST=$P(DGMS0,"^",4)
  1.  S DGMSST=$S(DGMSST:"INACTIVE",1:"ACTIVE")
  1.  W !,$P(DGMS0,"^")
  1.  I $G(DGSUM)=2 D
  1.  .W "^",$P(DGMS0,"^",2)
  1.  .W "^",DGMSST
  1.  .S DGCT=$P(DGMS0,"^",3) W "^",DGCT
  1.  S DGMMS0=$G(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE"))
  1.  S DGMMSI=+$P(DGMMS0,"^",4)
  1.  W "^",$S(DGMMSI:"MAPPED",1:"NOT MAPPED")
  1.  Q:'DGMMSI
  1.  W "^",$P(DGMMS0,"^")  ; $P(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE"),"^")
  1.  I $G(DGSUM)=2 D
  1.  .W "^",$P(DGMMS0,"^",2)
  1.  .S DGMTED=$$NOW^XLFDT,DGMTED=$O(^DGMMS(11.99,DGMMSI,"TERMSTATUS","B",DGMTED),-1)
  1.  .I $G(DGMTED) D
  1.  ..S DGMTEDI="",DGMTEDI=$O(^DGMMS(11.99,DGMMSI,"TERMSTATUS","B",DGMTED,DGMTEDI))
  1.  ..S DGMTST=$P(^DGMMS(11.99,DGMMSI,"TERMSTATUS",DGMTEDI,0),"^",2)
  1.  ..W "^",$S(DGMTST:"ACTIVE",1:"INACTIVE")
  1.  .S DGMV0=$G(^DGMMS(11.99,DGMMSI,"VUID"))
  1.  .W "^",$P(DGMV0,"^")
  1.  Q
  1.  ;
  1. SELDEV()  ; Propmt for output device, return 1 if queued
  1.  I DGOUTP="E" D
  1.  .N DIR,X,Y
  1.  .S DIR("A",1)=""
  1.  .S DIR("A",2)="     ************************************************************"
  1.  .S DIR("A",3)="     **  You selected a Delimited report. Please verify you    **"
  1.  .S DIR("A",4)="     **  you have turned logging on to capture the output.     **"
  1.  .S DIR("A",5)="     **                                                        **"
  1.  .S DIR("A",6)="     **  To avoid undesired wrapping, enter '0;199;999' at     **"
  1.  .S DIR("A",7)="     **  the 'DEVICE:' prompt. The Terminal Session display    **"
  1.  .S DIR("A",8)="     **  may need to be set to 199 columns.                    **"
  1.  .S DIR("A",9)="     ************************************************************"
  1.  .S DIR("A",10)=""
  1.  .S DIR("A",11)="",DIR("A",12)=""
  1.  .S DIR("A")=" Press return to continue"
  1.  .S DIR(0)="EA" D ^DIR W !
  1.  ;
  1.  N DGDONE
  1.  W !,"You may queue this report to print at a later time.",!
  1.  F  Q:$G(DGSMS)!$G(DGDONE)  D
  1.  .K %ZIS,IOP,POP,ZTSK N I S DGION=$I,%ZIS="QM"
  1.  .D ^%ZIS K %ZIS
  1.  .I POP S IOP=DGION D ^%ZIS K IOP,DGION D  Q
  1.  ..N DIR,X,Y
  1.  ..S DIR(0)="YA",DIR("A",1)="  ** No Device Selected **",DIR("A")="Select a different device? (Y/N) " D ^DIR
  1.  ..S:'Y DGSMS=1
  1.  .S DGDONE=1
  1.  I $D(IO("Q")) D  Q 1
  1.  .N ZTDESC,ZTSAVE,ZTRTN
  1.  .S ZTDESC="Marital Status to Master Marital Status Mapping Report",ZTRTN="DQ^DGMFR11"
  1.  .S ZTSAVE("DATE*")="",ZTSAVE("DG*")="",ZTSAVE("ZTREQ")="@"
  1.  .K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"Report is Queued to print!" K ZTSK
  1.  Q:$G(DGSMS) -1
  1.  Q 0
  1.  ;
  1.  N DGHDR,DGTAB,DGSPACE
  1.  S DGSMS=0
  1.  I CRT,DGPGCNT>0,'$D(ZTQUEUED) D  Q:DGSMS
  1.  .N DIR,LIN
  1.  .I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
  1.  .W !
  1.  .S DIR(0)="E" D ^DIR K DIR
  1.  .I 'Y S DGSMS=1 Q
  1.  S DGPGCNT=DGPGCNT+1
  1.  W @IOF,!
  1.  S $P(DGSPACE," ",132)=""
  1.  S DGHDR=" Marital Status to Master Marital Status Report     "
  1.  S DGHDR=DGHDR_"Page: "_DGPGCNT,DGTAB=132-$L(DGHDR)-1
  1.  W ?DGTAB,DGHDR
  1.  Q
  1.  ;
  1. PRINMS(DGMSI)  ; Print Marital Status file (#11) entry
  1.  W !!,"Marital Status: ",$P(DGMS0,"^")
  1.  N DGCT2
  1.  I $G(DGSUM)=2 D
  1.  .W !,"Abbreviation: ",$P(DGMS0,"^",2)
  1.  .W ?30,"Status: ",DGMSST
  1.  .S DGCT=$P(DGMS0,"^",3) I $L(DGCT) W !?3,"Code: ",DGCT
  1.  S DGMMS0=$G(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE"))
  1.  S DGMMSI=+$P(DGMMS0,"^",4)
  1.  W !,"Mapped to Master Marital Status : ",$S(DGMMSI:"YES",1:"NO")
  1.  Q:'DGMMSI
  1.  W !?3,"Master MS Name: ",$P(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE"),"^")
  1.  I $G(DGSUM)=2 W !?3,"Master Code: ",$P(^TMP($J,"DGMFR11",DGMS0,DGMSI,"MMSE"),"^",2)
  1.  Q
  1.  ;
  1. INFO ; Display message, clear screen
  1.  N MSG
  1.  S MSG(1)="  This report prints Marital Statuses from the MARITAL"
  1.  S MSG(2)="  STATUS file (#11), and each Marital Status' relationship"
  1.  S MSG(3)="  to the Master Marital Status (#11.99) file."
  1.  S MSG(4)=""
  1.  D CLEAR^VALM1
  1.  D BMES^XPDUTL(.MSG)
  1.  Q