- SCRPW50 ;RENO/KEITH - ACRP Data Validation Reports ; 15 Jul 98 4:31 PM
- ;;5.3;Scheduling;**144,466,1015**;AUG 13, 1993;Build 21
- RQUE(SDROU,SDES,SD132) ;Queue data validation reports
- ;Required input: SDROU=routine entry point to que
- ;Required input: SDES=report name
- ;Optional input: SD132='1' to flag for 132 column output
- N SD,SDDIV,ZTSAVE D TITL(SDES)
- G:'$$DIVA^SCRPW17(.SDDIV) EXIT S SDMD=$O(SDDIV("")),SDMD=$O(SDDIV(SDMD)) S:$P(SDDIV,U,2)="ALL DIVISIONS" SDMD=1
- 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
- I Y<2961001 W !!,$C(7),"This date cannot be prior to OCT 1, 1996!" K Y G DATE
- 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
- F X="SD(","SDDIV","SDDIV(","SDMD" S ZTSAVE(X)=""
- I $D(SDSTA) S ZTSAVE("SDSTA")="" ;encounter status
- I $G(SD132) W !!,"This report requires 132 column output."
- W ! D EN^XUTMDEVQ(SDROU,SDES,.ZTSAVE)
- EXIT D END K SDMD,SD132,SDROU,SDES,SD,SDDIV,X,Y,%DT,SDX Q
- ;
- XY(X,SDI,SDZ) ;Maintain $X, $Y
- ;Required input: X=screen handling variable
- ;Optional input: SDI=1 if indirection is needed
- ;Optional input: SDZ=0 if $X & $Y are to be zeroed
- N DX,DY S DX=$X,DY=$Y S:$G(SDZ)=0 (DX,DY)=0
- I $G(SDI),$L(X) W @X X ^%ZOSF("XY") Q ""
- W X X ^%ZOSF("XY") Q ""
- ;
- TITL(SDES) ;Display report title
- ;Required input: SDES=report descriptive title
- N X,SDX
- D ENS^%ZISS S X=0 X ^%ZOSF("RM")
- I $E(IOST)'="C" W $$XY(IOF,1,0),?(IOM-$L(SDES)\2),SDES,! Q
- 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),!
- Q
- ;
- SUBT(SDX) ;Display subtitle
- ;Required input: SDX=subtitle text
- W !!?(80-$L(SDX)\2),$$XY(IORVON),SDX,$$XY(IORVOFF) Q
- ;
- END ;Clean up
- N X S X=IOM X ^%ZOSF("RM") D DISP0^SCRPW23,KILL^%ZISS K ^TMP("SCRPW",$J) Q
- ;
- PROV(SDOE,SDARY) ;Create array of provider types for an encounter
- ;Required input: SDOE=outpatient encounter ifn
- ;Required input: SDARY=array to return list (pass by reference)
- ;Output: SDARY(providerifn)=VA code of person class
- K SDARY N SDAR1,SDPR,SDPRA,SDI D GETPRV^SDOE(SDOE,"SDPR")
- S SDI=0 F S SDI=$O(SDPR(SDI)) Q:'SDI S SDPR=$P(SDPR(SDI),U) I SDPR D
- .K SDAR1 D ROLE^VAFHLRO3(SDPR,"SDAR1","")
- .I $L($G(SDAR1(1))) S SDARY(SDPR)=SDAR1(1)
- .Q
- Q
- SCRPW50 ;RENO/KEITH - ACRP Data Validation Reports ; 15 Jul 98 4:31 PM
- +1 ;;5.3;Scheduling;**144,466,1015**;AUG 13, 1993;Build 21
- RQUE(SDROU,SDES,SD132) ;Queue data validation reports
- +1 ;Required input: SDROU=routine entry point to que
- +2 ;Required input: SDES=report name
- +3 ;Optional input: SD132='1' to flag for 132 column output
- +4 NEW SD,SDDIV,ZTSAVE
- DO TITL(SDES)
- +5 IF '$$DIVA^SCRPW17(.SDDIV)
- GOTO EXIT
- SET SDMD=$ORDER(SDDIV(""))
- SET SDMD=$ORDER(SDDIV(SDMD))
- IF $PIECE(SDDIV,U,2)="ALL DIVISIONS"
- SET SDMD=1
- DATE NEW %DT
- SET %DT="AEPX"
- SET %DT(0)="-NOW"
- SET %DT("A")="Produce report for Fiscal Year workload through (date): "
- WRITE !
- DO ^%DT
- IF Y<1
- GOTO EXIT
- +1 IF Y<2961001
- WRITE !!,$CHAR(7),"This date cannot be prior to OCT 1, 1996!"
- KILL Y
- GOTO DATE
- +2 SET SD("MOD")=$EXTRACT(Y,1,5)_"00"
- SET SD("EDT")=Y_.99
- SET SD("FYD")=$EXTRACT(Y,1,3)_1001
- IF SD("FYD")>SD("EDT")
- SET SD("FYD")=SD("FYD")-10000
- XECUTE ^DD("DD")
- SET SD("PEDT")=Y
- +3 FOR X="SD(","SDDIV","SDDIV(","SDMD"
- SET ZTSAVE(X)=""
- +4 ;encounter status
- IF $DATA(SDSTA)
- SET ZTSAVE("SDSTA")=""
- +5 IF $GET(SD132)
- WRITE !!,"This report requires 132 column output."
- +6 WRITE !
- DO EN^XUTMDEVQ(SDROU,SDES,.ZTSAVE)
- EXIT DO END
- KILL SDMD,SD132,SDROU,SDES,SD,SDDIV,X,Y,%DT,SDX
- QUIT
- +1 ;
- XY(X,SDI,SDZ) ;Maintain $X, $Y
- +1 ;Required input: X=screen handling variable
- +2 ;Optional input: SDI=1 if indirection is needed
- +3 ;Optional input: SDZ=0 if $X & $Y are to be zeroed
- +4 NEW DX,DY
- SET DX=$X
- SET DY=$Y
- IF $GET(SDZ)=0
- SET (DX,DY)=0
- +5 IF $GET(SDI)
- IF $LENGTH(X)
- WRITE @X
- XECUTE ^%ZOSF("XY")
- QUIT ""
- +6 WRITE X
- XECUTE ^%ZOSF("XY")
- QUIT ""
- +7 ;
- TITL(SDES) ;Display report title
- +1 ;Required input: SDES=report descriptive title
- +2 NEW X,SDX
- +3 DO ENS^%ZISS
- SET X=0
- XECUTE ^%ZOSF("RM")
- +4 IF $EXTRACT(IOST)'="C"
- WRITE $$XY(IOF,1,0),?(IOM-$LENGTH(SDES)\2),SDES,!
- QUIT
- +5 IF $LENGTH(SDES)#1
- SET SDES=SDES_" "
- SET IOTM=3
- SET IOBM=IOSL
- SET SDX=""
- SET $PIECE(SDX," ",(80-$LENGTH(SDES)\2+1))=""
- SET SDX=SDX_SDES_SDX
- WRITE $$XY(IOF,1,0),$$XY(IORVON),SDX,$$XY(IORVOFF),$$XY(IOSTBM,1),!
- +6 QUIT
- +7 ;
- SUBT(SDX) ;Display subtitle
- +1 ;Required input: SDX=subtitle text
- +2 WRITE !!?(80-$LENGTH(SDX)\2),$$XY(IORVON),SDX,$$XY(IORVOFF)
- QUIT
- +3 ;
- END ;Clean up
- +1 NEW X
- SET X=IOM
- XECUTE ^%ZOSF("RM")
- DO DISP0^SCRPW23
- DO KILL^%ZISS
- KILL ^TMP("SCRPW",$JOB)
- QUIT
- +2 ;
- PROV(SDOE,SDARY) ;Create array of provider types for an encounter
- +1 ;Required input: SDOE=outpatient encounter ifn
- +2 ;Required input: SDARY=array to return list (pass by reference)
- +3 ;Output: SDARY(providerifn)=VA code of person class
- +4 KILL SDARY
- NEW SDAR1,SDPR,SDPRA,SDI
- DO GETPRV^SDOE(SDOE,"SDPR")
- +5 SET SDI=0
- FOR
- SET SDI=$ORDER(SDPR(SDI))
- IF 'SDI
- QUIT
- SET SDPR=$PIECE(SDPR(SDI),U)
- IF SDPR
- Begin DoDot:1
- +6 KILL SDAR1
- DO ROLE^VAFHLRO3(SDPR,"SDAR1","")
- +7 IF $LENGTH($GET(SDAR1(1)))
- SET SDARY(SDPR)=SDAR1(1)
- +8 QUIT
- End DoDot:1
- +9 QUIT
