QAOSXTRN.m

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 ---QAOSXTRN   1152     printed  Apr 09, 2024@21:22:25                                                                                                                                                                                                    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