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

DGMSTR2.m

Go to the documentation of this file. 
  1. DGMSTR2 ;ALB/SCK - MST DETAILED DEMOGRAPHIC REPORT ; 11/19/03 10:56am
  1.  ;;5.3;Registration;**195,555,1015**;Aug 13, 1993;Build 21
  1.  ;
  1. EN ; Main entry point for report
  1.  ; Variable List
  1.  ;     DGBEG   - Beginning of date range (FM date)
  1.  ;     DGEND   - End of date range (FM Date)
  1.  ;     DGMST   - array of MST status codes
  1.  ;     DGSEX   - Patient gender to filter on
  1.  ;     DGPOS   - array of period of service values to filter on
  1.  ;     DGDISP  - Sort report on
  1.  ;     DGSDAT  - start date selection
  1.  ;     DGEDAT  - end date selection
  1.  ;     RPTREF  - location of report data array
  1.  ;     RPTARRY - temporary location of report array
  1.  ;     DGX     - temporary variable
  1.  ;     MSTST   - temporary variable holding MST status
  1.  ;     MSTPOS  - temporary array of selected POS's
  1.  ;     MSTNAME - temporary variable, patient name
  1.  ;     MSTIEN  - temporary variable, IEN in MST HISTORY File (#29.11)
  1.  ;     MSTACT  - temporary array, service in country indicated
  1.  ;     MSTDT   - temporary variable, MST status change date
  1.  ;
  1.  N DGBEG,DGEND,DGMST,DGSEX,DGPOS,DGDISP,DGSDAT,DGEDAT,DIC,Y,X,ZTSAVE
  1.  ;
  1.  ;; Get beginning date for report
  1.  K DIRUT
  1.  S DIR(0)="DAO^:"_$$DT^XLFDT_":EX",DIR("A")="Start Date: "
  1.  S DIR("?")="Enter beginning date of the reports date range."
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S DGSDAT=+Y
  1.  ;
  1.  ;; Get ending date for report
  1.  K DIRUT
  1.  S DIR(0)="DAO^"_DGSDAT_":"_DT_":EX",DIR("A")="End Date: "
  1.  S DIR("?")="Enter the ending date of the reports date range."
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S DGEDAT=+Y_.9999
  1.  ;
  1.  ; Call procedure to select MST status codes to include
  1.  D GETMST(.DGMST)
  1.  Q:($O(DGMST(""))="")
  1.  ;
  1.  ;; Select gender for report
  1.  K DIRUT
  1.  S DIR(0)="SAO^M:Male;F:Female;B:Both"
  1.  S DIR("A")="Gender to display MST status for: ",DIR("B")="Both"
  1.  S DIR("?",1)="Select the gender to include on the report, either male,"
  1.  S DIR("?")="female or both."
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S DGSEX=Y
  1.  ;
  1.  ;; Select period of service to include
  1.  N VAUTNI,VAUTSTR,VAUTVB
  1.  S VAUTNI=0,VAUTSTR="Period of Service to include"
  1.  S VAUTVB="DGPOS",DIC=21
  1.  D FIRST^VAUTOMA
  1.  ;
  1.  ;; Select sort criteria
  1.  K DIRUT
  1.  S DIR(0)="SAO^P:Patient Name;S:Period of Service/Patient Name"
  1.  S DIR("A")="Sort report by ",DIR("B")="Patient Name"
  1.  S DIR("?",1)="Sort the report by either patient name, or by Period of"
  1.  S DIR("?")="Service and within POS, by patient name."
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S DGDISP=Y
  1.  ;
  1.  ;; Set up print device using KERNEL utility
  1.  N ZTSAVE
  1.  F X="DGPOS","DGPOS(","DGDISP","DGSEX","DGSDAT","DGEDAT","DGMST(" D
  1.  . S ZTSAVE(X)=""
  1.  W !!,"This report is formatted for 132 characters, and will not format"
  1.  W !,"correctly on either an 80 column terminal or printer."
  1.  W !!,"This report may take a while to build and print.  In order to"
  1.  W !,"free up your workstation, please queue this report to print device."
  1.  D EN^XUTMDEVQ("RPT^DGMSTR2","MST Detailed Report",.ZTSAVE)
  1.  D HOME^%ZIS
  1.  Q
  1.  ;
  1. RPT ; Main entry point for printing report form KERNEL device utility
  1.  N FRSTPAS
  1.  S RPTREF="^TMP(""DGMST DEM"","_$J_")"
  1.  K @RPTREF
  1.  D BUILD(DGSDAT,DGEDAT,.DGMST,DGSEX,.DGPOS,DGDISP,RPTREF)
  1.  I DGDISP["P" D PRNNAME(DGSDAT,DGEDAT,DGDISP,RPTREF,.DGMST)
  1.  I DGDISP["S" D PRNPOS(DGSDAT,DGEDAT,DGDISP,RPTREF,.DGMST)
  1.  K @RPTREF,RPTREF
  1.  Q
  1.  ;
  1. BUILD(DGBEG,DGEND,DGMST,DGSEX,DGPOS,DGDISP,RPTARRY) ;
  1.  ;; Build the report array using the parameters entered by the user
  1.  ;
  1.  N MSTDT,DFN,LINE,MSTIEN,DGX,MSTDAT,VADM,VAEL,VAPA,VA
  1.  S MSTDT=DGBEG
  1.  F  S MSTDT=$O(^DGMS(29.11,"B",MSTDT)) Q:'MSTDT!(MSTDT>DGEND)  D
  1.  . S MSTIEN=0
  1.  . F  S MSTIEN=$O(^DGMS(29.11,"B",MSTDT,MSTIEN)) Q:'MSTIEN  D
  1.  .. S MSTDAT=$G(^DGMS(29.11,MSTIEN,0))
  1.  .. S DGX=$P(MSTDAT,U,3)
  1.  .. Q:'($D(DGMST(DGX)))
  1.  .. S DFN=$P(MSTDAT,U,2)
  1.  .. S DGX=$$GETSTAT^DGMSTAPI(DFN)
  1.  .. Q:MSTIEN'=+DGX
  1.  .. D DEM^VADPT
  1.  .. I '(DGSEX["B") Q:'(DGSEX[$P(VADM(5),U))
  1.  .. D ELIG^VADPT
  1.  .. I 'DGPOS S DGX=$P(VAEL(2),U) Q:'($D(DGPOS(+DGX)))
  1.  .. S LINE=$G(LINE)+1
  1.  .. I DGDISP["P" D
  1.  ... S @RPTARRY@($P(MSTDAT,U,3),VADM(1),LINE)=DFN_U_MSTIEN
  1.  .. E  D
  1.  ... S @RPTARRY@($P(MSTDAT,U,3),$S(VAEL(2)]"":VAEL(2),1:"UNKNOWN"),VADM(1),LINE)=DFN_U_MSTIEN
  1.  .. D KVAR^VADPT
  1.  Q
  1.  ;
  1. PRNNAME(DGBEG,DGEND,DGDSP,RPTARRY,DGMST) ;
  1.  ; Print out report on patient name sort.  One level of sort in the ^TMP global
  1.  N MSTST,DFN,MSTPOS,MSTNAME,MSTIEN,DGQUIT,DGNDX,MSTDAT
  1.  ;
  1.  S MSTST=""
  1.  F  S MSTST=$O(DGMST(MSTST)) Q:'(MSTST]"")  D  Q:$G(DGQUIT)
  1.  . I $O(@RPTARRY@(MSTST,""))="" D  Q
  1.  .. S X=$$HEADER(MSTST,DGDSP,DGBEG,DGEND)  ;DG*5.3*264
  1.  .. W !!?5,"No data for MST status "_MSTST_" found."
  1.  . S DGQUIT=$$HEADER(MSTST,DGDSP,DGBEG,DGEND) Q:$G(DGQUIT)
  1.  . S (DGNDX,MSTNAME)=""
  1.  . F  S MSTNAME=$O(@RPTARRY@(MSTST,MSTNAME)) Q:'(MSTNAME]"")  D  Q:$G(DGQUIT)
  1.  .. F  S DGNDX=$O(@RPTARRY@(MSTST,MSTNAME,DGNDX)) Q:'(DGNDX]"")  D  Q:$G(DGQUIT)
  1.  ... S MSTDAT=$G(^(DGNDX))
  1.  ... S DFN=$P(MSTDAT,U),MSTIEN=$P(MSTDAT,U,2)
  1.  ... D PRNTLN1(DFN,MSTIEN)
  1.  ... I $Y+5>$G(IOSL) S DGQUIT=$$HEADER(MSTST,DGDSP,DGBEG,DGEND) Q:$G(DGQUIT)
  1.  Q
  1.  ;
  1. PRNPOS(DGBEG,DGEND,DGDSP,RPTARRY,DGMST) ;
  1.  ;  Print out report on period of service sort, Two levels of sort.
  1.  N MSTST,DFN,MSTPOS,MSTNAME,MSTIEN,DGQUIT,DGX,DGNDX
  1.  ;
  1.  I '$O(@RPTARRY@(""))="" D  Q
  1.  . S X=$$HEADER(MSTST,DGDSP,DGBEG,DGEND)
  1.  . W !!?5,"No data for these parameters found."
  1.  ;
  1.  S MSTST=""
  1.  F  S MSTST=$O(DGMST(MSTST)) Q:'(MSTST]"")  D  Q:$G(DGQUIT)
  1.  . I $O(@RPTARRY@(MSTST,""))="" D  Q
  1.  .. S X=$$HEADER(MSTST,DGDSP,DGBEG,DGEND)
  1.  .. W !!?5,"No data for MST status "_MSTST_" found."
  1.  . S DGQUIT=$$HEADER(MSTST,DGDSP,DGBEG,DGEND) Q:$G(DGQUIT)
  1.  . S MSTPOS=""
  1.  . F  S MSTPOS=$O(@RPTARRY@(MSTST,MSTPOS)) Q:'(MSTPOS]"")  D  Q:$G(DGQUIT)
  1.  .. S (MSTNAME,DGNDX)=""
  1.  .. F  S MSTNAME=$O(@RPTARRY@(MSTST,MSTPOS,MSTNAME)) Q:'(MSTNAME]"")  D  Q:$G(DGQUIT)
  1.  ... F  S DGNDX=$O(@RPTARRY@(MSTST,MSTPOS,MSTNAME,DGNDX)) Q:'(DGNDX]"")  D  Q:$G(DGQUIT)
  1.  .... S MSTDAT=$G(^(DGNDX))
  1.  .... S DFN=$P(MSTDAT,U),MSTIEN=$P(MSTDAT,U,2)
  1.  .... D PRNTLN1(DFN,MSTIEN)
  1.  .... I $Y+5>$G(IOSL) S DGQUIT=$$HEADER(MSTST,DGDSP,DGBEG,DGEND) Q:$G(DGQUIT)
  1.  Q
  1.  ;
  1. PRNTLN1(DFN,MSTIEN) ;  Format and print data for patient passed in
  1.  N MSTACT,DGX,VADM,VAEL,VAPA,VA
  1.  D DEM^VADPT,ELIG^VADPT,ADD^VADPT,ACTION(DFN,.MSTACT)
  1.  ;
  1.  W !,VA("BID")
  1.  W ?6,$E(VADM(1),1,25)
  1.  W ?32,$E(VAPA(1),1,25)
  1.  W ?58,$P(VADM(5),U)
  1.  W ?61,$E($P(VAEL(1),U,2),1,15)
  1.  W ?80,$E($P(VAEL(2),U,2),1,15)
  1.  W ?100,$G(MSTACT(1))
  1.  W !
  1.  S DGX=$E(VAPA(4),1,$L(VAPA(4)))_$S(VAPA(6)]"":", ",1:"  ")_$P(VAPA(5),U,2)_" "_VAPA(6)
  1.  W ?32,$S($G(VAPA(2))]"":$E(VAPA(2),1,25),1:DGX)
  1.  W ?100,$G(MSTACT(2))
  1.  W !
  1.  W ?32,$S($G(VAPA(2))]"":DGX,1:VAPA(8))
  1.  W ?100,$G(MSTACT(3))
  1.  W !
  1.  W ?32,$S($G(VAPA(2))]"":VAPA(8),1:"")
  1.  W ?100,$G(MSTACT(4))
  1.  ;
  1.  I $G(MSTACT(5))]"" D
  1.  . W !?100,$G(MSTACT(5))
  1.  . I $G(MSTACT(6))]"" D
  1.  .. W !?100,$G(MSTACT(6))
  1.  E  W !
  1.  ;
  1.  D KVAR^VADPT
  1.  Q
  1.  ;
  1.  N LINE,STR,SDASH
  1.  I $G(FRSTPAS),$E(IOST,1,2)="C-" D PAUSE^VALM1 Q:'Y 1
  1.  I '$G(FRSTPAS) D
  1.  . S FRSTPAS=1
  1.  . W @IOF
  1.  E  D
  1.  . W @IOF
  1.  ;
  1.  S STR="MST Detailed Demographic Report"
  1.  S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
  1.  W !,LINE_STR
  1.  S STR="MST Status: "_$S(MSTST["Y":"Yes",MSTST["N":"No",MSTST["D":"Declined",1:"Unknown")
  1.  K LINE S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
  1.  W !,LINE_STR
  1.  S STR="Sorted by: "_$S(DGDISP["P":"Patient",1:"Period of Service\Patient")
  1.  K LINE S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
  1.  W !,LINE_STR
  1.  S STR="Date Range: "_$$FMTE^XLFDT(DGBEG,"D")_" - "_$$FMTE^XLFDT(DGEND,"D")
  1.  K LINE S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
  1.  W !,LINE_STR
  1.  S STR="Date printed: "_$$FMTE^XLFDT($$NOW^XLFDT,"D")
  1.  K LINE S $P(LINE," ",(IOM/2)-($L(STR)/2))=""
  1.  W !,LINE_STR
  1.  W !!
  1.  W !?32,"ADDRESS",?82,"PERIOD"
  1.  W !?6,"PATIENT",?32,"AND",?63,"ELIGIBILITY",?82,"OF"
  1.  W !,"SSN",?6,"NAME",?32,"PHONE",?57,"SEX",?63,"CODE",?82,"SERVICE",?100,"SERVICE IND."
  1.  W !
  1.  S $P(SDASH,"-",IOM+1)=""
  1.  W SDASH,!
  1.  Q 0
  1.  ;
  1. ACTION(DFN,MSTRSLT) ;  Check for service indicated fields in PATIENT File (#2) for
  1.  ; patient passed in.  Return local array with all entries flaged as yes in the 
  1.  ; respective fields
  1.  ;   .32101  - Vietnam
  1.  ;   .3221   - Lebanon
  1.  ;   .3224   - Grenada
  1.  ;   .3227   - Panama
  1.  ;   .32201  - Persian Gulf
  1.  ;   .322016 - Somalia
  1.  ; Output
  1.  ;    MSTRSLT(n)="VIETNAM"
  1.  ;
  1.  N MSTACTN,NDX,LINE
  1.  S DFN=DFN_","
  1.  D GETS^DIQ(2,DFN,".32101;.3221;.3224;.3227;.32201;.322016","E","MSTACTN")
  1.  S NDX=""
  1.  F  S NDX=$O(MSTACTN(2,DFN,NDX)) Q:'NDX  D
  1.  . S:MSTACTN(2,DFN,NDX,"E")["YES" LINE=$G(LINE)+1,MSTRSLT(LINE)=$$SERVICE(NDX)
  1.  ;
  1.  Q
  1.  ;
  1. SERVICE(NDX) ; Convert field number to text value
  1.  Q $S(NDX=.32101:"VIETNAM",NDX=.3221:"LEBANON",NDX=.3224:"GRENADA",NDX=.3227:"PANAMA",NDX=.32201:"PERSIAN GULF",NDX=.322016:"SOMALIA",1:"UNKNOWN")
  1.  ;
  1.  ;
  1. GETMST(MST) ; Multiple MST status code seletion, loops until user quites
  1. NEXT S DIR(0)="29.11,3AO"
  1.  S DIR("A")="Select MST status code: "
  1.  S DIR("?")="Select one of the current MST status codes: Y/N/D/U."
  1.  D ^DIR K DIR
  1.  Q:$D(DIRUT)
  1.  S:'$D(MST(Y)) MST(Y)=""
  1.  G NEXT
  1.  Q