[613] | 1 | SCRPW58 ;RENO/KEITH - Most Frequent 20 Practitioner Types (OP8) or (IP8); 15 Jul 98 8:28 PM
|
---|
| 2 | ;;5.3;Scheduling;**144,466**;AUG 13, 1993;Build 2
|
---|
| 3 | ;Most Frequent 20 Practitioner Types (OP8) or (IP8)
|
---|
| 4 | S SDSTA=$G(SDSTA,2)
|
---|
| 5 | D RQUE^SCRPW50("START^SCRPW58","Most Frequent 20 Practitioner Types "_$S(SDSTA=2:"(OP8)",1:"(IP8)"),1) Q
|
---|
| 6 | ;
|
---|
| 7 | START ;Print report
|
---|
| 8 | K ^TMP("SCRPW",$J) S (SDSTOP,SDOUT)=0,SDT=SD("FYD")
|
---|
| 9 | 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 S SDOE0=$$GETOE^SDOE(SDOE),SDIV=$P(SDOE0,U,11) I $$VALID() D SET(SDIV) D:SDMD SET(0)
|
---|
| 10 | G:SDOUT EXIT S (SDVCT,SDIV)=""
|
---|
| 11 | F S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:SDIV=""!SDOUT D STOP,DLIST S SDX="" F S SDX=$O(^TMP("SCRPW",$J,SDIV,0,SDX)) Q:SDX=""!SDOUT S SDI=^TMP("SCRPW",$J,SDIV,0,SDX),^TMP("SCRPW",$J,SDIV,1,SDI,SDX)=""
|
---|
| 12 | G:SDOUT EXIT S SDLINE="",$P(SDLINE,"-",(IOM+1))="" D NOW^%DTC S Y=% X ^DD("DD") S SDPNOW=$P(Y,":",1,2),SDTIT(1)="<*> MOST FREQUENT 20 PRACTITIONER TYPES "_$S(SDSTA=2:"(OP8)",1:"(IP8)")_" <*>",SDPG=0 D:$E(IOST)="C" DISP0^SCRPW23
|
---|
| 13 | I '$D(^TMP("SCRPW",$J)) S SDPAGE=1,SDX="No activity found within report parameters." D HDR G:SDOUT EXIT W !!?(IOM-$L(SDX)\2),SDX G EXIT
|
---|
| 14 | G:SDOUT EXIT S SDIVN="" F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT D DPRT(SDIV(SDIVN))
|
---|
| 15 | G:SDOUT EXIT D:SDVCT>1 DPRT(0)
|
---|
| 16 | EXIT I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
|
---|
| 17 | K ^TMP("SCRPW",$J),%,%H,%I,DIR,SD,SDARY,SDCD,SDDIV,SDI,SDII,SDIV,SDIVN,SDLINE,SDMD,SDOE,SDOE0,SDOUT,SDPAGE,SDPC,SDPG,SDPNOW,SDSPE,SDSTOP,SDSUB,SDT,SDTIT,SDV,SDVCT,SDX,X,Y,SDSTA Q
|
---|
| 18 | ;
|
---|
| 19 | DPRT(SDV) ;Print division
|
---|
| 20 | ;Required input: SDV=division ifn or '0' for combined divisions
|
---|
| 21 | I SDV S SDTIT(2)="For "_$S(SDDIV["DIVISIONS":"division",1:"facility")_": "_SDIVN
|
---|
| 22 | I 'SDV S SDTIT(2)="Report for: "_$P(SDDIV,U,2) D
|
---|
| 23 | .S SDI=2,SDIVN="" F S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN="" S SDI=SDI+1,SDTIT(SDI)=$J("Division: ",$L(SDIVN))_SDIVN
|
---|
| 24 | .Q
|
---|
| 25 | S SDPAGE=1 D HDR,HD1 Q:SDOUT S (SDI,SDII)="" F S SDI=$O(^TMP("SCRPW",$J,SDV,1,SDI),-1) Q:SDI=""!SDOUT!(SDII>19) S SDX="" F S SDX=$O(^TMP("SCRPW",$J,SDV,1,SDI,SDX)) Q:SDX=""!SDOUT!(SDII>19) D PLINE
|
---|
| 26 | Q
|
---|
| 27 | ;
|
---|
| 28 | PLINE ;Print output line
|
---|
| 29 | D:$Y>(IOSL-4) HDR,HD1 Q:SDOUT
|
---|
| 30 | S SDPC=$$CODE2TXT^XUA4A72(SDX) Q:'$L(SDPC)
|
---|
| 31 | S SDCD=+$P(SDX,"V",2),SDSPE=$P(SDPC,U,2),SDSUB=$P(SDPC,U,3),SDII=SDII+1
|
---|
| 32 | W !,$J(SDII,3,0),?6,$J(SDCD,7,0),?15,$E(SDSPE,1,51),?68,$E(SDSUB,1,52),?122,$J(SDI,10,0)
|
---|
| 33 | Q
|
---|
| 34 | ;
|
---|
| 35 | HDR ;Print header
|
---|
| 36 | I $E(IOST)="C",SDPG N DIR S DIR(0)="E" W ! D ^DIR S SDOUT=Y'=1 Q:SDOUT
|
---|
| 37 | D STOP Q:SDOUT W:SDPG!($E(IOST)="C") $$XY^SCRPW50(IOF,1,0) W:$X $$XY^SCRPW50("",0,0)
|
---|
| 38 | N SDI S SDI=0 W SDLINE F S SDI=$O(SDTIT(SDI)) Q:'SDI W !?(IOM-$L(SDTIT(SDI))\2),SDTIT(SDI)
|
---|
| 39 | W !,SDLINE,!,"For Fiscal Year activity through ",SD("PEDT"),!,"Date printed: ",SDPNOW,?(IOM-6-$L(SDPAGE)),"Page: ",SDPAGE,!,SDLINE S SDPAGE=SDPAGE+1,SDPG=1 Q
|
---|
| 40 | ;
|
---|
| 41 | HD1 ;Print subheader
|
---|
| 42 | Q:SDOUT W !,"Rank",?6,"VA Code",?15,"Specialty",?68,"Subspecialty",?123,"Frequency",!,"---- ------- ",$E(SDLINE,1,51),?68,$E(SDLINE,1,52),?122,"----------" Q
|
---|
| 43 | ;
|
---|
| 44 | DLIST ;Create alphabetic list of divisions found
|
---|
| 45 | Q:'SDIV S SDX=$P($G(^DG(40.8,SDIV,0)),U) S:'$L(SDX) SDX="*** UNKNOWN ***" S SDIV(SDX)=SDIV,SDVCT=SDVCT+1 Q
|
---|
| 46 | ;
|
---|
| 47 | VALID() ;Check encounter record
|
---|
| 48 | I $P(SDOE0,U,4),$P($G(^SC($P(SDOE0,U,4),0)),U,17)="Y" Q 0
|
---|
| 49 | I SDIV,$$DIV(),$P(SDOE0,U,2),'$P(SDOE0,U,6),$P(SDOE0,U,7),$P(SDOE0,U,12)=SDSTA Q 1
|
---|
| 50 | Q 0
|
---|
| 51 | ;
|
---|
| 52 | DIV() ;Check division
|
---|
| 53 | Q:'SDDIV 1 Q $D(SDDIV(SDIV))
|
---|
| 54 | ;
|
---|
| 55 | STOP ;Check for stop task request
|
---|
| 56 | S:$D(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
|
---|
| 57 | ;
|
---|
| 58 | SET(SDIV) ;Set division lists
|
---|
| 59 | ;Required input: SDIV=division ifn or '0' for summary
|
---|
| 60 | S SDSTOP=SDSTOP+1 I SDSTOP#2000=0 D STOP^SCRPW40 Q:SDOUT
|
---|
| 61 | N SDARY,SDI,SDX
|
---|
| 62 | D PROV^SCRPW50(SDOE,.SDARY)
|
---|
| 63 | S SDI=0 F S SDI=$O(SDARY(SDI)) Q:'SDI S SDX=SDARY(SDI) I $L(SDX) D
|
---|
| 64 | .S ^TMP("SCRPW",$J,SDIV,0,SDX)=$G(^TMP("SCRPW",$J,SDIV,0,SDX))+1
|
---|
| 65 | .Q
|
---|
| 66 | Q
|
---|