source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCRPW14.m@ 1446

Last change on this file since 1446 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.0 KB
Line 
1SCRPW14 ;RENO/KEITH - Encounter Activity Report ;06/10/99
2 ;;5.3;Scheduling;**139,144,180**;AUG 13, 1993
3 ;06/10/99 ACS Added cpt modifiers to the report
4 ;
5 N DIC,DIR,DTOUT,DUOUT,X,Y,SD,ZTSAVE,%DT,SDDIV,SDI
6 D TITL^SCRPW50("Encounter Activity Report") G:'$$DIVA^SCRPW17(.SDDIV) EXIT
7 D SUBT^SCRPW50("*** Date Range Selection ***")
8FDT W ! S %DT="AEPX",%DT("A")="Beginning date: ",%DT(0)="-TODAY" D ^%DT G:X=U!$D(DTOUT)!(X="") EXIT
9 G:Y<1 FDT S SD("BDT")=Y X ^DD("DD") S SD("PBDT")=Y W !
10LDT S %DT("A")="Ending date: " D ^%DT G:X=U!$D(DTOUT)!(X="") EXIT
11 I Y<SD("BDT") W !!,$C(7),"Ending date must be after beginning date!",! G LDT
12 G:Y<1 LDT S SD("EDT")=Y X ^DD("DD") S SD("PEDT")=Y,SD("EDT")=SD("EDT")_".999999"
13CATE D SUBT^SCRPW50("*** Report Category Selection ***")
14 W ! S DIR(0)="S^C:CLINIC;P:PROVIDER;S:STOP CODE",DIR("A")="Select category for report output" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SD("CAT")=Y D STAT G:'$D(SD("STAT")) EXIT
15 D SUBT^SCRPW50("*** Report Format Selection ***")
16 W ! S DIR(0)="S^D:DETAILED;S:SUMMARY",DIR("A")="Select report format",DIR("B")="SUMMARY" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SD("FMT")=Y
17 I SD("FMT")="S" W ! S DIR(0)="S^A:ALPHABETIC;E:ENCOUNTER TOTALS;V:VISIT TOTALS;U:UNIQUE TOTALS",DIR("A")="Select report order",DIR("B")="ALPHABETIC" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT S SD("ORD")=Y G QUE
18 S SD("ORD")="A" D LIST(SD("CAT")) G:'$D(SD("LIST")) EXIT
19QUE D SUBT^SCRPW50("*** Selected Report Parameters ***")
20 W !!,"You have selected the following report parameters:",! D PVIEW^SCRPW15(0)
21 W ! K DIR S DIR(0)="Y",DIR("A")="OK",DIR("B")="YES" D ^DIR G:$D(DTOUT)!$D(DUOUT) EXIT G:'Y EXIT
22 F SDI="SDDIV","SDDIV(","SD(","SDL(" S ZTSAVE(SDI)=""
23 W ! D EN^XUTMDEVQ("RPT^SCRPW14","OPT. ACTIVITY REPORT",.ZTSAVE)
24 ;
25EXIT D END^SCRPW50 Q
26 ;
27STAT ;Prompt for encounter statuses to include
28 D SUBT^SCRPW50("*** Encounter Status Selection ***")
29 K SD("STAT") W !!,"Choose as many of the following statuses",!,"as you wish to include in the report:",!
30 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"
31 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))="" K DIC("B") Q:X=""&(I>1)
32 Q
33 ;
34LIST(X) ;Get list for detail
35 ;Output: SD("LIST",ifn)=name
36 W ! N DIC S DIC=$S(X="C":"^SC(",X="P":"^VA(200,",1:"^DIC(40.7,"),DIC(0)="AEMQ" S:X="S" DIC("S")="I $L($P(^(0),U,2))=3"
37 F D ^DIC Q:$D(DTOUT)!$D(DUOUT)!(X="") S:Y>0 SD("LIST",$P(Y,U))=$P(Y,U,2)
38 W ! Q
39 ;
40RPT ;Print report
41 N %,X,Y,SDQ,SDTIT,SDI,DFN,SDIVN,SDMD,SDOUT,SDSTOP,SDX
42 N SDCH,SDCH0,SDCL,SDCOL,SDD,SDD0,SDDET,SDDT,SDFFS,SDLINE,SDN,SDOE,SDOE0,SDOED,SDOED0,SDP,SDPI,SDP0,SDPAGE,SDPG,SDPNOW,SDPR,SDPT,SDR,SDS,SDSC,SDSV,SDT,SDT1,SDT2,SDTOT,SDTOT1,SDTOT2,SDUN,SDVP,SDVP0,SDVS,SDLIST,SDRPVS,SDRPUN,SDRPEN
43 K ^TMP("SCRPW",$J) S (SDOUT,SDSTOP)=0,SDMD=$O(SDDIV("")),SDMD=$O(SDDIV(SDMD)) S:$P(SDDIV,U,2)="ALL DIVISIONS" SDMD=1
44 S SDDT=SD("BDT") F S SDDT=$O(^SCE("B",SDDT)) Q:'SDDT!(SDDT>SD("EDT"))!SDOUT S SDOE=0 F S SDOE=$O(^SCE("B",SDDT,SDOE)) Q:'SDOE!SDOUT S SDOE0=$$GETOE^SDOE(SDOE) I $L(SDOE0) S SDIV=$P(SDOE0,U,11) D:SDIV EVAL
45 G:SDOUT EXIT G ^SCRPW15
46 ;
47STOP ;Check for stop task request
48 S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
49 ;
50EVAL ;Evaluate encounter
51 S SDSTOP=SDSTOP+1 I SDSTOP#3000=0 D STOP Q:SDOUT
52 I '$P(SDOE0,U,6),$$DIV(SDIV),$D(SD("STAT",+$P(SDOE0,U,12))) K SDS I $$CAT(.SDS) D SRT(SDIV) D:SDMD SRT(0) S SDS=0 F S SDS=$O(SDS(SDS)) Q:'SDS D SET
53 Q
54 ;
55DIV(SDIV) ;Evaluate division
56 Q:'SDDIV 1 Q $D(SDDIV(SDIV))
57 ;
58SRT(SDIV) ;Set report total for summary format
59 Q:SD("FMT")="D" S SDRPEN(SDIV)=$G(SDRPEN(SDIV))+1,^TMP("SCRPW",$J,SDIV,"RPT","PT",+$P(SDOE0,U,2),+$P(SDDT,"."))="" Q
60 ;
61SET ;Set global for a division
62 D SET1(SDIV) D:SDMD SET1(0) Q:SD("FMT")="S"
63 K SDLIST D GETDX^SDOE(SDOE,"SDLIST")
64 S SDOED=0 F S SDOED=$O(SDLIST(SDOED)) Q:'SDOED S SDOED0=SDLIST(SDOED) D:$L(SDOED0) DSET(SDIV) D:SDMD DSET(0)
65 K SDLIST D GETCPT^SDOE(SDOE,"SDLIST")
66 S SDVP=0 F S SDVP=$O(SDLIST(SDVP)) Q:'SDVP S SDVP0=SDLIST(SDVP) I $L(SDVP0) D PSET(SDIV) D:SDMD PSET(0)
67 Q
68 ;
69SET1(SDIV) S ^TMP("SCRPW",$J,SDIV,1,SDS,"ENC")=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"ENC"))+1,^TMP("SCRPW",$J,SDIV,1,SDS,"PT",+$P(SDOE0,U,2),+$P(SDDT,"."))=""
70 Q
71 ;
72DSET(SDIV) S SDD=+$P(SDOED0,U),SDR=$S($P(SDOED0,U,12)="P":"PRI",1:"SEC"),^TMP("SCRPW",$J,SDIV,1,SDS,"DX",SDD,SDR)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"DX",SDD,SDR))+1 Q
73 ;
74PSET(SDIV) ;
75 I SD("CAT")="P",'$$OLD^SDOEUT(SDOE) S SDPR=$P($G(^AUPNVCPT(SDVP,12)),U,4) Q:'$D(SD("LIST",+SDPR))
76 ;S SDP=+$P(SDVP0,U),SDQ=$P(SDVP0,U,16) S:'SDQ SDQ=1 S ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP))+SDQ Q
77 ;SDP=procedure pointer, SDQ=procedure quantity
78 S SDP=+$P(SDVP0,U)
79 S SDQ=$P(SDVP0,U,16)
80 S:'SDQ SDQ=1
81 ; add quantity to total quantity for current procedure
82 S ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP))+SDQ
83 ;
84 ;Loop through modifiers and add to ^TMP array
85 N SDMODN,SDMOD
86 S SDMODN=0
87 F S SDMODN=+$O(SDLIST(SDVP,1,SDMODN)) Q:'SDMODN D
88 .S SDMOD=$P(SDLIST(SDVP,1,SDMODN,0),"^")
89 .;add modifier quantity to array
90 .S:SDMOD ^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP,SDMOD)=$G(^TMP("SCRPW",$J,SDIV,1,SDS,"PROC",SDP,SDMOD))+SDQ
91 Q
92 ;
93CAT(SDS) ;Determine if encounter fits category
94 ;Required input: SDS array to return list
95 ;Output: SDS(ifn) array=list of category ifns to tally
96 I SD("CAT")="C" S SDCL=$P(SDOE0,U,4) Q:SDCL<1 0 S:SD("FMT")="S"!$D(SD("LIST",+SDCL)) SDS(SDCL)="" Q $D(SDS)
97 I SD("CAT")="P" D CATP Q $D(SDS)
98 I SD("CAT")="S" D CATS Q $D(SDS)
99 Q 0
100 ;
101CATP ;Get providers
102 K SDLIST D GETPRV^SDOE(SDOE,"SDLIST")
103 S SDPI=0 F S SDPI=$O(SDLIST(SDPI)) Q:'SDPI S SDP=$P(SDLIST(SDPI),U) S:SD("FMT")="S"!$D(SD("LIST",SDP)) SDS(SDP)=""
104 Q
105 ;
106CATS ;Get stop codes
107 S SDSC=+$P(SDOE0,U,3) S:SD("FMT")="S"!$D(SD("LIST",SDSC)) SDS(SDSC)=""
108 S SDCH=0 F S SDCH=$O(^SCE("APAR",SDOE,SDCH)) Q:'SDCH S SDCH0=$$GETOE^SDOE(SDCH) I $P(SDCH0,U,8)=4 S SDSC=+$P(SDCH0,U,3) S:SD("FMT")="S"!$D(SD("LIST",SDSC)) SDS(SDSC)=""
109 Q
Note: See TracBrowser for help on using the repository browser.