source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGMSTR2.m@ 1270

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