- A1B2OSR2 ;ALB/AAS - PRINT ODS SUMMARY REPORT ; 11-JAN-91
- ;;Version 1.55 (local for MAS v5 sites);;
- ;
- % S CNTF=0,PAGE=0,TAB=IOM/2,A1B2QUIT=0 S Y=DT D D^DIQ S A1B2DATE=Y
- I '$D(^UTILITY($J)) W !,"No Matches Found"
- I 'A1B2NSR S FAC="" F I=0:0 S FAC=$O(^UTILITY($J,"ODS-FAC",FAC)) Q:FAC=""!(A1B2QUIT) S CNTF=CNTF+1 D RPRT,PAUSE:'A1B2QUIT Q:A1B2QUIT
- ;I 'A1B2QUIT S A1B2NSR=1 D ^A1B2OSR3
- G END
- Q
- ;
- PAUSE I $E(IOST,1,2)["C-" S DIR(0)="E" D ^DIR S A1B2QUIT='Y
- Q
- LINE ; --write line in report
- I ($Y+6)>IOSL S A1B2X=X,A1B2Y=Y D PAUSE Q:A1B2QUIT D HDR S X=A1B2X,Y=A1B2Y
- W !?(TAB-$L(X)),X,": ",Y Q
- ;
- RPRT ; --write report
- D HDR W !
- S X="Total Admissions",Y=$S($D(^UTILITY($J,"ODS-ADM",FAC)):^(FAC),1:0) D LINE Q:A1B2QUIT
- S X="Total Discharges",Y=$S($D(^UTILITY($J,"ODS-DIS",FAC)):^(FAC),1:0) D LINE Q:A1B2QUIT
- S X="Patients Treated",Y=Y+$S($D(^UTILITY($J,"ODS-PTRM",FAC)):^(FAC),1:0) D LINE Q:A1B2QUIT
- S X="No. Unique Patients Admitted",Y=$S($D(^UTILITY($J,"ODS-UNQ-ADM",FAC)):^(FAC),1:0) D LINE Q:A1B2QUIT
- I $D(^UTILITY($J,"ODS-UNQA-SPC",FAC)) W ! S X="No. Pts. Admitted to",Y="" D LINE Q:A1B2QUIT D SPC Q:A1B2QUIT
- I $D(^UTILITY($J,"ODS-UNQA-BOS",FAC)) W ! S X="No. Pts. Admitted from",Y="" D LINE Q:A1B2QUIT D BOS Q:A1B2QUIT
- W ! S X="No. ODS pts. to Non-VA Care",Y=$S($D(^UTILITY($J,"ODS-TRF-NVA",FAC)):^(FAC),1:0) D LINE Q:A1B2QUIT
- S X="No. Vets Displaced to Non-VA Care",Y=$S($D(^UTILITY($J,"ODS-DISP-NVA",FAC)):^(FAC),1:0) D LINE Q:A1B2QUIT
- S X="No. Vets Displaced to VA Care",Y=$S($D(^UTILITY($J,"ODS-DISP-VA",FAC)):^(FAC),1:0) D LINE Q:A1B2QUIT
- F M=0:0 Q:($Y+6)>IOSL W !
- W ?IOM-30,"DATE PRINTED: ",A1B2DATE
- Q
- ;
- HDR S PAGE=PAGE+1,X="OPERATION DESERT SHIELD" W @IOF,?(IOM-$L(X))/2,X,?(IOM-10),"PAGE: ",PAGE
- S X="STATISTICAL SUMMARY REPORT" W !!,?(IOM-$L(X))/2,X
- I A1B2NSR S X="Medical Center Summary Report" W !!,?(IOM-$L(X))/2,X
- I 'A1B2NSR S Y=FAC_" - "_^UTILITY($J,"ODS-FAC",FAC)
- I 'A1B2NSR S X="Medical Center: "_Y W !!,?(IOM-$L(X))/2,X
- S X="For Period: " S Y=A1B2BDT D D^DIQ S Y1=Y,Y=A1B2EDT/1 D D^DIQ S X=X_Y1_" to "_Y W !!,?(IOM-$L(X))/2,X
- S X="-----------------------------" W !,?(IOM-$L(X))/2,X
- I A1B2NSR S X="-----------------------------" W !,?(IOM-$L(X))/2,X
- Q
- ;
- SPC S X1="" F J=0:0 S X1=$O(^UTILITY($J,"ODS-UNQA-SPC",FAC,X1)) Q:X1=""!(A1B2QUIT) S Y=^(X1),X=$P($T(@(X1)),";",3) D LINE Q:A1B2QUIT
- Q
- ;
- BOS S X1="" F J=0:0 S X1=$O(^UTILITY($J,"ODS-UNQA-BOS",FAC,X1)) Q:X1=""!(A1B2QUIT) S Y=^(X1),X=$S($D(^DIC(23,X1,0)):$P(^(0),"^"),1:"UNKNOWN") D LINE Q:A1B2QUIT
- Q
- ;
- END Q
- Q
- ;
- M ;;Medicine
- S ;;Surgery
- R ;;Rehab Medicine
- P ;;Psychiatry
- NH ;;NHCU
- I ;;Intermediate
- SCI ;;Spinal Cord Injury
- D ;;Domiciliary
- B ;;Blind Rehab
- RE ;;Respite Care
- NE ;;Neurology
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1B2OSR2 2766 printed Feb 18, 2025@23:47:41 Page 2
- A1B2OSR2 ;ALB/AAS - PRINT ODS SUMMARY REPORT ; 11-JAN-91
- +1 ;;Version 1.55 (local for MAS v5 sites);;
- +2 ;
- % SET CNTF=0
- SET PAGE=0
- SET TAB=IOM/2
- SET A1B2QUIT=0
- SET Y=DT
- DO D^DIQ
- SET A1B2DATE=Y
- +1 IF '$DATA(^UTILITY($JOB))
- WRITE !,"No Matches Found"
- +2 IF 'A1B2NSR
- SET FAC=""
- FOR I=0:0
- SET FAC=$ORDER(^UTILITY($JOB,"ODS-FAC",FAC))
- if FAC=""!(A1B2QUIT)
- QUIT
- SET CNTF=CNTF+1
- DO RPRT
- if 'A1B2QUIT
- DO PAUSE
- if A1B2QUIT
- QUIT
- +3 ;I 'A1B2QUIT S A1B2NSR=1 D ^A1B2OSR3
- +4 GOTO END
- +5 QUIT
- +6 ;
- PAUSE IF $EXTRACT(IOST,1,2)["C-"
- SET DIR(0)="E"
- DO ^DIR
- SET A1B2QUIT='Y
- +1 QUIT
- LINE ; --write line in report
- +1 IF ($Y+6)>IOSL
- SET A1B2X=X
- SET A1B2Y=Y
- DO PAUSE
- if A1B2QUIT
- QUIT
- DO HDR
- SET X=A1B2X
- SET Y=A1B2Y
- +2 WRITE !?(TAB-$LENGTH(X)),X,": ",Y
- QUIT
- +3 ;
- RPRT ; --write report
- +1 DO HDR
- WRITE !
- +2 SET X="Total Admissions"
- SET Y=$SELECT($DATA(^UTILITY($JOB,"ODS-ADM",FAC)):^(FAC),1:0)
- DO LINE
- if A1B2QUIT
- QUIT
- +3 SET X="Total Discharges"
- SET Y=$SELECT($DATA(^UTILITY($JOB,"ODS-DIS",FAC)):^(FAC),1:0)
- DO LINE
- if A1B2QUIT
- QUIT
- +4 SET X="Patients Treated"
- SET Y=Y+$SELECT($DATA(^UTILITY($JOB,"ODS-PTRM",FAC)):^(FAC),1:0)
- DO LINE
- if A1B2QUIT
- QUIT
- +5 SET X="No. Unique Patients Admitted"
- SET Y=$SELECT($DATA(^UTILITY($JOB,"ODS-UNQ-ADM",FAC)):^(FAC),1:0)
- DO LINE
- if A1B2QUIT
- QUIT
- +6 IF $DATA(^UTILITY($JOB,"ODS-UNQA-SPC",FAC))
- WRITE !
- SET X="No. Pts. Admitted to"
- SET Y=""
- DO LINE
- if A1B2QUIT
- QUIT
- DO SPC
- if A1B2QUIT
- QUIT
- +7 IF $DATA(^UTILITY($JOB,"ODS-UNQA-BOS",FAC))
- WRITE !
- SET X="No. Pts. Admitted from"
- SET Y=""
- DO LINE
- if A1B2QUIT
- QUIT
- DO BOS
- if A1B2QUIT
- QUIT
- +8 WRITE !
- SET X="No. ODS pts. to Non-VA Care"
- SET Y=$SELECT($DATA(^UTILITY($JOB,"ODS-TRF-NVA",FAC)):^(FAC),1:0)
- DO LINE
- if A1B2QUIT
- QUIT
- +9 SET X="No. Vets Displaced to Non-VA Care"
- SET Y=$SELECT($DATA(^UTILITY($JOB,"ODS-DISP-NVA",FAC)):^(FAC),1:0)
- DO LINE
- if A1B2QUIT
- QUIT
- +10 SET X="No. Vets Displaced to VA Care"
- SET Y=$SELECT($DATA(^UTILITY($JOB,"ODS-DISP-VA",FAC)):^(FAC),1:0)
- DO LINE
- if A1B2QUIT
- QUIT
- +11 FOR M=0:0
- if ($Y+6)>IOSL
- QUIT
- WRITE !
- +12 WRITE ?IOM-30,"DATE PRINTED: ",A1B2DATE
- +13 QUIT
- +14 ;
- HDR SET PAGE=PAGE+1
- SET X="OPERATION DESERT SHIELD"
- WRITE @IOF,?(IOM-$LENGTH(X))/2,X,?(IOM-10),"PAGE: ",PAGE
- +1 SET X="STATISTICAL SUMMARY REPORT"
- WRITE !!,?(IOM-$LENGTH(X))/2,X
- +2 IF A1B2NSR
- SET X="Medical Center Summary Report"
- WRITE !!,?(IOM-$LENGTH(X))/2,X
- +3 IF 'A1B2NSR
- SET Y=FAC_" - "_^UTILITY($JOB,"ODS-FAC",FAC)
- +4 IF 'A1B2NSR
- SET X="Medical Center: "_Y
- WRITE !!,?(IOM-$LENGTH(X))/2,X
- +5 SET X="For Period: "
- SET Y=A1B2BDT
- DO D^DIQ
- SET Y1=Y
- SET Y=A1B2EDT/1
- DO D^DIQ
- SET X=X_Y1_" to "_Y
- WRITE !!,?(IOM-$LENGTH(X))/2,X
- +6 SET X="-----------------------------"
- WRITE !,?(IOM-$LENGTH(X))/2,X
- +7 IF A1B2NSR
- SET X="-----------------------------"
- WRITE !,?(IOM-$LENGTH(X))/2,X
- +8 QUIT
- +9 ;
- SPC SET X1=""
- FOR J=0:0
- SET X1=$ORDER(^UTILITY($JOB,"ODS-UNQA-SPC",FAC,X1))
- if X1=""!(A1B2QUIT)
- QUIT
- SET Y=^(X1)
- SET X=$PIECE($TEXT(@(X1)),";",3)
- DO LINE
- if A1B2QUIT
- QUIT
- +1 QUIT
- +2 ;
- BOS SET X1=""
- FOR J=0:0
- SET X1=$ORDER(^UTILITY($JOB,"ODS-UNQA-BOS",FAC,X1))
- if X1=""!(A1B2QUIT)
- QUIT
- SET Y=^(X1)
- SET X=$SELECT($DATA(^DIC(23,X1,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
- DO LINE
- if A1B2QUIT
- QUIT
- +1 QUIT
- +2 ;
- END QUIT
- +1 QUIT
- +2 ;
- M ;;Medicine
- S ;;Surgery
- R ;;Rehab Medicine
- P ;;Psychiatry
- NH ;;NHCU
- I ;;Intermediate
- SCI ;;Spinal Cord Injury
- D ;;Domiciliary
- B ;;Blind Rehab
- RE ;;Respite Care
- NE ;;Neurology