| [613] | 1 | SCRPW41 ;RENO/KEITH - Veterans Without Activity Since a Specified Date Range ; 5/25/2004
|
|---|
| 2 | ;;5.3;Scheduling;**144,375,358**;AUG 13, 1993
|
|---|
| 3 | N DIR,%DT K SD
|
|---|
| 4 | D TITL^SCRPW50("Veterans Without Activity Since a Specified Date Range")
|
|---|
| 5 | W !!,"This report will return a list of veterans that are not deceased who had",!,"activity during a date range specified by the user, and have not been seen"
|
|---|
| 6 | W !,"since. Activity is determined by an examination of Fee Basis, inpatient and",!,"outpatient care (including future appointments). Once the scheduling"
|
|---|
| 7 | W !,"replacement application has been implemented at your site, this report will",!,"no longer be accurate."
|
|---|
| 8 | D SUBT^SCRPW50("**** Date Range Selection ****")
|
|---|
| 9 | W ! S %DT="AEPX",%DT("A")="Beginning date: " D ^%DT G:Y<1 EXIT^SCRPW42 S SD("BDT")=Y X ^DD("DD") S SD("PBDT")=Y
|
|---|
| 10 | EDT S %DT("A")=" Ending date: " W ! D ^%DT G:Y<1 EXIT^SCRPW42
|
|---|
| 11 | I Y<SD("BDT") W !!,$C(7),"End date cannot be before begin date!",! G EDT
|
|---|
| 12 | S SD("EDT")=Y_.999999 X ^DD("DD") S SD("PEDT")=Y,(SDOUT,SDNUL)=0
|
|---|
| 13 | D BLD^SCRPW21 S SDX="" D SUBT^SCRPW50("**** Output Sort Selection (optional) ****") S DIR("?")="Sort elements selected will determine the order of output.",(SD("PAGE"),SD("SORT"))=0
|
|---|
| 14 | F SDI=1:1:6 S T="~",DIR("A")=$S(SDX="":"Specify data element to sort by",1:"Within "_SDX_", sort by") D ASK Q:SDOUT!SDNUL
|
|---|
| 15 | G:SDOUT EXIT^SCRPW42 D SUBT^SCRPW50("**** Parameters Selected ****") W !!,"Veterans not seen since the date range: ",SD("PBDT")," to ",SD("PEDT"),!!,"Output sort elements: " D
|
|---|
| 16 | .I SD("SORT")=0 W "(NONE SELECTED)" Q
|
|---|
| 17 | .S SDI=0 F S SDI=$O(SD("SORT",SDI)) Q:'SDI S SDX=SD("SORT",SDI) W:SDI>1 ! W ?(19+(3*SDI)) S SDL=$S($P(SDX,U,3):(69-$X),1:(80-$X)) W $E($P(SDX,U,2),1,SDL)_$S($P(SDX,U,3):" <pagefeed>",1:"")
|
|---|
| 18 | .Q
|
|---|
| 19 | K DIR S DIR(0)="Y",DIR("A")="Ok",DIR("B")="YES",DIR("?")="Specify if the parameters are satisfactory as displayed." W ! D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT^SCRPW42 G:'Y EXIT^SCRPW42
|
|---|
| 20 | N ZTSAVE S ZTSAVE("SD(")="" W !!,"This report requires 132 column output.",!
|
|---|
| 21 | D EN^XUTMDEVQ("START^SCRPW41","Veterans Without Activity Since a Specified Date",.ZTSAVE) G EXIT^SCRPW42
|
|---|
| 22 | ;
|
|---|
| 23 | ASK ;Ask for sort elements
|
|---|
| 24 | N SDZ I $L(SDX) D SUBT^SCRPW50("**** Select "_$S(SDI=2:"second",SDI=3:"third",SDI=4:"fourth",SDI=5:"fifth",SDI=6:"sixth",1:"another")_" sort element (optional) ****")
|
|---|
| 25 | K DIR(0) S S1=$$DIR^SCRPW23(.DIR,1,"","","O",2) Q:SDOUT!SDNUL
|
|---|
| 26 | K DIR(0) S DIR("A")="Select "_$P(S1,U,2)_" data element",S2=$$DIR^SCRPW23(.DIR,2,"",$P(S1,U),"O",2,1) Q:SDOUT I SDNUL S SDNUL=0 G ASK
|
|---|
| 27 | S SDX=$P(S2,U,2),SD("SORT",SDI)=$P(S1,U)_$P(S2,U)_U_SDX_U_$$PF(),SD("SORT")=SD("SORT")+1 Q
|
|---|
| 28 | ;
|
|---|
| 29 | PF() ;Prompt for page feed
|
|---|
| 30 | N DIR S DIR(0)="Y",DIR("A")="Perform a pagefeed for each new "_SDX_" value",DIR("B")="NO",DIR("?")="Specify if you want a pagefeed between each sort value for this element." W ! D ^DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q 0
|
|---|
| 31 | S:Y SD("PAGE")=SDI Q Y
|
|---|
| 32 | ;
|
|---|
| 33 | START ;Print report
|
|---|
| 34 | K ^TMP("SCRPW",$J) D BLD^SCRPW21 S (SDOUT,SDSTOP,DFN)=0 D NOW^%DTC S SDNOW=%,T="~"
|
|---|
| 35 | S SDFEE=""
|
|---|
| 36 | F S DFN=$O(^DPT(DFN)) Q:'DFN S SDSTOP=SDSTOP+1 D:SDSTOP#3000=0 STOP Q:SDOUT I $$VET() S SDX=$$EVAL(SD("BDT"),SD("EDT")) D:$P(SDX,U)=2 SET
|
|---|
| 37 | G:SDOUT EXIT^SCRPW42 D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDLINE="",$P(SDLINE,"-",133)="",SDPAGE=1,(SDTOT,SDPG)=0 G ^SCRPW42
|
|---|
| 38 | ;
|
|---|
| 39 | VET() ;Vet? Alive? Eligible?
|
|---|
| 40 | D DEM^VADPT Q:VADM(6) 0 ;deceased
|
|---|
| 41 | D ELIG^VADPT Q:'VAEL(4) 0 ;veteran
|
|---|
| 42 | Q VAEL(5) ;eligible
|
|---|
| 43 | ;
|
|---|
| 44 | EVAL(SDBD,SDED) ;Evaluate last activity
|
|---|
| 45 | ;Required input: SDBD=begin date of date range
|
|---|
| 46 | ;Required input: SDED=end date of date range
|
|---|
| 47 | ;Output: code^last activity date^location, where 'code'=
|
|---|
| 48 | ; 1=activity since date range
|
|---|
| 49 | ; 2=activity during date range, none since
|
|---|
| 50 | ; 3=no activity during or after date range
|
|---|
| 51 | N SDDT,SDX,SDXX,SDY
|
|---|
| 52 | S SDX=$O(^SCE("ADFN",DFN,9999999),-1) I SDX S SDY=$O(^SCE("ADFN",DFN,SDX,0)),SDY=$$GETOE^SDOE(SDY),SDY=$P($G(^SC(+$P(SDY,U,4),0)),U),SDDT(SDX)=SDY
|
|---|
| 53 | S SDX=$O(^DPT(DFN,"S",9999999),-1) I SDX S SDY=+$G(^DPT(DFN,"S",SDX,0)),SDY=$P($G(^SC(+SDY,0)),U),SDDT(SDX)=SDY
|
|---|
| 54 | S SDX=$O(^DPT(DFN,"DIS",0)) I SDX S SDDT(9999999-SDX)="REGISTRATION"
|
|---|
| 55 | S SDX=$O(^SDV("ADT",DFN,9999999),-1) I SDX S SDDT(SDX)="ADD/EDIT"
|
|---|
| 56 | ;S SDX=$O(^FBAAA(DFN,1,9999999),-1) I SDX S SDX=$P($G(^FBAAA(DFN,1,SDX,0)),U) I SDX S SDDT(SDX)="FEE BASIS"
|
|---|
| 57 | S SDXX=$$AUTHL^FBUTL(DFN,,SDBD,"SDX") D
|
|---|
| 58 | .I +SDXX=-1,$P(SDXX,"^",2)=110 S SDFEE="FEE BASIS SYSTEM NOT AVAILABLE"
|
|---|
| 59 | .I SDXX>0 S SDDT($G(SDX(SDXX,"FDT")))="FEE BASIS"
|
|---|
| 60 | S SDX=$O(^DGPM("APRD",DFN,9999999),-1) I SDX S SDY=$O(^DGPM("APRD",DFN,SDX,0)),SDY=$G(^DGPM(+SDY,0)) I $L(SDY) D
|
|---|
| 61 | .I $P(SDY,U,2)=1 S SDDT(SDX)=$P($G(^DIC(42,+$P(SDY,U,6),0)),U) Q
|
|---|
| 62 | .I $P(SDY,U,2)=3 N D0,X S D0=$O(^DGPM("APRD",DFN,SDX,0)) D WARD^DGPMUTL S SDDT(SDX)=X Q
|
|---|
| 63 | .D WARD(SDX) Q
|
|---|
| 64 | D WARD(SDNOW)
|
|---|
| 65 | S SDX=$O(SDDT(9999999),-1),SDX=$S('$L(SDX):U_U,1:U_SDX_U_SDDT(SDX))
|
|---|
| 66 | Q:$P(SDX,U,2)'<SDED 1_SDX Q:$P(SDX,U,2)'<SDBD 2_SDX Q 3_SDX
|
|---|
| 67 | ;
|
|---|
| 68 | WARD(SDT) ;Get ward for date/time
|
|---|
| 69 | ;Required input: SDT=date/time
|
|---|
| 70 | N DGT,DG1,DGA1,DGXFR0 S DGT=SDT D ^DGPMSTAT I DG1 S SDDT(SDT)=$P($G(^DIC(42,DG1,0)),U)
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | SET ;Set TMP global
|
|---|
| 74 | S SD0=$G(^DPT(DFN,0)),SDSSN=$P(SD0,U,9),SDPNAM=$P(SD0,U) Q:'$L(SDPNAM) S $P(SDX,U)=SDSSN
|
|---|
| 75 | 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))
|
|---|
| 76 | I 'SD("SORT") S ^TMP("SCRPW",$J,1,SDPNAM,DFN)=SDX Q
|
|---|
| 77 | I SD("SORT")=1 S ^TMP("SCRPW",$J,1,SDS(1),SDPNAM,DFN)=SDX Q
|
|---|
| 78 | I SD("SORT")=2 S ^TMP("SCRPW",$J,1,SDS(1),SDS(2),SDPNAM,DFN)=SDX Q
|
|---|
| 79 | I SD("SORT")=3 S ^TMP("SCRPW",$J,1,SDS(1),SDS(2),SDS(3),SDPNAM,DFN)=SDX Q
|
|---|
| 80 | S SDUI=$$DSV^SCRPW42(SDS(1),SDS(2),SDS(3),SDS(4))
|
|---|
| 81 | I SD("SORT")=4 S ^TMP("SCRPW",$J,1,SDS(1),SDS(2),SDS(3),SDS(4))="",^TMP("SCRPW",$J,2,SDUI,SDPNAM,DFN)=SDX Q
|
|---|
| 82 | I SD("SORT")=5 S ^TMP("SCRPW",$J,1,SDS(1),SDS(2),SDS(3),SDS(4))="",^TMP("SCRPW",$J,2,SDUI,SDS(5),SDPNAM,DFN)=SDX Q
|
|---|
| 83 | I SD("SORT")=6 S ^TMP("SCRPW",$J,1,SDS(1),SDS(2),SDS(3),SDS(4))="",^TMP("SCRPW",$J,2,SDUI,SDS(5),SDS(6),SDPNAM,DFN)=SDX
|
|---|
| 84 | Q
|
|---|
| 85 | ;
|
|---|
| 86 | SORT(SDACR) ;Return sort value
|
|---|
| 87 | ;Required input: SDACR=data element acronym
|
|---|
| 88 | N SDACT,SDX,SDOE0
|
|---|
| 89 | S SDOE0=U_DFN_U,SDACT=^TMP("SCRPW",$J,"ACT",SDACR) X $P(SDACT,T,7)
|
|---|
| 90 | S SDX=$O(SDX("")) Q $P(SDX(SDX),U,2)
|
|---|
| 91 | ;
|
|---|
| 92 | STOP ;Check for stop task request
|
|---|
| 93 | S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
|
|---|
| 94 | ;
|
|---|
| 95 | ASK1 ;Prompt for 'Means Test/Eligibility/Enrollment Report' parameters
|
|---|
| 96 | N SD,SDDIV,%DT,X,Y,DIR,SDOUT,SDNUL S (SDOUT,SDNUL,SD("SORT"))=0
|
|---|
| 97 | D TITL^SCRPW50("Means Test/Eligibility/Enrollment Report")
|
|---|
| 98 | G:'$$DIVA^SCRPW17(.SDDIV) EXIT1^SCRPW42
|
|---|
| 99 | D SUBT^SCRPW50("**** Date Range Selection ****")
|
|---|
| 100 | W ! S %DT="AEPX",%DT(0)=2961001,%DT("A")="Beginning date: " D ^%DT G:Y<1 EXIT1^SCRPW42 S SD("BDT")=Y X ^DD("DD") S $P(SD("BDT"),U,2)=Y
|
|---|
| 101 | EDT1 S %DT("A")=" Ending date: " W ! D ^%DT G:Y<1 EXIT1^SCRPW42
|
|---|
| 102 | I Y<SD("BDT") W !!,$C(7),"End date cannot be before begin date!",! G EDT1
|
|---|
| 103 | S SD("EDT")=Y_.999999 X ^DD("DD") S $P(SD("EDT"),U,2)=Y
|
|---|
| 104 | D SUBT^SCRPW50("**** Report Format Selection ****")
|
|---|
| 105 | K DIR S DIR(0)="S^D:DETAILED;S:SUMMARY",DIR("A")="Select report format",DIR("?",1)="Specify the format of report you wish to print. 'Detailed' allows the printing",DIR("?")="of patient lists, 'summary' produces totals only."
|
|---|
| 106 | S DIR("B")="SUMMARY" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT1^SCRPW42 S SD("FMT",1)=Y_U_Y(0) G:Y="S" STAT
|
|---|
| 107 | D SUBT^SCRPW50("**** Detail Category Selection ****")
|
|---|
| 108 | K DIR S DIR(0)="S^MT:MEANS TEST INDICATOR;EE:ENCOUNTER ELIGIBILITY;EP:ENROLLMENT PRIORITY",DIR("A")="Select category for detail",DIR("?")="This determines how output will be sorted."
|
|---|
| 109 | D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT1^SCRPW42 S SD("FMT",2)=Y_U_Y(0) D SCAT^SCRPW43 G:'$D(SD("FMT",3))!SDOUT EXIT1^SCRPW42
|
|---|
| 110 | S SDNUL=0 D BLD^SCRPW21 S SDX="" D SUBT^SCRPW50("**** Output Sort Selection (optional) ****") S DIR("?")="Sort elements selected will determine the order of output.",(SD("PAGE"),SD("SORT"))=0
|
|---|
| 111 | F SDI=1:1:6 S T="~",DIR("A")=$S(SDX="":"Specify data element to sort by",1:"Within "_SDX_", sort by") D ASK^SCRPW41 Q:SDOUT!SDNUL
|
|---|
| 112 | STAT ;Prompt for encounter statuses to include
|
|---|
| 113 | D SUBT^SCRPW50("**** Encounter Status Selection ****")
|
|---|
| 114 | K SD("STAT") W !!,"Choose as many of the following statuses",!,"as you wish to include in the report:",!
|
|---|
| 115 | W !?10,"CHECKED IN",!?10,"CHECKED OUT",!?10,"NO ACTION TAKEN",!?10,"INPATIENT APPOINTMENT",!?10,"NON-COUNT",!?10,"ACTION REQUIRED",! N DIC,I S DIC="^SD(409.63,",DIC(0)="AEMQ",DIC("B")="CHECKED OUT"
|
|---|
| 116 | S DIC("S")="I Y<4!(Y=8!(Y=12!(Y=14)))",DIC("A")="Select encounter status: " F I=1:1 D ^DIC Q:$D(DTOUT)!$D(DUOUT) S:Y>0 SD("STAT",$P(Y,U))=$P(Y,U,2) K DIC("B") Q:X=""&(I>1)
|
|---|
| 117 | G:'$D(SD("STAT")) EXIT1^SCRPW42 D PDIS^SCRPW43 G:SDOUT EXIT1^SCRPW42
|
|---|
| 118 | N ZTSAVE S ZTSAVE("SD(")="",ZTSAVE("SDDIV(")="",ZTSAVE("SDDIV")=""
|
|---|
| 119 | W:$P(SD("FMT",1),U)="D" !!,"This report requires 132 column output." W ! D EN^XUTMDEVQ("START^SCRPW43","Means Test/Eligibility/Enrollment Report",.ZTSAVE),DISP0^SCRPW23 G EXIT1^SCRPW42
|
|---|
