- 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 Jan 18, 2025@03:44:52 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