- A1B2OSR4 ;ALB/AAS - ODS SUMMARY REPORT ; 11-JAN-91
- ;;Version 1.55 (local for MAS v5 sites);;
- ;
- ; - Description of Utility Array
- ; - ^Utility($j,"ods-fac",fac)= facility indicator
- ; - ^Utility($j,"ods-adm",facility)=total admissions for facility
- ; ,"ods-adm-nat") =national count
- ; ,"ods-pt-adm",dfn,fac)="" for tracking uniques
- ; ,"ods-pt-adm-bos",bos,dfn,fac)="" Branch of Service
- ; ,"ods-pt-adm-spc",spc,dfn,fac)="" admitting specialty
- ; ,"ods-unq-adm",fac)=count unique admissions
- ; ,"ods-unq-adm-nat")=count unique adms. nationally
- ; ,"ods-unq-adm-bos",fac,bos)=unique admissions by branch of service
- ; ,"ods-unq-adm-bos-nat",bos)=national "
- ; ,"ods-unq-adm-spc",fac,spc)=unique admissions by admitting specialty
- ; ,"ods-unq-adm-spc-nat",spc)=national "
- ;
- ; ,"ods-dis",fac)=count total discharges
- ; ,"ods-dis-nat")=national totol discharges
- ; ,"ods-trf-nva",fac)= ods patients transfered to non-va care
- ; ,"ods-trf-nva-nat")= national ""
- ; ,"ods-ptrm",fac) = patients remaining
- ; ,"ods-ptrm-nat) = national patients remaining
- ; ,"ods-dis-nva",fac) = va patients displaced to non va care
- ; ,"ods-dis-nva-nat") = national ""
- ; ,"ods-dis-va",fac) = va patients displaced to va care
- ;
- % S U="^",A1B2QUIT=0 D HOME^%ZIS
- W @IOF,?28,"OPERATION DESERT SHIELD",!?26,"STATISTICAL SUMMARY REPORT",!!
- ;
- BDT ;Get beginning date of report
- S %DT="AEPX",%DT("A")="Start with DATE: " D ^%DT G END:Y<0 S A1B2BDT=Y
- ;
- EDT ;Get ending date of report
- S %DT="EX" R !,"Go to DATE: ",X:DTIME S:X=" " X=A1B2BDT G END:(X="")!(X["^") D ^%DT G BDT:Y<0 S A1B2EDT=Y I Y<A1B2BDT W *7," ??",!,"ENDING DATE must follow BEGINNING DATE." G BDT
- ;
- NSR K DIR S DIR(0)="Y",DIR("A")="Print Total Statistical Summary Only",DIR("B")="NO" D ^DIR S A1B2NSR=Y K DIR I A1B2NSR S A1B2ONE="" G DEV
- ;
- ONE R !,"Print Statistical Summary for Medical Center: ALL// ",X:DTIME S:X="" X="ALL" G ONE1:X="ALL"
- I X="?" W !!,"Enter station name or number to select a Statistical Summary Report",!,"for one Medical Center or 'ALL' to print the report for all Medical Centers.",! G ONE
- I X'="ALL" S DIC=4,DIC(0)="QEM" D ^DIC G:$D(DUOUT)!($D(DTOUT)) END G:Y<1 ONE S X=$S($D(^DIC(4,+Y,99)):+^(99),1:"") I 'X W !,"This facility has no station number - required" G ONE
- ONE1 S A1B2ONE=X
- ;
- DEV ;Get device for output.
- S %IS="QMP" D ^%ZIS G:POP END
- I $D(IO("Q")) S ZTSAVE("A1B2*")="",ZTDESC="ODS SUMMARY REPORT",ZTRTN="DQ^A1B2OSR4" D ^%ZTLOAD W !,"Request ",$S('$D(ZTSK):"not",1:"")," Queued" G:$D(ZTSK) END K ZTSK
- ;
- U IO
- ;
- DQ S CNTF=0,PAGE=0,TAB=IOM/2,A1B2QUIT=0 S Y=DT D D^DIQ S A1B2DATE=Y S:'$D(A1B2NSR) A1B2NSR=0
- D ^A1B2OSR1 I 'A1B2NSR,A1B2ONE="ALL" D ^A1B2OSR2 S A1B2NSR=1
- I A1B2NSR,'A1B2QUIT D ^A1B2OSR3 G END
- G:A1B2QUIT END
- I +A1B2ONE S FAC=A1B2ONE I '$D(^UTILITY($J,"ODS-FAC",FAC)) W !!,"No matches found for facility number ",FAC G END
- D RPRT^A1B2OSR2
- END X:$D(ZTQUEUED) ^%ZIS("C") K ZTSK,A1B2BDT,A1B2EDT,%DT,A1B2ONE
- K ^UTILITY($J)
- K A1B2DATE,A1B2NSR,A1B2QUIT,BOS,DFN,DIC,DIR,M,N,P,PAGE,SPC,T,TAB,TYPE,X,Y,X1,Y1,CNTF,FAC,I,J,A1B2X,A1B2Y,A1B2ONE,PAGE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1B2OSR4 3380 printed Mar 13, 2025@21:26:08 Page 2
- A1B2OSR4 ;ALB/AAS - ODS SUMMARY REPORT ; 11-JAN-91
- +1 ;;Version 1.55 (local for MAS v5 sites);;
- +2 ;
- +3 ; - Description of Utility Array
- +4 ; - ^Utility($j,"ods-fac",fac)= facility indicator
- +5 ; - ^Utility($j,"ods-adm",facility)=total admissions for facility
- +6 ; ,"ods-adm-nat") =national count
- +7 ; ,"ods-pt-adm",dfn,fac)="" for tracking uniques
- +8 ; ,"ods-pt-adm-bos",bos,dfn,fac)="" Branch of Service
- +9 ; ,"ods-pt-adm-spc",spc,dfn,fac)="" admitting specialty
- +10 ; ,"ods-unq-adm",fac)=count unique admissions
- +11 ; ,"ods-unq-adm-nat")=count unique adms. nationally
- +12 ; ,"ods-unq-adm-bos",fac,bos)=unique admissions by branch of service
- +13 ; ,"ods-unq-adm-bos-nat",bos)=national "
- +14 ; ,"ods-unq-adm-spc",fac,spc)=unique admissions by admitting specialty
- +15 ; ,"ods-unq-adm-spc-nat",spc)=national "
- +16 ;
- +17 ; ,"ods-dis",fac)=count total discharges
- +18 ; ,"ods-dis-nat")=national totol discharges
- +19 ; ,"ods-trf-nva",fac)= ods patients transfered to non-va care
- +20 ; ,"ods-trf-nva-nat")= national ""
- +21 ; ,"ods-ptrm",fac) = patients remaining
- +22 ; ,"ods-ptrm-nat) = national patients remaining
- +23 ; ,"ods-dis-nva",fac) = va patients displaced to non va care
- +24 ; ,"ods-dis-nva-nat") = national ""
- +25 ; ,"ods-dis-va",fac) = va patients displaced to va care
- +26 ;
- % SET U="^"
- SET A1B2QUIT=0
- DO HOME^%ZIS
- +1 WRITE @IOF,?28,"OPERATION DESERT SHIELD",!?26,"STATISTICAL SUMMARY REPORT",!!
- +2 ;
- BDT ;Get beginning date of report
- +1 SET %DT="AEPX"
- SET %DT("A")="Start with DATE: "
- DO ^%DT
- if Y<0
- GOTO END
- SET A1B2BDT=Y
- +2 ;
- EDT ;Get ending date of report
- +1 SET %DT="EX"
- READ !,"Go to DATE: ",X:DTIME
- if X=" "
- SET X=A1B2BDT
- if (X="")!(X["^")
- GOTO END
- DO ^%DT
- if Y<0
- GOTO BDT
- SET A1B2EDT=Y
- IF Y<A1B2BDT
- WRITE *7," ??",!,"ENDING DATE must follow BEGINNING DATE."
- GOTO BDT
- +2 ;
- NSR KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Print Total Statistical Summary Only"
- SET DIR("B")="NO"
- DO ^DIR
- SET A1B2NSR=Y
- KILL DIR
- IF A1B2NSR
- SET A1B2ONE=""
- GOTO DEV
- +1 ;
- ONE READ !,"Print Statistical Summary for Medical Center: ALL// ",X:DTIME
- if X=""
- SET X="ALL"
- if X="ALL"
- GOTO ONE1
- +1 IF X="?"
- WRITE !!,"Enter station name or number to select a Statistical Summary Report",!,"for one Medical Center or 'ALL' to print the report for all Medical Centers.",!
- GOTO ONE
- +2 IF X'="ALL"
- SET DIC=4
- SET DIC(0)="QEM"
- DO ^DIC
- if $DATA(DUOUT)!($DATA(DTOUT))
- GOTO END
- if Y<1
- GOTO ONE
- SET X=$SELECT($DATA(^DIC(4,+Y,99)):+^(99),1:"")
- IF 'X
- WRITE !,"This facility has no station number - required"
- GOTO ONE
- ONE1 SET A1B2ONE=X
- +1 ;
- DEV ;Get device for output.
- +1 SET %IS="QMP"
- DO ^%ZIS
- if POP
- GOTO END
- +2 IF $DATA(IO("Q"))
- SET ZTSAVE("A1B2*")=""
- SET ZTDESC="ODS SUMMARY REPORT"
- SET ZTRTN="DQ^A1B2OSR4"
- DO ^%ZTLOAD
- WRITE !,"Request ",$SELECT('$DATA(ZTSK):"not",1:"")," Queued"
- if $DATA(ZTSK)
- GOTO END
- KILL ZTSK
- +3 ;
- +4 USE IO
- +5 ;
- DQ SET CNTF=0
- SET PAGE=0
- SET TAB=IOM/2
- SET A1B2QUIT=0
- SET Y=DT
- DO D^DIQ
- SET A1B2DATE=Y
- if '$DATA(A1B2NSR)
- SET A1B2NSR=0
- +1 DO ^A1B2OSR1
- IF 'A1B2NSR
- IF A1B2ONE="ALL"
- DO ^A1B2OSR2
- SET A1B2NSR=1
- +2 IF A1B2NSR
- IF 'A1B2QUIT
- DO ^A1B2OSR3
- GOTO END
- +3 if A1B2QUIT
- GOTO END
- +4 IF +A1B2ONE
- SET FAC=A1B2ONE
- IF '$DATA(^UTILITY($JOB,"ODS-FAC",FAC))
- WRITE !!,"No matches found for facility number ",FAC
- GOTO END
- +5 DO RPRT^A1B2OSR2
- END if $DATA(ZTQUEUED)
- XECUTE ^%ZIS("C")
- KILL ZTSK,A1B2BDT,A1B2EDT,%DT,A1B2ONE
- +1 KILL ^UTILITY($JOB)
- +2 KILL A1B2DATE,A1B2NSR,A1B2QUIT,BOS,DFN,DIC,DIR,M,N,P,PAGE,SPC,T,TAB,TYPE,X,Y,X1,Y1,CNTF,FAC,I,J,A1B2X,A1B2Y,A1B2ONE,PAGE
- +3 QUIT
