QAOC199.m

QAOC199 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ;5/13/93  09:06

 ;;3.0;Occurrence Screen;;09/14/1993

 ;SCREEN 199 -- READMISSION TO ACUTE CARE WITHIN 48 HOURS OF DISCHARGE

 ;              FROM EXTENDED CARE

 Q:$$INACTIVE^QAOC0(199)

 F QAOSDT=(QAMTODAY-.0000001):0 S QAOSDT=$O(^DGPM("AMV1",QAOSDT)) Q:QAOSDT'>0!(QAOSDT>(QAMTODAY+.24))!(QAOSDT\1'?7N)  F QAOSDFN=0:0 S QAOSDFN=$O(^DGPM("AMV1",QAOSDT,QAOSDFN)) Q:QAOSDFN'>0  D

 . F QAOSD0=0:0 S QAOSD0=$O(^DGPM("AMV1",QAOSDT,QAOSDFN,QAOSD0)) Q:QAOSD0'>0  D:$D(^DGPM(QAOSD0,0))#2 MAIN

 . Q

 Q

MAIN ;

 D VADPT^QAOC0(QAOSDFN,QAOSD0) S QAOSDIAG=VAIP(9)

 Q:$$TXSP^QAOC0("AS",+VAIP(8))'>0

 S X1=QAOSDT,X2=-2 D C^%DTC S QAOSDCXX=9999999.9999999-X

 S QA=9999999.9999999-QAOSDT,QAOFOUND=0

 F QAOSDCDT=QA:0 S QAOSDCDT=$O(^DGPM("ATID3",QAOSDFN,QAOSDCDT)) Q:(QAOSDCDT'>0)!(QAOSDCDT>QAOSDCXX)!(QAOSDCDT\1'?7N)!QAOFOUND  F QAOSDCD0=0:0 S QAOSDCD0=$O(^DGPM("ATID3",QAOSDFN,QAOSDCDT,QAOSDCD0)) Q:QAOSDCD0'>0!QAOFOUND  D

 . Q:"^31^32^34^"'[("^"_$P($G(^DGPM(QAOSDCD0,0)),"^",18)_"^")

 . D VADPT^QAOC0(QAOSDFN,QAOSDCD0) S QAOFOUND=1

 . S ^UTILITY($J,"QAM CONDITION",QAMD1,QAOSDFN,QAMTODAY)=""

 . S WARDCLIN=+VAIP(5)_"^"

 . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"WARD")=WARDCLIN

 . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"TXSP")=+VAIP(8)

 . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"MVDT")=+VAIP(3)

 . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"DIAG")=QAOSDIAG

 . S ^UTILITY($J,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"AADM")=QAOSD0

 . Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QAOC199   1543     printed  Apr 09, 2024@21:23:41                                                                                                                                                                                                     Page 2

QAOC199   ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ;5/13/93  09:06

 +1       ;;3.0;Occurrence Screen;;09/14/1993

 +2       ;SCREEN 199 -- READMISSION TO ACUTE CARE WITHIN 48 HOURS OF DISCHARGE

 +3       ;              FROM EXTENDED CARE

 +4        if $$INACTIVE^QAOC0(199)

               QUIT 

 +5        FOR QAOSDT=(QAMTODAY-.0000001):0

               SET QAOSDT=$ORDER(^DGPM("AMV1",QAOSDT))

               if QAOSDT'>0!(QAOSDT>(QAMTODAY+.24))!(QAOSDT\1'?7N)

                   QUIT 

               FOR QAOSDFN=0:0

                   SET QAOSDFN=$ORDER(^DGPM("AMV1",QAOSDT,QAOSDFN))

                   if QAOSDFN'>0

                       QUIT 

                   Begin DoDot:1

 +6                    FOR QAOSD0=0:0

                           SET QAOSD0=$ORDER(^DGPM("AMV1",QAOSDT,QAOSDFN,QAOSD0))

                           if QAOSD0'>0

                               QUIT 

                           if $DATA(^DGPM(QAOSD0,0))#2

                               DO MAIN

 +7                    QUIT 

                   End DoDot:1

 +8        QUIT 

MAIN      ;

 +1        DO VADPT^QAOC0(QAOSDFN,QAOSD0)

           SET QAOSDIAG=VAIP(9)

 +2        if $$TXSP^QAOC0("AS",+VAIP(8))'>0

               QUIT 

 +3        SET X1=QAOSDT

           SET X2=-2

           DO C^%DTC

           SET QAOSDCXX=9999999.9999999-X

 +4        SET QA=9999999.9999999-QAOSDT

           SET QAOFOUND=0

 +5        FOR QAOSDCDT=QA:0

               SET QAOSDCDT=$ORDER(^DGPM("ATID3",QAOSDFN,QAOSDCDT))

               if (QAOSDCDT'>0)!(QAOSDCDT>QAOSDCXX)!(QAOSDCDT\1'?7N)!QAOFOUND

                   QUIT 

               FOR QAOSDCD0=0:0

                   SET QAOSDCD0=$ORDER(^DGPM("ATID3",QAOSDFN,QAOSDCDT,QAOSDCD0))

                   if QAOSDCD0'>0!QAOFOUND

                       QUIT 

                   Begin DoDot:1

 +6                    if "^31^32^34^"'[("^"_$PIECE($GET(^DGPM(QAOSDCD0,0)),"^",18)_"^")

                           QUIT 

 +7                    DO VADPT^QAOC0(QAOSDFN,QAOSDCD0)

                       SET QAOFOUND=1

 +8                    SET ^UTILITY($JOB,"QAM CONDITION",QAMD1,QAOSDFN,QAMTODAY)=""

 +9                    SET WARDCLIN=+VAIP(5)_"^"

 +10                   SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"WARD")=WARDCLIN

 +11                   SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"TXSP")=+VAIP(8)

 +12                   SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"MVDT")=+VAIP(3)

 +13                   SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"DIAG")=QAOSDIAG

 +14                   SET ^UTILITY($JOB,"QAM FALL OUT",QAMD0,QAOSDFN,QAMTODAY,"AADM")=QAOSD0

 +15                   QUIT 

                   End DoDot:1

 +16       QUIT