- QAOSXTRN ;HISC/DDA-SUPPORTED EXTERNAL ENTRY POINTS ;2/4/93 09:33
- ;;3.0;Occurrence Screen;;09/14/1993
- Q
- PAD0 ;ENTRY TO PRINT ADVERSE FINDINGS REPORT THAT PRINTS NO NAMES OR CODES
- S QAOSCHOS="X" ; FLAG TO SUPPRESS NAMES AND CODES
- D ^QAQDATE G:QAQQUIT EXIT^QAOSPAD0
- K %ZIS S %ZIS="QM" D ^%ZIS G:POP EXIT^QAOSPAD0
- I $D(IO("Q")) D G EXIT^QAOSPAD0
- . S ZTDESC="Adverse findings report",ZTRTN="ENTSK^QAOSPAD0"
- . S ZTSAVE("QAOS*")="",ZTSAVE("QAQ*")="" D ^%ZTLOAD
- . Q
- D ENTSK^QAOSPAD0
- Q
- PSM0 ;ENTRY TO PRINT SUMMARY OF OCCURRENCE SCREENING
- D ^QAOSPSM
- Q
- PSS0(QAQNBEG,QAQNEND) ;
- ;ENTRY TO EXTRACT DATA FROM THE SERVICE STATISTICS REPORT
- ;
- ; RETURNS: Y = # 10 DAY READMISSIONS WITH D/C FROM MEDICINE SERVICE
- ; ^ # 10 DAY READMISSIONS WITH D/C FROM SURGERY SERVICE
- ; ^ # 48 HRS READMISSIONS WITH D/C FROM EXTENDED CARE
- ;
- S QAOSSORT="C" ; SORT BY CRITERIA
- S QAOSLIST(0)="1,2," ; INCLUDE ONLY NATIONAL SCREENS
- D ^QAOSPSS0
- S Y=$G(^UTILITY($J,"QAOSPSS","N",1)),Y=+$P(Y,"^",5)_"^"_+$P(Y,"^",12)
- S X=$G(^UTILITY($J,"QAOSPSS","L",1)),Z=0 F QA=2:1:13 S Z=Z+$P(X,"^",QA)
- S Y=Y_"^"_Z
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSXTRN 1152 printed Mar 13, 2025@21:27:12 Page 2
- QAOSXTRN ;HISC/DDA-SUPPORTED EXTERNAL ENTRY POINTS ;2/4/93 09:33
- +1 ;;3.0;Occurrence Screen;;09/14/1993
- +2 QUIT
- PAD0 ;ENTRY TO PRINT ADVERSE FINDINGS REPORT THAT PRINTS NO NAMES OR CODES
- +1 ; FLAG TO SUPPRESS NAMES AND CODES
- SET QAOSCHOS="X"
- +2 DO ^QAQDATE
- if QAQQUIT
- GOTO EXIT^QAOSPAD0
- +3 KILL %ZIS
- SET %ZIS="QM"
- DO ^%ZIS
- if POP
- GOTO EXIT^QAOSPAD0
- +4 IF $DATA(IO("Q"))
- Begin DoDot:1
- +5 SET ZTDESC="Adverse findings report"
- SET ZTRTN="ENTSK^QAOSPAD0"
- +6 SET ZTSAVE("QAOS*")=""
- SET ZTSAVE("QAQ*")=""
- DO ^%ZTLOAD
- +7 QUIT
- End DoDot:1
- GOTO EXIT^QAOSPAD0
- +8 DO ENTSK^QAOSPAD0
- +9 QUIT
- PSM0 ;ENTRY TO PRINT SUMMARY OF OCCURRENCE SCREENING
- +1 DO ^QAOSPSM
- +2 QUIT
- PSS0(QAQNBEG,QAQNEND) ;
- +1 ;ENTRY TO EXTRACT DATA FROM THE SERVICE STATISTICS REPORT
- +2 ;
- +3 ; RETURNS: Y = # 10 DAY READMISSIONS WITH D/C FROM MEDICINE SERVICE
- +4 ; ^ # 10 DAY READMISSIONS WITH D/C FROM SURGERY SERVICE
- +5 ; ^ # 48 HRS READMISSIONS WITH D/C FROM EXTENDED CARE
- +6 ;
- +7 ; SORT BY CRITERIA
- SET QAOSSORT="C"
- +8 ; INCLUDE ONLY NATIONAL SCREENS
- SET QAOSLIST(0)="1,2,"
- +9 DO ^QAOSPSS0
- +10 SET Y=$GET(^UTILITY($JOB,"QAOSPSS","N",1))
- SET Y=+$PIECE(Y,"^",5)_"^"_+$PIECE(Y,"^",12)
- +11 SET X=$GET(^UTILITY($JOB,"QAOSPSS","L",1))
- SET Z=0
- FOR QA=2:1:13
- SET Z=Z+$PIECE(X,"^",QA)
- +12 SET Y=Y_"^"_Z
- +13 QUIT
