SCRPW43 ;RENO/KEITH - Means Test/Eligibility/Enrollment Report ; 24 Aug 99 9:25 PM
;;5.3;Scheduling;**144,176,199,258,243**;AUG 13, 1993
D ASK1^SCRPW41 Q
;
START ;Print report
D BLD^SCRPW21 S T="~"
S SDMD="",SDMD=$O(SDDIV(SDMD)),SDMD=$O(SDDIV(SDMD)),(SDSTOP,SDOUT)=0,SDT=$P(SD("BDT"),U) S:$P(SDDIV,U,2)="ALL DIVISIONS" SDMD=1
F S SDT=$O(^SCE("B",SDT)) Q:'SDT!SDOUT!(SDT>SD("EDT")) S SDOE=0 F S SDOE=$O(^SCE("B",SDT,SDOE)) Q:'SDOE!SDOUT D
.S SDOE0=$$GETOE^SDOE(SDOE) I $P(SDOE0,U,2),'$P(SDOE0,U,6),$P(SDOE0,U,11),$$DIV($P(SDOE0,U,11)),$D(SD("STAT",+$P(SDOE0,U,12))) D GET
G:SDOUT EXIT G ^SCRPW44
;
EXIT G EXIT1^SCRPW42
;
SCAT ;Select format subcategory
K DIR S (SDNUL,SDOUT)=0 I $P(SD("FMT",2),U)="MT" D
.S DIR(0)="SOA^AS:SC MT COPAY EXEMPT;AN:NSC MT COPAY EXEMPT;C:MT COPAY REQUIRED;G:GMT COPAY REQUIRED;NO:NON-VETERAN;XO:NOT APPLICABLE;UO:UNKNOWN/REQUIRED"
.S DIR("A")="Select Means Test indicator: ALL// ",DIR("?")="Specify which Means Test indicator(s) you wish to include on the report."
.Q
I $P(SD("FMT",2),U)="EE" D
.S DIR(0)="POA^8:AEMQZ",DIR("A")="Select encounter eligibility: ALL// "
.S DIR("?")="Specify which encounter eligibilities you wish to include in the report."
.Q
I $P(SD("FMT",2),U)="EP" D
.S DIR(0)="SOA^1:Group 1;2:Group 2;3:Group 3;4:Group 4;5:Group 5;6:Group 6;7:Group 7;8:Group 8;0:No enrollment"
.S DIR("A")="Select patient enrollment priority: ALL// "
.S DIR("?")="Specify which patient enrollment priorities you wish to include in the report."
.Q
F D SCAT1 Q:SDNUL!SDOUT S DIR("A")=$P(DIR("A"),"ALL")
Q:SDOUT I SDNUL,'$D(SD("FMT",3)) S SD("FMT",3,"ALL")="ALL"
Q
;
SCAT1 D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
I X="" S SDNUL=1 Q
I $D(SD("FMT",3,"X",$P(Y,U))) D SDEL Q
S SD("FMT",3,$P(Y,U))=$P(Y(0),U) Q
;
SDEL ;Delete sub-category
N DIR S DIR(0)="Y",DIR("A")="This item has already been selected, do you want to delete it" D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
Q:'Y K SD("FMT",3,$P(Y,U)) Q
;
PDIS ;Parameter display
D SUBT^SCRPW50("**** Report Parameters Selected ****") W ! D PD1(0) W !
K DIR S DIR(0)="Y",DIR("A")="Ok",DIR("B")="YES" D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
S SDOUT=Y'=1 Q
;
PD1(SDI) ;Print parameters
;Required input: SDI=0 for all division selections or division ifn
N SDLF,C S C=(IOM-80\2),SDLF=0 I SDI D PDP("Report for",SDDIV(SDI),1) Q:SDOUT
I 'SDI D PDP("Report for",SDDIV,2) Q:SDOUT D
.F S SDI=$O(SDDIV(SDI)) Q:'SDI!SDOUT D PDP("Division",SDDIV(SDI),1)
Q:SDOUT D PDP("Beginning date",SD("BDT"),2,0,1) Q:SDOUT D PDP("Ending date",SD("EDT"),2) Q:SDOUT
D PDP("Report format",SD("FMT",1),2,0,1) Q:SDOUT I $P(SD("FMT",1),U)="D" D
.D PDP("Detail category",SD("FMT",2),2,0,1) Q:SDOUT S SDI="",(SDII,SDL1)=0
.F S SDI=$O(SD("FMT",3,SDI)) Q:SDI=""!SDOUT D PDP($$LC($P(SD("FMT",2),U,2)),SD("FMT",3,SDI),1,SDII,'SDL1) S (SDL1,SDII)=1
.Q
Q:SDOUT S (SDI,SDII,SDL1)=0 F S SDI=$O(SD("STAT",SDI)) Q:'SDI!SDOUT D PDP("Encounter status",SD("STAT",SDI),1,SDII,'SDL1) S (SDL1,SDII)=1
Q:$P(SD("FMT",1),U)="S" S SDX="Output sort elements"
I SD("SORT")=0 D PDP(SDX,"(NONE SELECTED)",1,0,1) Q
I $E(IOST)="C",SDLF+SD("SORT")>18 D WAIT Q:SDOUT
I $Y>(IOSL-3-SD("SORT")),$E(IOST)="P" D HDR^SCRPW44 Q:SDOUT
W:$E(IOST)="C" !!?(C),SDX,":" W:$E(IOST)="P" !!,$J(SDX,(IOM-6\2)),":"
S SDI=0 F S SDI=$O(SD("SORT",SDI)) Q:'SDI S SDX=SD("SORT",SDI) W:SDI>1 ! W ?($S($E(IOST)="P":(IOM\2-1),1:C+19+(3*SDI))) S SDL=$S($P(SDX,U,3):(IOM-11-$X),1:(IOM-$X)) W $E($P(SDX,U,2),1,SDL)_$S($P(SDX,U,3):" <pagefeed>",1:"")
Q
;
PDP(SDT,SDX,SDP,SDL,SDL1) ;Print parameter display line
;Required input: SDT=parameter title
;Required input: SDX=parameter value
;Required input: SDP=$P of SDX to print
;Optional input: SDL=1 to suppress title and do line feed
;Optional input: SDL1=1 to do additional line feed
S SDLF=SDLF+1 I $E(IOST)="C",SDLF#18=0 D WAIT Q:SDOUT
I $Y>(IOSL-3),$E(IOST)="P" D HDR^SCRPW44 Q:SDOUT
I $G(SDL1) W ! S SDLF=SDLF+1
W ! W:'$G(SDL) $J(SDT,(IOM-6\2)),":" W ?(IOM\2-1),$P(SDX,U,SDP) Q
;
WAIT ;Do CRT pause
N DIR W ! S DIR(0)="E" D ^DIR S SDOUT=Y'=1 W ! Q
;
LC(X) ;Lowercase value
N SDI F SDI=2:1:$L(X) I $E(X,SDI)?1U,$E(X,SDI-1)?1A S X=$E(X,0,SDI-1)_$C($A(X,SDI)+32)_$E(X,SDI+1,999)
Q X
;
DIV(SDIV) ;Evaluate division
Q:'SDDIV 1 Q $D(SDDIV(SDIV))
;
GET ;Gather report information
N SDINC
S DFN=$P(SDOE0,U,2),SDIV=$P(SDOE0,U,11),SDSTOP=SDSTOP+1 D:SDSTOP#2000=0 STOP Q:SDOUT
S SDMT=$$MTI^SCDXUTL0(DFN,$P(SDOE0,U),$P(SDOE0,U,13),$P(SDOE0,U,10),SDOE)
S:"NXU"[SDMT SDMT=SDMT_"O" S SDEL=$P(SDOE0,U,13) S:'$L(SDEL) SDEL="NONE"
S SDEP=+$P($$ENROL^SCRPW24(DT),U,7),SDINC=$$INCL()
S SDMT=$S(SDMT="AN":"NSC MT Copay exempt (AN)",SDMT="AS":"SC MT Copay exempt (AS)",SDMT="C":"MT Copay req'd (C)",SDMT="G":"GMT Copay req'd (G)",SDMT="NO":"Non-veteran (NO)",SDMT="XO":"Not applicable (XO)",SDMT="UO":"Unknown/Req'd (UO)",1:"NN")
I SDMT="NN" S SDMT="~~~NONE~~~"
S SDEL=$P($G(^DIC(8,+SDEL,0)),U) S:'$L(SDEL) SDEL="~~~NONE~~~"
S SDEP=$S(SDEP=0:"No enrollment",1:"Group "_SDEP)
D SET0(SDIV) D:SDMD SET0(0) Q:$P(SD("FMT",1),U)="S"
S SDX=$P(SD("FMT",2),U),SDX=$S(SDX="MT":SDMT,SDX="EE":SDEL,1:SDEP),SDY=SDMT_U_SDEL_U_SDEP
I SDINC,$P(SD("FMT",1),U)="D" D SET1($P(SDOE0,U,11)) D:SDMD SET1(0)
Q
;
SET0(SDIV) ;Set TMP global for summary
S ^TMP("SCRPW",$J,0,SDIV,"MT",SDMT,"ENC")=$G(^TMP("SCRPW",$J,0,SDIV,"MT",SDMT,"ENC"))+1
S ^TMP("SCRPW",$J,0,SDIV,"MTP",SDMT,DFN,$P($P(SDOE0,U),"."))=""
S ^TMP("SCRPW",$J,0,SDIV,"EE",SDEL,"ENC")=$G(^TMP("SCRPW",$J,0,SDIV,"EE",SDEL,"ENC"))+1
S ^TMP("SCRPW",$J,0,SDIV,"EEP",SDEL,DFN,$P($P(SDOE0,U),"."))=""
S ^TMP("SCRPW",$J,0,SDIV,"EP",SDEP,"ENC")=$G(^TMP("SCRPW",$J,0,SDIV,"EP",SDEP,"ENC"))+1
S ^TMP("SCRPW",$J,0,SDIV,"EPP",SDEP,DFN,$P($P(SDOE0,U),"."))=""
S ^TMP("SCRPW",$J,0,SDIV,"RPT","ENC")=$G(^TMP("SCRPW",$J,0,SDIV,"RPT","ENC"))+1
S ^TMP("SCRPW",$J,0,SDIV,"RPT",DFN,$P($P(SDOE0,U),"."))=""
Q
;
SET1(SDIV) ;Set TMP global for detail
S SD0=$G(^DPT(DFN,0)),SDSSN=$P(SD0,U,9),SDPNAM=$P(SD0,U) Q:'$L(SDPNAM)
N SDS I SD("SORT") S SDI="" F S SDI=$O(SD("SORT",SDI)) Q:'SDI S SDS(SDI)=$$SORT($P(SD("SORT",SDI),U))
I 'SD("SORT") S ^TMP("SCRPW",$J,1,SDIV,SDX,SDPNAM,DFN)=SDSSN_U_SDY Q
I SD("SORT")=1 S ^TMP("SCRPW",$J,1,SDIV,SDX,SDS(1),SDPNAM,DFN)=SDSSN_U_SDY Q
I SD("SORT")=2 S ^TMP("SCRPW",$J,1,SDIV,SDX,SDS(1),SDS(2),SDPNAM,DFN)=SDSSN_U_SDY Q
I SD("SORT")=3 S ^TMP("SCRPW",$J,1,SDIV,SDX,SDS(1),SDS(2),SDS(3),SDPNAM,DFN)=SDSSN_U_SDY Q
S SDUI=$$DSV(SDIV,SDX,SDS(1),SDS(2),SDS(3),SDS(4))
I SD("SORT")=4 S ^TMP("SCRPW",$J,1,SDIV,SDX,SDS(1),SDS(2),SDS(3),SDS(4))=SDUI,^TMP("SCRPW",$J,2,SDUI,SDPNAM,DFN)=SDSSN_U_SDY Q
I SD("SORT")=5 S ^TMP("SCRPW",$J,1,SDIV,SDX,SDS(1),SDS(2),SDS(3),SDS(4))=SDUI,^TMP("SCRPW",$J,2,SDUI,SDS(5),SDPNAM,DFN)=SDSSN_U_SDY Q
I SD("SORT")=6 S ^TMP("SCRPW",$J,1,SDIV,SDX,SDS(1),SDS(2),SDS(3),SDS(4))=SDUI,^TMP("SCRPW",$J,2,SDUI,SDS(5),SDS(6),SDPNAM,DFN)=SDSSN_U_SDY
Q
;
DSV(SDIV,S0,S1,S2,S3,S4) ;Produce detail sort value
;Required input: SDIV=division
;Required input: S0, S1, S2, S3, S4=subscript values
N SDX S SDX=$G(^TMP("SCRPW",$J,3,SDIV,S0,S1,S2,S3,S4)) Q:SDX SDX
S (SDX,^TMP("SCRPW",$J,3,SDIV,0))=$G(^TMP("SCRPW",$J,3,SDIV,0))+1
S ^TMP("SCRPW",$J,3,SDIV,S0,S1,S2,S3,S4)=SDX Q SDX
;
SORT(SDACR) ;Return sort value
;Required input: SDACR=data element acronym
N SDACT,SDX,SDOE0
S SDOE0=U_DFN_U,SDACT=^TMP("SCRPW",$J,"ACT",SDACR) X $P(SDACT,T,7)
S SDX=$O(SDX("")) Q $P(SDX(SDX),U,2)
;
STOP ;Check for stop task request
S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
;
INCL() ;Determine if encounter should be included in detailed report
;Output: 1=yes, 0=no
Q:$P(SD("FMT",1),U)="S" 1
N SDFMT S SDFMT=$P(SD("FMT",2),U)
Q:$D(SD("FMT",3,"ALL")) 1
I SDFMT="MT",$D(SD("FMT",3,SDMT)) Q 1
I SDFMT="EE",$D(SD("FMT",3,SDEL)) Q 1
I SDFMT="EP",$D(SD("FMT",3,SDEP)) Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPW43 7934 printed Dec 13, 2024@02:43:44 Page 2
SCRPW43 ;RENO/KEITH - Means Test/Eligibility/Enrollment Report ; 24 Aug 99 9:25 PM
+1 ;;5.3;Scheduling;**144,176,199,258,243**;AUG 13, 1993
+2 DO ASK1^SCRPW41
QUIT
+3 ;
START ;Print report
+1 DO BLD^SCRPW21
SET T="~"
+2 SET SDMD=""
SET SDMD=$ORDER(SDDIV(SDMD))
SET SDMD=$ORDER(SDDIV(SDMD))
SET (SDSTOP,SDOUT)=0
SET SDT=$PIECE(SD("BDT"),U)
if $PIECE(SDDIV,U,2)="ALL DIVISIONS"
SET SDMD=1
+3 FOR
SET SDT=$ORDER(^SCE("B",SDT))
if 'SDT!SDOUT!(SDT>SD("EDT"))
QUIT
SET SDOE=0
FOR
SET SDOE=$ORDER(^SCE("B",SDT,SDOE))
if 'SDOE!SDOUT
QUIT
Begin DoDot:1
+4 SET SDOE0=$$GETOE^SDOE(SDOE)
IF $PIECE(SDOE0,U,2)
IF '$PIECE(SDOE0,U,6)
IF $PIECE(SDOE0,U,11)
IF $$DIV($PIECE(SDOE0,U,11))
IF $DATA(SD("STAT",+$PIECE(SDOE0,U,12)))
DO GET
End DoDot:1
+5 if SDOUT
GOTO EXIT
GOTO ^SCRPW44
+6 ;
EXIT GOTO EXIT1^SCRPW42
+1 ;
SCAT ;Select format subcategory
+1 KILL DIR
SET (SDNUL,SDOUT)=0
IF $PIECE(SD("FMT",2),U)="MT"
Begin DoDot:1
+2 SET DIR(0)="SOA^AS:SC MT COPAY EXEMPT;AN:NSC MT COPAY EXEMPT;C:MT COPAY REQUIRED;G:GMT COPAY REQUIRED;NO:NON-VETERAN;XO:NOT APPLICABLE;UO:UNKNOWN/REQUIRED"
+3 SET DIR("A")="Select Means Test indicator: ALL// "
SET DIR("?")="Specify which Means Test indicator(s) you wish to include on the report."
+4 QUIT
End DoDot:1
+5 IF $PIECE(SD("FMT",2),U)="EE"
Begin DoDot:1
+6 SET DIR(0)="POA^8:AEMQZ"
SET DIR("A")="Select encounter eligibility: ALL// "
+7 SET DIR("?")="Specify which encounter eligibilities you wish to include in the report."
+8 QUIT
End DoDot:1
+9 IF $PIECE(SD("FMT",2),U)="EP"
Begin DoDot:1
+10 SET DIR(0)="SOA^1:Group 1;2:Group 2;3:Group 3;4:Group 4;5:Group 5;6:Group 6;7:Group 7;8:Group 8;0:No enrollment"
+11 SET DIR("A")="Select patient enrollment priority: ALL// "
+12 SET DIR("?")="Specify which patient enrollment priorities you wish to include in the report."
+13 QUIT
End DoDot:1
+14 FOR
DO SCAT1
if SDNUL!SDOUT
QUIT
SET DIR("A")=$PIECE(DIR("A"),"ALL")
+15 if SDOUT
QUIT
IF SDNUL
IF '$DATA(SD("FMT",3))
SET SD("FMT",3,"ALL")="ALL"
+16 QUIT
+17 ;
SCAT1 DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
QUIT
+1 IF X=""
SET SDNUL=1
QUIT
+2 IF $DATA(SD("FMT",3,"X",$PIECE(Y,U)))
DO SDEL
QUIT
+3 SET SD("FMT",3,$PIECE(Y,U))=$PIECE(Y(0),U)
QUIT
+4 ;
SDEL ;Delete sub-category
+1 NEW DIR
SET DIR(0)="Y"
SET DIR("A")="This item has already been selected, do you want to delete it"
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
QUIT
+2 if 'Y
QUIT
KILL SD("FMT",3,$PIECE(Y,U))
QUIT
+3 ;
PDIS ;Parameter display
+1 DO SUBT^SCRPW50("**** Report Parameters Selected ****")
WRITE !
DO PD1(0)
WRITE !
+2 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Ok"
SET DIR("B")="YES"
DO ^DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
QUIT
+3 SET SDOUT=Y'=1
QUIT
+4 ;
PD1(SDI) ;Print parameters
+1 ;Required input: SDI=0 for all division selections or division ifn
+2 NEW SDLF,C
SET C=(IOM-80\2)
SET SDLF=0
IF SDI
DO PDP("Report for",SDDIV(SDI),1)
if SDOUT
QUIT
+3 IF 'SDI
DO PDP("Report for",SDDIV,2)
if SDOUT
QUIT
Begin DoDot:1
+4 FOR
SET SDI=$ORDER(SDDIV(SDI))
if 'SDI!SDOUT
QUIT
DO PDP("Division",SDDIV(SDI),1)
End DoDot:1
+5 if SDOUT
QUIT
DO PDP("Beginning date",SD("BDT"),2,0,1)
if SDOUT
QUIT
DO PDP("Ending date",SD("EDT"),2)
if SDOUT
QUIT
+6 DO PDP("Report format",SD("FMT",1),2,0,1)
if SDOUT
QUIT
IF $PIECE(SD("FMT",1),U)="D"
Begin DoDot:1
+7 DO PDP("Detail category",SD("FMT",2),2,0,1)
if SDOUT
QUIT
SET SDI=""
SET (SDII,SDL1)=0
+8 FOR
SET SDI=$ORDER(SD("FMT",3,SDI))
if SDI=""!SDOUT
QUIT
DO PDP($$LC($PIECE(SD("FMT",2),U,2)),SD("FMT",3,SDI),1,SDII,'SDL1)
SET (SDL1,SDII)=1
+9 QUIT
End DoDot:1
+10 if SDOUT
QUIT
SET (SDI,SDII,SDL1)=0
FOR
SET SDI=$ORDER(SD("STAT",SDI))
if 'SDI!SDOUT
QUIT
DO PDP("Encounter status",SD("STAT",SDI),1,SDII,'SDL1)
SET (SDL1,SDII)=1
+11 if $PIECE(SD("FMT",1),U)="S"
QUIT
SET SDX="Output sort elements"
+12 IF SD("SORT")=0
DO PDP(SDX,"(NONE SELECTED)",1,0,1)
QUIT
+13 IF $EXTRACT(IOST)="C"
IF SDLF+SD("SORT")>18
DO WAIT
if SDOUT
QUIT
+14 IF $Y>(IOSL-3-SD("SORT"))
IF $EXTRACT(IOST)="P"
DO HDR^SCRPW44
if SDOUT
QUIT
+15 if $EXTRACT(IOST)="C"
WRITE !!?(C),SDX,":"
if $EXTRACT(IOST)="P"
WRITE !!,$JUSTIFY(SDX,(IOM-6\2)),":"
+16 SET SDI=0
FOR
SET SDI=$ORDER(SD("SORT",SDI))
if 'SDI
QUIT
SET SDX=SD("SORT",SDI)
if SDI>1
WRITE !
WRITE ?($SELECT($EXTRACT(IOST)="P":(IOM\2-1),1:C+19+(3*SDI)))
SET SDL=$SELECT($PIECE(SDX,U,3):(IOM-11-$X),1:(IOM-$X))
WRITE $EXTRACT($PIECE(SDX,U,2),1,SDL)_$SELECT($PIECE(SDX,U,3):" <pagefeed>",1:"")
+17 QUIT
+18 ;
PDP(SDT,SDX,SDP,SDL,SDL1) ;Print parameter display line
+1 ;Required input: SDT=parameter title
+2 ;Required input: SDX=parameter value
+3 ;Required input: SDP=$P of SDX to print
+4 ;Optional input: SDL=1 to suppress title and do line feed
+5 ;Optional input: SDL1=1 to do additional line feed
+6 SET SDLF=SDLF+1
IF $EXTRACT(IOST)="C"
IF SDLF#18=0
DO WAIT
if SDOUT
QUIT
+7 IF $Y>(IOSL-3)
IF $EXTRACT(IOST)="P"
DO HDR^SCRPW44
if SDOUT
QUIT
+8 IF $GET(SDL1)
WRITE !
SET SDLF=SDLF+1
+9 WRITE !
if '$GET(SDL)
WRITE $JUSTIFY(SDT,(IOM-6\2)),":"
WRITE ?(IOM\2-1),$PIECE(SDX,U,SDP)
QUIT
+10 ;
WAIT ;Do CRT pause
+1 NEW DIR
WRITE !
SET DIR(0)="E"
DO ^DIR
SET SDOUT=Y'=1
WRITE !
QUIT
+2 ;
LC(X) ;Lowercase value
+1 NEW SDI
FOR SDI=2:1:$LENGTH(X)
IF $EXTRACT(X,SDI)?1U
IF $EXTRACT(X,SDI-1)?1A
SET X=$EXTRACT(X,0,SDI-1)_$CHAR($ASCII(X,SDI)+32)_$EXTRACT(X,SDI+1,999)
+2 QUIT X
+3 ;
DIV(SDIV) ;Evaluate division
+1 if 'SDDIV
QUIT 1
QUIT $DATA(SDDIV(SDIV))
+2 ;
GET ;Gather report information
+1 NEW SDINC
+2 SET DFN=$PIECE(SDOE0,U,2)
SET SDIV=$PIECE(SDOE0,U,11)
SET SDSTOP=SDSTOP+1
if SDSTOP#2000=0
DO STOP
if SDOUT
QUIT
+3 SET SDMT=$$MTI^SCDXUTL0(DFN,$PIECE(SDOE0,U),$PIECE(SDOE0,U,13),$PIECE(SDOE0,U,10),SDOE)
+4 if "NXU"[SDMT
SET SDMT=SDMT_"O"
SET SDEL=$PIECE(SDOE0,U,13)
if '$LENGTH(SDEL)
SET SDEL="NONE"
+5 SET SDEP=+$PIECE($$ENROL^SCRPW24(DT),U,7)
SET SDINC=$$INCL()
+6 SET SDMT=$SELECT(SDMT="AN":"NSC MT Copay exempt (AN)",SDMT="AS":"SC MT Copay exempt (AS)",SDMT="C":"MT Copay req'd (C)",SDMT="G":"GMT Copay req'd (G)",SDMT="NO":"Non-veteran (NO)",SDMT="XO":"Not applicable (XO)",SDMT="UO":"Unknown/Req'd (UO)",1
:"NN")
+7 IF SDMT="NN"
SET SDMT="~~~NONE~~~"
+8 SET SDEL=$PIECE($GET(^DIC(8,+SDEL,0)),U)
if '$LENGTH(SDEL)
SET SDEL="~~~NONE~~~"
+9 SET SDEP=$SELECT(SDEP=0:"No enrollment",1:"Group "_SDEP)
+10 DO SET0(SDIV)
if SDMD
DO SET0(0)
if $PIECE(SD("FMT",1),U)="S"
QUIT
+11 SET SDX=$PIECE(SD("FMT",2),U)
SET SDX=$SELECT(SDX="MT":SDMT,SDX="EE":SDEL,1:SDEP)
SET SDY=SDMT_U_SDEL_U_SDEP
+12 IF SDINC
IF $PIECE(SD("FMT",1),U)="D"
DO SET1($PIECE(SDOE0,U,11))
if SDMD
DO SET1(0)
+13 QUIT
+14 ;
SET0(SDIV) ;Set TMP global for summary
+1 SET ^TMP("SCRPW",$JOB,0,SDIV,"MT",SDMT,"ENC")=$GET(^TMP("SCRPW",$JOB,0,SDIV,"MT",SDMT,"ENC"))+1
+2 SET ^TMP("SCRPW",$JOB,0,SDIV,"MTP",SDMT,DFN,$PIECE($PIECE(SDOE0,U),"."))=""
+3 SET ^TMP("SCRPW",$JOB,0,SDIV,"EE",SDEL,"ENC")=$GET(^TMP("SCRPW",$JOB,0,SDIV,"EE",SDEL,"ENC"))+1
+4 SET ^TMP("SCRPW",$JOB,0,SDIV,"EEP",SDEL,DFN,$PIECE($PIECE(SDOE0,U),"."))=""
+5 SET ^TMP("SCRPW",$JOB,0,SDIV,"EP",SDEP,"ENC")=$GET(^TMP("SCRPW",$JOB,0,SDIV,"EP",SDEP,"ENC"))+1
+6 SET ^TMP("SCRPW",$JOB,0,SDIV,"EPP",SDEP,DFN,$PIECE($PIECE(SDOE0,U),"."))=""
+7 SET ^TMP("SCRPW",$JOB,0,SDIV,"RPT","ENC")=$GET(^TMP("SCRPW",$JOB,0,SDIV,"RPT","ENC"))+1
+8 SET ^TMP("SCRPW",$JOB,0,SDIV,"RPT",DFN,$PIECE($PIECE(SDOE0,U),"."))=""
+9 QUIT
+10 ;
SET1(SDIV) ;Set TMP global for detail
+1 SET SD0=$GET(^DPT(DFN,0))
SET SDSSN=$PIECE(SD0,U,9)
SET SDPNAM=$PIECE(SD0,U)
if '$LENGTH(SDPNAM)
QUIT
+2 NEW SDS
IF SD("SORT")
SET SDI=""
FOR
SET SDI=$ORDER(SD("SORT",SDI))
if 'SDI
QUIT
SET SDS(SDI)=$$SORT($PIECE(SD("SORT",SDI),U))
+3 IF 'SD("SORT")
SET ^TMP("SCRPW",$JOB,1,SDIV,SDX,SDPNAM,DFN)=SDSSN_U_SDY
QUIT
+4 IF SD("SORT")=1
SET ^TMP("SCRPW",$JOB,1,SDIV,SDX,SDS(1),SDPNAM,DFN)=SDSSN_U_SDY
QUIT
+5 IF SD("SORT")=2
SET ^TMP("SCRPW",$JOB,1,SDIV,SDX,SDS(1),SDS(2),SDPNAM,DFN)=SDSSN_U_SDY
QUIT
+6 IF SD("SORT")=3
SET ^TMP("SCRPW",$JOB,1,SDIV,SDX,SDS(1),SDS(2),SDS(3),SDPNAM,DFN)=SDSSN_U_SDY
QUIT
+7 SET SDUI=$$DSV(SDIV,SDX,SDS(1),SDS(2),SDS(3),SDS(4))
+8 IF SD("SORT")=4
SET ^TMP("SCRPW",$JOB,1,SDIV,SDX,SDS(1),SDS(2),SDS(3),SDS(4))=SDUI
SET ^TMP("SCRPW",$JOB,2,SDUI,SDPNAM,DFN)=SDSSN_U_SDY
QUIT
+9 IF SD("SORT")=5
SET ^TMP("SCRPW",$JOB,1,SDIV,SDX,SDS(1),SDS(2),SDS(3),SDS(4))=SDUI
SET ^TMP("SCRPW",$JOB,2,SDUI,SDS(5),SDPNAM,DFN)=SDSSN_U_SDY
QUIT
+10 IF SD("SORT")=6
SET ^TMP("SCRPW",$JOB,1,SDIV,SDX,SDS(1),SDS(2),SDS(3),SDS(4))=SDUI
SET ^TMP("SCRPW",$JOB,2,SDUI,SDS(5),SDS(6),SDPNAM,DFN)=SDSSN_U_SDY
+11 QUIT
+12 ;
DSV(SDIV,S0,S1,S2,S3,S4) ;Produce detail sort value
+1 ;Required input: SDIV=division
+2 ;Required input: S0, S1, S2, S3, S4=subscript values
+3 NEW SDX
SET SDX=$GET(^TMP("SCRPW",$JOB,3,SDIV,S0,S1,S2,S3,S4))
if SDX
QUIT SDX
+4 SET (SDX,^TMP("SCRPW",$JOB,3,SDIV,0))=$GET(^TMP("SCRPW",$JOB,3,SDIV,0))+1
+5 SET ^TMP("SCRPW",$JOB,3,SDIV,S0,S1,S2,S3,S4)=SDX
QUIT SDX
+6 ;
SORT(SDACR) ;Return sort value
+1 ;Required input: SDACR=data element acronym
+2 NEW SDACT,SDX,SDOE0
+3 SET SDOE0=U_DFN_U
SET SDACT=^TMP("SCRPW",$JOB,"ACT",SDACR)
XECUTE $PIECE(SDACT,T,7)
+4 SET SDX=$ORDER(SDX(""))
QUIT $PIECE(SDX(SDX),U,2)
+5 ;
STOP ;Check for stop task request
+1 if $DATA(ZTQUEUED)
SET (SDOUT,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)
QUIT
+2 ;
INCL() ;Determine if encounter should be included in detailed report
+1 ;Output: 1=yes, 0=no
+2 if $PIECE(SD("FMT",1),U)="S"
QUIT 1
+3 NEW SDFMT
SET SDFMT=$PIECE(SD("FMT",2),U)
+4 if $DATA(SD("FMT",3,"ALL"))
QUIT 1
+5 IF SDFMT="MT"
IF $DATA(SD("FMT",3,SDMT))
QUIT 1
+6 IF SDFMT="EE"
IF $DATA(SD("FMT",3,SDEL))
QUIT 1
+7 IF SDFMT="EP"
IF $DATA(SD("FMT",3,SDEP))
QUIT 1
+8 QUIT 0
