source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPW50.m@ 1141

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

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1SCRPW50 ;RENO/KEITH - ACRP Data Validation Reports ; 15 Jul 98 4:31 PM
2 ;;5.3;Scheduling;**144,466**;AUG 13, 1993;Build 2
3RQUE(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
9DATE 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)
16EXIT D END K SDMD,SD132,SDROU,SDES,SD,SDDIV,X,Y,%DT,SDX Q
17 ;
18XY(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 ;
26TITL(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 ;
34SUBT(SDX) ;Display subtitle
35 ;Required input: SDX=subtitle text
36 W !!?(80-$L(SDX)\2),$$XY(IORVON),SDX,$$XY(IORVOFF) Q
37 ;
38END ;Clean up
39 N X S X=IOM X ^%ZOSF("RM") D DISP0^SCRPW23,KILL^%ZISS K ^TMP("SCRPW",$J) Q
40 ;
41PROV(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
Note: See TracBrowser for help on using the repository browser.