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 Nov 22, 2024@17:32:15 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
