| [613] | 1 | SCRPW50 ;RENO/KEITH - ACRP Data Validation Reports ; 15 Jul 98 4:31 PM
|
|---|
| 2 | ;;5.3;Scheduling;**144,466**;AUG 13, 1993;Build 2
|
|---|
| 3 | RQUE(SDROU,SDES,SD132) ;Queue data validation reports
|
|---|
| 4 | ;Required input: SDROU=routine entry point to que
|
|---|
| 5 | ;Required input: SDES=report name
|
|---|
| 6 | ;Optional input: SD132='1' to flag for 132 column output
|
|---|
| 7 | N SD,SDDIV,ZTSAVE D TITL(SDES)
|
|---|
| 8 | G:'$$DIVA^SCRPW17(.SDDIV) EXIT S SDMD=$O(SDDIV("")),SDMD=$O(SDDIV(SDMD)) S:$P(SDDIV,U,2)="ALL DIVISIONS" SDMD=1
|
|---|
| 9 | DATE N %DT S %DT="AEPX",%DT(0)="-NOW",%DT("A")="Produce report for Fiscal Year workload through (date): " W ! D ^%DT G:Y<1 EXIT
|
|---|
| 10 | I Y<2961001 W !!,$C(7),"This date cannot be prior to OCT 1, 1996!" K Y G DATE
|
|---|
| 11 | S SD("MOD")=$E(Y,1,5)_"00",SD("EDT")=Y_.99,SD("FYD")=$E(Y,1,3)_1001 S:SD("FYD")>SD("EDT") SD("FYD")=SD("FYD")-10000 X ^DD("DD") S SD("PEDT")=Y
|
|---|
| 12 | F X="SD(","SDDIV","SDDIV(","SDMD" S ZTSAVE(X)=""
|
|---|
| 13 | I $D(SDSTA) S ZTSAVE("SDSTA")="" ;encounter status
|
|---|
| 14 | I $G(SD132) W !!,"This report requires 132 column output."
|
|---|
| 15 | W ! D EN^XUTMDEVQ(SDROU,SDES,.ZTSAVE)
|
|---|
| 16 | EXIT D END K SDMD,SD132,SDROU,SDES,SD,SDDIV,X,Y,%DT,SDX Q
|
|---|
| 17 | ;
|
|---|
| 18 | XY(X,SDI,SDZ) ;Maintain $X, $Y
|
|---|
| 19 | ;Required input: X=screen handling variable
|
|---|
| 20 | ;Optional input: SDI=1 if indirection is needed
|
|---|
| 21 | ;Optional input: SDZ=0 if $X & $Y are to be zeroed
|
|---|
| 22 | N DX,DY S DX=$X,DY=$Y S:$G(SDZ)=0 (DX,DY)=0
|
|---|
| 23 | I $G(SDI),$L(X) W @X X ^%ZOSF("XY") Q ""
|
|---|
| 24 | W X X ^%ZOSF("XY") Q ""
|
|---|
| 25 | ;
|
|---|
| 26 | TITL(SDES) ;Display report title
|
|---|
| 27 | ;Required input: SDES=report descriptive title
|
|---|
| 28 | N X,SDX
|
|---|
| 29 | D ENS^%ZISS S X=0 X ^%ZOSF("RM")
|
|---|
| 30 | I $E(IOST)'="C" W $$XY(IOF,1,0),?(IOM-$L(SDES)\2),SDES,! Q
|
|---|
| 31 | S:$L(SDES)#1 SDES=SDES_" " S IOTM=3,IOBM=IOSL,SDX="",$P(SDX," ",(80-$L(SDES)\2+1))="",SDX=SDX_SDES_SDX W $$XY(IOF,1,0),$$XY(IORVON),SDX,$$XY(IORVOFF),$$XY(IOSTBM,1),!
|
|---|
| 32 | Q
|
|---|
| 33 | ;
|
|---|
| 34 | SUBT(SDX) ;Display subtitle
|
|---|
| 35 | ;Required input: SDX=subtitle text
|
|---|
| 36 | W !!?(80-$L(SDX)\2),$$XY(IORVON),SDX,$$XY(IORVOFF) Q
|
|---|
| 37 | ;
|
|---|
| 38 | END ;Clean up
|
|---|
| 39 | N X S X=IOM X ^%ZOSF("RM") D DISP0^SCRPW23,KILL^%ZISS K ^TMP("SCRPW",$J) Q
|
|---|
| 40 | ;
|
|---|
| 41 | PROV(SDOE,SDARY) ;Create array of provider types for an encounter
|
|---|
| 42 | ;Required input: SDOE=outpatient encounter ifn
|
|---|
| 43 | ;Required input: SDARY=array to return list (pass by reference)
|
|---|
| 44 | ;Output: SDARY(providerifn)=VA code of person class
|
|---|
| 45 | K SDARY N SDAR1,SDPR,SDPRA,SDI D GETPRV^SDOE(SDOE,"SDPR")
|
|---|
| 46 | S SDI=0 F S SDI=$O(SDPR(SDI)) Q:'SDI S SDPR=$P(SDPR(SDI),U) I SDPR D
|
|---|
| 47 | .K SDAR1 D ROLE^VAFHLRO3(SDPR,"SDAR1","")
|
|---|
| 48 | .I $L($G(SDAR1(1))) S SDARY(SDPR)=SDAR1(1)
|
|---|
| 49 | .Q
|
|---|
| 50 | Q
|
|---|
