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
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMSTR2 9057 printed Dec 13, 2024@02:44:30 Page 2
DGMSTR2 ;ALB/SCK - MST DETAILED DEMOGRAPHIC REPORT ; 11/19/03 10:56am
+1 ;;5.3;Registration;**195,555**;Aug 13, 1993
+2 ;
EN ; Main entry point for report
+1 ; Variable List
+2 ; DGBEG - Beginning of date range (FM date)
+3 ; DGEND - End of date range (FM Date)
+4 ; DGMST - array of MST status codes
+5 ; DGSEX - Patient gender to filter on
+6 ; DGPOS - array of period of service values to filter on
+7 ; DGDISP - Sort report on
+8 ; DGSDAT - start date selection
+9 ; DGEDAT - end date selection
+10 ; RPTREF - location of report data array
+11 ; RPTARRY - temporary location of report array
+12 ; DGX - temporary variable
+13 ; MSTST - temporary variable holding MST status
+14 ; MSTPOS - temporary array of selected POS's
+15 ; MSTNAME - temporary variable, patient name
+16 ; MSTIEN - temporary variable, IEN in MST HISTORY File (#29.11)
+17 ; MSTACT - temporary array, service in country indicated
+18 ; MSTDT - temporary variable, MST status change date
+19 ;
+20 NEW DGBEG,DGEND,DGMST,DGSEX,DGPOS,DGDISP,DGSDAT,DGEDAT,DIC,Y,X,ZTSAVE
+21 ;
+22 ;; Get beginning date for report
+23 KILL DIRUT
+24 SET DIR(0)="DAO^:"_$$DT^XLFDT_":EX"
SET DIR("A")="Start Date: "
+25 SET DIR("?")="Enter beginning date of the reports date range."
+26 DO ^DIR
KILL DIR
+27 if $DATA(DIRUT)
QUIT
+28 SET DGSDAT=+Y
+29 ;
+30 ;; Get ending date for report
+31 KILL DIRUT
+32 SET DIR(0)="DAO^"_DGSDAT_":"_DT_":EX"
SET DIR("A")="End Date: "
+33 SET DIR("?")="Enter the ending date of the reports date range."
+34 DO ^DIR
KILL DIR
+35 if $DATA(DIRUT)
QUIT
+36 SET DGEDAT=+Y_.9999
+37 ;
+38 ; Call procedure to select MST status codes to include
+39 DO GETMST(.DGMST)
+40 if ($ORDER(DGMST(""))="")
QUIT
+41 ;
+42 ;; Select gender for report
+43 KILL DIRUT
+44 SET DIR(0)="SAO^M:Male;F:Female;B:Both"
+45 SET DIR("A")="Gender to display MST status for: "
SET DIR("B")="Both"
+46 SET DIR("?",1)="Select the gender to include on the report, either male,"
+47 SET DIR("?")="female or both."
+48 DO ^DIR
KILL DIR
+49 if $DATA(DIRUT)
QUIT
+50 SET DGSEX=Y
+51 ;
+52 ;; Select period of service to include
+53 NEW VAUTNI,VAUTSTR,VAUTVB
+54 SET VAUTNI=0
SET VAUTSTR="Period of Service to include"
+55 SET VAUTVB="DGPOS"
SET DIC=21
+56 DO FIRST^VAUTOMA
+57 ;
+58 ;; Select sort criteria
+59 KILL DIRUT
+60 SET DIR(0)="SAO^P:Patient Name;S:Period of Service/Patient Name"
+61 SET DIR("A")="Sort report by "
SET DIR("B")="Patient Name"
+62 SET DIR("?",1)="Sort the report by either patient name, or by Period of"
+63 SET DIR("?")="Service and within POS, by patient name."
+64 DO ^DIR
KILL DIR
+65 if $DATA(DIRUT)
QUIT
+66 SET DGDISP=Y
+67 ;
+68 ;; Set up print device using KERNEL utility
+69 NEW ZTSAVE
+70 FOR X="DGPOS","DGPOS(","DGDISP","DGSEX","DGSDAT","DGEDAT","DGMST("
Begin DoDot:1
+71 SET ZTSAVE(X)=""
End DoDot:1
+72 WRITE !!,"This report is formatted for 132 characters, and will not format"
+73 WRITE !,"correctly on either an 80 column terminal or printer."
+74 WRITE !!,"This report may take a while to build and print. In order to"
+75 WRITE !,"free up your workstation, please queue this report to print device."
+76 DO EN^XUTMDEVQ("RPT^DGMSTR2","MST Detailed Report",.ZTSAVE)
+77 DO HOME^%ZIS
+78 QUIT
+79 ;
RPT ; Main entry point for printing report form KERNEL device utility
+1 NEW FRSTPAS
+2 SET RPTREF="^TMP(""DGMST DEM"","_$JOB_")"
+3 KILL @RPTREF
+4 DO BUILD(DGSDAT,DGEDAT,.DGMST,DGSEX,.DGPOS,DGDISP,RPTREF)
+5 IF DGDISP["P"
DO PRNNAME(DGSDAT,DGEDAT,DGDISP,RPTREF,.DGMST)
+6 IF DGDISP["S"
DO PRNPOS(DGSDAT,DGEDAT,DGDISP,RPTREF,.DGMST)
+7 KILL @RPTREF,RPTREF
+8 QUIT
+9 ;
BUILD(DGBEG,DGEND,DGMST,DGSEX,DGPOS,DGDISP,RPTARRY) ;
+1 ;; Build the report array using the parameters entered by the user
+2 ;
+3 NEW MSTDT,DFN,LINE,MSTIEN,DGX,MSTDAT,VADM,VAEL,VAPA,VA
+4 SET MSTDT=DGBEG
+5 FOR
SET MSTDT=$ORDER(^DGMS(29.11,"B",MSTDT))
if 'MSTDT!(MSTDT>DGEND)
QUIT
Begin DoDot:1
+6 SET MSTIEN=0
+7 FOR
SET MSTIEN=$ORDER(^DGMS(29.11,"B",MSTDT,MSTIEN))
if 'MSTIEN
QUIT
Begin DoDot:2
+8 SET MSTDAT=$GET(^DGMS(29.11,MSTIEN,0))
+9 SET DGX=$PIECE(MSTDAT,U,3)
+10 if '($DATA(DGMST(DGX)))
QUIT
+11 SET DFN=$PIECE(MSTDAT,U,2)
+12 SET DGX=$$GETSTAT^DGMSTAPI(DFN)
+13 if MSTIEN'=+DGX
QUIT
+14 DO DEM^VADPT
+15 IF '(DGSEX["B")
if '(DGSEX[$PIECE(VADM(5),U))
QUIT
+16 DO ELIG^VADPT
+17 IF 'DGPOS
SET DGX=$PIECE(VAEL(2),U)
if '($DATA(DGPOS(+DGX)))
QUIT
+18 SET LINE=$GET(LINE)+1
+19 IF DGDISP["P"
Begin DoDot:3
+20 SET @RPTARRY@($PIECE(MSTDAT,U,3),VADM(1),LINE)=DFN_U_MSTIEN
End DoDot:3
+21 IF '$TEST
Begin DoDot:3
+22 SET @RPTARRY@($PIECE(MSTDAT,U,3),$SELECT(VAEL(2)]"":VAEL(2),1:"UNKNOWN"),VADM(1),LINE)=DFN_U_MSTIEN
End DoDot:3
+23 DO KVAR^VADPT
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
PRNNAME(DGBEG,DGEND,DGDSP,RPTARRY,DGMST) ;
+1 ; Print out report on patient name sort. One level of sort in the ^TMP global
+2 NEW MSTST,DFN,MSTPOS,MSTNAME,MSTIEN,DGQUIT,DGNDX,MSTDAT
+3 ;
+4 SET MSTST=""
+5 FOR
SET MSTST=$ORDER(DGMST(MSTST))
if '(MSTST]"")
QUIT
Begin DoDot:1
+6 IF $ORDER(@RPTARRY@(MSTST,""))=""
Begin DoDot:2
+7 ;DG*5.3*264
SET X=$$HEADER(MSTST,DGDSP,DGBEG,DGEND)
+8 WRITE !!?5,"No data for MST status "_MSTST_" found."
End DoDot:2
QUIT
+9 SET DGQUIT=$$HEADER(MSTST,DGDSP,DGBEG,DGEND)
if $GET(DGQUIT)
QUIT
+10 SET (DGNDX,MSTNAME)=""
+11 FOR
SET MSTNAME=$ORDER(@RPTARRY@(MSTST,MSTNAME))
if '(MSTNAME]"")
QUIT
Begin DoDot:2
+12 FOR
SET DGNDX=$ORDER(@RPTARRY@(MSTST,MSTNAME,DGNDX))
if '(DGNDX]"")
QUIT
Begin DoDot:3
+13 SET MSTDAT=$GET(^(DGNDX))
+14 SET DFN=$PIECE(MSTDAT,U)
SET MSTIEN=$PIECE(MSTDAT,U,2)
+15 DO PRNTLN1(DFN,MSTIEN)
+16 IF $Y+5>$GET(IOSL)
SET DGQUIT=$$HEADER(MSTST,DGDSP,DGBEG,DGEND)
if $GET(DGQUIT)
QUIT
End DoDot:3
if $GET(DGQUIT)
QUIT
End DoDot:2
if $GET(DGQUIT)
QUIT
End DoDot:1
if $GET(DGQUIT)
QUIT
+17 QUIT
+18 ;
PRNPOS(DGBEG,DGEND,DGDSP,RPTARRY,DGMST) ;
+1 ; Print out report on period of service sort, Two levels of sort.
+2 NEW MSTST,DFN,MSTPOS,MSTNAME,MSTIEN,DGQUIT,DGX,DGNDX
+3 ;
+4 IF '$ORDER(@RPTARRY@(""))=""
Begin DoDot:1
+5 SET X=$$HEADER(MSTST,DGDSP,DGBEG,DGEND)
+6 WRITE !!?5,"No data for these parameters found."
End DoDot:1
QUIT
+7 ;
+8 SET MSTST=""
+9 FOR
SET MSTST=$ORDER(DGMST(MSTST))
if '(MSTST]"")
QUIT
Begin DoDot:1
+10 IF $ORDER(@RPTARRY@(MSTST,""))=""
Begin DoDot:2
+11 SET X=$$HEADER(MSTST,DGDSP,DGBEG,DGEND)
+12 WRITE !!?5,"No data for MST status "_MSTST_" found."
End DoDot:2
QUIT
+13 SET DGQUIT=$$HEADER(MSTST,DGDSP,DGBEG,DGEND)
if $GET(DGQUIT)
QUIT
+14 SET MSTPOS=""
+15 FOR
SET MSTPOS=$ORDER(@RPTARRY@(MSTST,MSTPOS))
if '(MSTPOS]"")
QUIT
Begin DoDot:2
+16 SET (MSTNAME,DGNDX)=""
+17 FOR
SET MSTNAME=$ORDER(@RPTARRY@(MSTST,MSTPOS,MSTNAME))
if '(MSTNAME]"")
QUIT
Begin DoDot:3
+18 FOR
SET DGNDX=$ORDER(@RPTARRY@(MSTST,MSTPOS,MSTNAME,DGNDX))
if '(DGNDX]"")
QUIT
Begin DoDot:4
+19 SET MSTDAT=$GET(^(DGNDX))
+20 SET DFN=$PIECE(MSTDAT,U)
SET MSTIEN=$PIECE(MSTDAT,U,2)
+21 DO PRNTLN1(DFN,MSTIEN)
+22 IF $Y+5>$GET(IOSL)
SET DGQUIT=$$HEADER(MSTST,DGDSP,DGBEG,DGEND)
if $GET(DGQUIT)
QUIT
End DoDot:4
if $GET(DGQUIT)
QUIT
End DoDot:3
if $GET(DGQUIT)
QUIT
End DoDot:2
if $GET(DGQUIT)
QUIT
End DoDot:1
if $GET(DGQUIT)
QUIT
+23 QUIT
+24 ;
PRNTLN1(DFN,MSTIEN) ; Format and print data for patient passed in
+1 NEW MSTACT,DGX,VADM,VAEL,VAPA,VA
+2 DO DEM^VADPT
DO ELIG^VADPT
DO ADD^VADPT
DO ACTION(DFN,.MSTACT)
+3 ;
+4 WRITE !,VA("BID")
+5 WRITE ?6,$EXTRACT(VADM(1),1,25)
+6 WRITE ?32,$EXTRACT(VAPA(1),1,25)
+7 WRITE ?58,$PIECE(VADM(5),U)
+8 WRITE ?61,$EXTRACT($PIECE(VAEL(1),U,2),1,15)
+9 WRITE ?80,$EXTRACT($PIECE(VAEL(2),U,2),1,15)
+10 WRITE ?100,$GET(MSTACT(1))
+11 WRITE !
+12 SET DGX=$EXTRACT(VAPA(4),1,$LENGTH(VAPA(4)))_$SELECT(VAPA(6)]"":", ",1:" ")_$PIECE(VAPA(5),U,2)_" "_VAPA(6)
+13 WRITE ?32,$SELECT($GET(VAPA(2))]"":$EXTRACT(VAPA(2),1,25),1:DGX)
+14 WRITE ?100,$GET(MSTACT(2))
+15 WRITE !
+16 WRITE ?32,$SELECT($GET(VAPA(2))]"":DGX,1:VAPA(8))
+17 WRITE ?100,$GET(MSTACT(3))
+18 WRITE !
+19 WRITE ?32,$SELECT($GET(VAPA(2))]"":VAPA(8),1:"")
+20 WRITE ?100,$GET(MSTACT(4))
+21 ;
+22 IF $GET(MSTACT(5))]""
Begin DoDot:1
+23 WRITE !?100,$GET(MSTACT(5))
+24 IF $GET(MSTACT(6))]""
Begin DoDot:2
+25 WRITE !?100,$GET(MSTACT(6))
End DoDot:2
End DoDot:1
+26 IF '$TEST
WRITE !
+27 ;
+28 DO KVAR^VADPT
+29 QUIT
+30 ;
+1 NEW LINE,STR,SDASH
+2 IF $GET(FRSTPAS)
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^VALM1
if 'Y
QUIT 1
+3 IF '$GET(FRSTPAS)
Begin DoDot:1
+4 SET FRSTPAS=1
+5 WRITE @IOF
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 WRITE @IOF
End DoDot:1
+8 ;
+9 SET STR="MST Detailed Demographic Report"
+10 SET $PIECE(LINE," ",(IOM/2)-($LENGTH(STR)/2))=""
+11 WRITE !,LINE_STR
+12 SET STR="MST Status: "_$SELECT(MSTST["Y":"Yes",MSTST["N":"No",MSTST["D":"Declined",1:"Unknown")
+13 KILL LINE
SET $PIECE(LINE," ",(IOM/2)-($LENGTH(STR)/2))=""
+14 WRITE !,LINE_STR
+15 SET STR="Sorted by: "_$SELECT(DGDISP["P":"Patient",1:"Period of Service\Patient")
+16 KILL LINE
SET $PIECE(LINE," ",(IOM/2)-($LENGTH(STR)/2))=""
+17 WRITE !,LINE_STR
+18 SET STR="Date Range: "_$$FMTE^XLFDT(DGBEG,"D")_" - "_$$FMTE^XLFDT(DGEND,"D")
+19 KILL LINE
SET $PIECE(LINE," ",(IOM/2)-($LENGTH(STR)/2))=""
+20 WRITE !,LINE_STR
+21 SET STR="Date printed: "_$$FMTE^XLFDT($$NOW^XLFDT,"D")
+22 KILL LINE
SET $PIECE(LINE," ",(IOM/2)-($LENGTH(STR)/2))=""
+23 WRITE !,LINE_STR
+24 WRITE !!
+25 WRITE !?32,"ADDRESS",?82,"PERIOD"
+26 WRITE !?6,"PATIENT",?32,"AND",?63,"ELIGIBILITY",?82,"OF"
+27 WRITE !,"SSN",?6,"NAME",?32,"PHONE",?57,"SEX",?63,"CODE",?82,"SERVICE",?100,"SERVICE IND."
+28 WRITE !
+29 SET $PIECE(SDASH,"-",IOM+1)=""
+30 WRITE SDASH,!
+31 QUIT 0
+32 ;
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
+2 ; respective fields
+3 ; .32101 - Vietnam
+4 ; .3221 - Lebanon
+5 ; .3224 - Grenada
+6 ; .3227 - Panama
+7 ; .32201 - Persian Gulf
+8 ; .322016 - Somalia
+9 ; Output
+10 ; MSTRSLT(n)="VIETNAM"
+11 ;
+12 NEW MSTACTN,NDX,LINE
+13 SET DFN=DFN_","
+14 DO GETS^DIQ(2,DFN,".32101;.3221;.3224;.3227;.32201;.322016","E","MSTACTN")
+15 SET NDX=""
+16 FOR
SET NDX=$ORDER(MSTACTN(2,DFN,NDX))
if 'NDX
QUIT
Begin DoDot:1
+17 if MSTACTN(2,DFN,NDX,"E")["YES"
SET LINE=$GET(LINE)+1
SET MSTRSLT(LINE)=$$SERVICE(NDX)
End DoDot:1
+18 ;
+19 QUIT
+20 ;
SERVICE(NDX) ; Convert field number to text value
+1 QUIT $SELECT(NDX=.32101:"VIETNAM",NDX=.3221:"LEBANON",NDX=.3224:"GRENADA",NDX=.3227:"PANAMA",NDX=.32201:"PERSIAN GULF",NDX=.322016:"SOMALIA",1:"UNKNOWN")
+2 ;
+3 ;
GETMST(MST) ; Multiple MST status code seletion, loops until user quites
NEXT SET DIR(0)="29.11,3AO"
+1 SET DIR("A")="Select MST status code: "
+2 SET DIR("?")="Select one of the current MST status codes: Y/N/D/U."
+3 DO ^DIR
KILL DIR
+4 if $DATA(DIRUT)
QUIT
+5 if '$DATA(MST(Y))
SET MST(Y)=""
+6 GOTO NEXT
+7 QUIT
