- ECTSNP ;B'ham ISC/PTD-Inpatient Workload Trends by Fiscal Year ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
- I '$D(^ECT(731)) W *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'VAMC Management' File - #731 is not loaded on your system.",!! S XQUIT="" Q
- I '$O(^ECT(731,0)) W *7,!!,"'VAMC Management' File - #731 has not been populated on your system.",!! S XQUIT="" Q
- W !,"You may select the fiscal year RANGE for this report.",!,"(Up to 5 years of data may be displayed.)",!!,"Enter ONLY the 2 or 4 digit year!",!
- BYR S %DT="AE",%DT("A")="Enter BEGINNING fiscal year: ",%DT(0)=2700000 D ^%DT K %DT G:$D(DTOUT)!("^"[X) EXIT S BYRDA=$E(Y,1,3),BYR=$E(Y,2,3)
- EYR S %DT="AE",%DT("A")="Enter ENDING fiscal year: ",%DT(0)=BYRDA_"0000" D ^%DT K %DT G:$D(DTOUT)!("^"[X) EXIT S EYRDA=$E(Y,1,3),EYR=$E(Y,2,3)
- I EYRDA-BYRDA>4 W *7,!!,"Only a 5 year range may be shown on one report!",!! K BYRDA,BYR,EYRDA,EYR,X,Y G BYR
- S FLG=0 F YR=BYRDA:1:EYRDA I $D(^ECT(731,YR,30,0)) S FLG=1
- I FLG=0 W *7,!!,"There is NO DATA in the file for the selected date range!",!! G EXIT
- DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G EXIT
- I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^ECTSNP",ZTDESC="Inpatient Workload Trends by Fiscal Year",ZTSAVE("BYRDA")="",ZTSAVE("EYRDA")=""
- I D ^%ZTLOAD K ZTSK G EXIT
- U IO
- ;
- ENQ ;ENTRY POINT WHEN QUEUED
- K ^TMP($J) S CNT=0 F YR=BYRDA:1:EYRDA S INP=0,CNT=CNT+1,(TOT(YR),TAF(YR))=0 F J=0:0 S INP=$O(^ECT(731,YR,30,INP)) Q:'INP S LCN=$P(^ECT(731,YR,30,INP,0),"^"),DSCH=$P(^(0),"^",3),^TMP($J,LCN,YR)=DSCH,TAF(YR)=$P(^ECT(731,YR,0),"^",2)
- S PGCT=1,(INP,QFLG)="",$P(LN,"-",81)="" D HDR
- LCN F K=0:0 S INP=$O(^TMP($J,INP)) Q:INP="" D WRTLN G:QFLG EXIT
- WRTOT W !?34 F J=1:1:46 W "-"
- W !?12,"TOTAL DISCHARGES:" S CT=0,INCR=9,COL=25 F YEAR=BYRDA:1:EYRDA S CT=CT+1,COL=COL+INCR S TOT=$P(TOT(YEAR),"^") W:CT'>CNT ?COL,$S(TOT=0:" NO DATA",1:$J(TOT,7))
- WRTAF W !!?9,"TOTAL ASSIGNED FTEE:" S CT=0,INCR=9,COL=25 F YEAR=BYRDA:1:EYRDA S CT=CT+1,COL=COL+INCR S TAF=$P(TAF(YEAR),"^") W:CT'>CNT ?COL,$S(TAF=0:"NO DATA",1:$J(TAF,8,3))
- ;
- EXIT K ^TMP($J),%,%H,%I,BYR,BYRDA,CNT,COL,CT,DTOUT,DIR,DSCH,EYR,EYRDA,FLG,INCR,INP,J,K,LCN,LN,PGCT,POP,QFLG,TAF,TOT,X,Y,YEAR,YR,ZTDESC,ZTRTN,ZTSAVE,ZTSK
- D ^%ZISC I IO="" S IOP="HOME" D ^%ZIS
- Q
- ;
- HDR ;PRINT REPORT MAIN HEADER
- W @IOF,!?25,"VAMC INPATIENT WORKLOAD TRENDS",!?22,"DISCHARGES FROM FY: "_(1700+BYRDA)_" TO FY: "_(1700+EYRDA) D NOW^%DTC S Y=$E(%,1,12) X ^DD("DD") W !!?45,Y,?70,"PAGE ",PGCT S PGCT=PGCT+1
- W !!?10,"LOCATION" S CT=0,INCR=9,COL=27 F YR=BYRDA:1:EYRDA S CT=CT+1,COL=COL+INCR W:CT'>CNT ?COL,"FY "_$E(((BYRDA-1)+CT),2,3)
- W !,LN
- Q
- ;
- WRTLN D:$Y+5>IOSL PRTCHK Q:QFLG W !,INP S CT=0,INCR=9,COL=26
- F YEAR=BYRDA:1:EYRDA S CT=CT+1,COL=COL+INCR D DSCH S TOT(YEAR)=TOT(YEAR)+DSCH W:CT'>CNT ?COL,$S(DSCH="":"NO DATA",1:$J(DSCH,6))
- Q
- ;
- DSCH I '$D(^TMP($J,INP,YEAR)) S DSCH="" Q
- S DSCH=$P(^TMP($J,INP,YEAR),"^")
- Q
- ;
- PRTCHK I $E(IOST)="C" S DIR(0)="E" D ^DIR I Y=0 S QFLG=1 Q
- D HDR
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECTSNP 3037 printed Mar 13, 2025@21:07:43 Page 2
- ECTSNP ;B'ham ISC/PTD-Inpatient Workload Trends by Fiscal Year ;01/29/91 08:00
- V ;;1.05;INTERIM MANAGEMENT SUPPORT;;
- +1 IF '$DATA(^ECT(731))
- WRITE *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'VAMC Management' File - #731 is not loaded on your system.",!!
- SET XQUIT=""
- QUIT
- +2 IF '$ORDER(^ECT(731,0))
- WRITE *7,!!,"'VAMC Management' File - #731 has not been populated on your system.",!!
- SET XQUIT=""
- QUIT
- +3 WRITE !,"You may select the fiscal year RANGE for this report.",!,"(Up to 5 years of data may be displayed.)",!!,"Enter ONLY the 2 or 4 digit year!",!
- BYR SET %DT="AE"
- SET %DT("A")="Enter BEGINNING fiscal year: "
- SET %DT(0)=2700000
- DO ^%DT
- KILL %DT
- if $DATA(DTOUT)!("^"[X)
- GOTO EXIT
- SET BYRDA=$EXTRACT(Y,1,3)
- SET BYR=$EXTRACT(Y,2,3)
- EYR SET %DT="AE"
- SET %DT("A")="Enter ENDING fiscal year: "
- SET %DT(0)=BYRDA_"0000"
- DO ^%DT
- KILL %DT
- if $DATA(DTOUT)!("^"[X)
- GOTO EXIT
- SET EYRDA=$EXTRACT(Y,1,3)
- SET EYR=$EXTRACT(Y,2,3)
- +1 IF EYRDA-BYRDA>4
- WRITE *7,!!,"Only a 5 year range may be shown on one report!",!!
- KILL BYRDA,BYR,EYRDA,EYR,X,Y
- GOTO BYR
- +2 SET FLG=0
- FOR YR=BYRDA:1:EYRDA
- IF $DATA(^ECT(731,YR,30,0))
- SET FLG=1
- +3 IF FLG=0
- WRITE *7,!!,"There is NO DATA in the file for the selected date range!",!!
- GOTO EXIT
- DEV KILL %ZIS,IOP
- SET %ZIS="QM"
- SET %ZIS("B")=""
- DO ^%ZIS
- IF POP
- WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED!"
- GOTO EXIT
- +1 IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTRTN="ENQ^ECTSNP"
- SET ZTDESC="Inpatient Workload Trends by Fiscal Year"
- SET ZTSAVE("BYRDA")=""
- SET ZTSAVE("EYRDA")=""
- +2 IF $TEST
- DO ^%ZTLOAD
- KILL ZTSK
- GOTO EXIT
- +3 USE IO
- +4 ;
- ENQ ;ENTRY POINT WHEN QUEUED
- +1 KILL ^TMP($JOB)
- SET CNT=0
- FOR YR=BYRDA:1:EYRDA
- SET INP=0
- SET CNT=CNT+1
- SET (TOT(YR),TAF(YR))=0
- FOR J=0:0
- SET INP=$ORDER(^ECT(731,YR,30,INP))
- if 'INP
- QUIT
- SET LCN=$PIECE(^ECT(731,YR,30,INP,0),"^")
- SET DSCH=$PIECE(^(0),"^",3)
- SET ^TMP($JOB,LCN,YR)=DSCH
- SET TAF(YR)=$PIECE(^ECT(731,YR,0),"^",2)
- +2 SET PGCT=1
- SET (INP,QFLG)=""
- SET $PIECE(LN,"-",81)=""
- DO HDR
- LCN FOR K=0:0
- SET INP=$ORDER(^TMP($JOB,INP))
- if INP=""
- QUIT
- DO WRTLN
- if QFLG
- GOTO EXIT
- WRTOT WRITE !?34
- FOR J=1:1:46
- WRITE "-"
- +1 WRITE !?12,"TOTAL DISCHARGES:"
- SET CT=0
- SET INCR=9
- SET COL=25
- FOR YEAR=BYRDA:1:EYRDA
- SET CT=CT+1
- SET COL=COL+INCR
- SET TOT=$PIECE(TOT(YEAR),"^")
- if CT'>CNT
- WRITE ?COL,$SELECT(TOT=0:" NO DATA",1:$JUSTIFY(TOT,7))
- WRTAF WRITE !!?9,"TOTAL ASSIGNED FTEE:"
- SET CT=0
- SET INCR=9
- SET COL=25
- FOR YEAR=BYRDA:1:EYRDA
- SET CT=CT+1
- SET COL=COL+INCR
- SET TAF=$PIECE(TAF(YEAR),"^")
- if CT'>CNT
- WRITE ?COL,$SELECT(TAF=0:"NO DATA",1:$JUSTIFY(TAF,8,3))
- +1 ;
- EXIT KILL ^TMP($JOB),%,%H,%I,BYR,BYRDA,CNT,COL,CT,DTOUT,DIR,DSCH,EYR,EYRDA,FLG,INCR,INP,J,K,LCN,LN,PGCT,POP,QFLG,TAF,TOT,X,Y,YEAR,YR,ZTDESC,ZTRTN,ZTSAVE,ZTSK
- +1 DO ^%ZISC
- IF IO=""
- SET IOP="HOME"
- DO ^%ZIS
- +2 QUIT
- +3 ;
- HDR ;PRINT REPORT MAIN HEADER
- +1 WRITE @IOF,!?25,"VAMC INPATIENT WORKLOAD TRENDS",!?22,"DISCHARGES FROM FY: "_(1700+BYRDA)_" TO FY: "_(1700+EYRDA)
- DO NOW^%DTC
- SET Y=$EXTRACT(%,1,12)
- XECUTE ^DD("DD")
- WRITE !!?45,Y,?70,"PAGE ",PGCT
- SET PGCT=PGCT+1
- +2 WRITE !!?10,"LOCATION"
- SET CT=0
- SET INCR=9
- SET COL=27
- FOR YR=BYRDA:1:EYRDA
- SET CT=CT+1
- SET COL=COL+INCR
- if CT'>CNT
- WRITE ?COL,"FY "_$EXTRACT(((BYRDA-1)+CT),2,3)
- +3 WRITE !,LN
- +4 QUIT
- +5 ;
- WRTLN if $Y+5>IOSL
- DO PRTCHK
- if QFLG
- QUIT
- WRITE !,INP
- SET CT=0
- SET INCR=9
- SET COL=26
- +1 FOR YEAR=BYRDA:1:EYRDA
- SET CT=CT+1
- SET COL=COL+INCR
- DO DSCH
- SET TOT(YEAR)=TOT(YEAR)+DSCH
- if CT'>CNT
- WRITE ?COL,$SELECT(DSCH="":"NO DATA",1:$JUSTIFY(DSCH,6))
- +2 QUIT
- +3 ;
- DSCH IF '$DATA(^TMP($JOB,INP,YEAR))
- SET DSCH=""
- QUIT
- +1 SET DSCH=$PIECE(^TMP($JOB,INP,YEAR),"^")
- +2 QUIT
- +3 ;
- PRTCHK IF $EXTRACT(IOST)="C"
- SET DIR(0)="E"
- DO ^DIR
- IF Y=0
- SET QFLG=1
- QUIT
- +1 DO HDR
- +2 QUIT
- +3 ;
