Routine: QAMC13

QAMC13 ;HISC/DAD-CONDITION: READMISSION ;9/3/93  13:13

 ;;1.0;Clinical Monitoring System;;09/13/1993

EN1 ; *** CONDITION CODE

 S QAMDAYS=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:+^("P1"),1:0)

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

 K ADMD0,QAMDAYS,ADMDT,X1,X2,X,STOPDT,QAMDC

LOOP0 F ADMD0=0:0 S ADMD0=$O(^DGPM("AMV1",ADMDT,QAMDFN,ADMD0)) Q:ADMD0'>0  D LOOP1

LOOP1 S X1=ADMDT,X2=-QAMDAYS D C^%DTC S STOPDT=9999999.9999999-X

 F QAMDC=(9999999.9999999-ADMDT):0 S QAMDC=$O(^DGPM("ATID3",QAMDFN,QAMDC)) Q:(QAMDC'>0)!(QAMDC\1'?7N)!(QAMDC>STOPDT)  S ^UTILITY($J,"QAM CONDITION",QAMD1,QAMDFN)="",^(QAMDFN,ADMDT)=ADMD0 Q

EN2 ; *** PARAMETER CODE

 K DIR,DIRUT S DIR(0)="NO^1:365:0",DIR("A")="DAYS BETWEEN DISCHARGE AND ADMISSION",DIR("B")=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:^("P1"),1:"") K:DIR("B")="" DIR("B")

 S DIR("?",1)="Enter the number of QAMDAYS between the patient's last discharge",DIR("?")="and current admission."

 S QAMPARAM="P1" D EN3^QAMUTL1 I $D(DIRUT) S Y=-1 G Y

 S:Y]"" ^QA(743,QAMD0,"COND",QAMD1,"P1")=+Y

EXIT K Y

 K QAMPARAM

Y Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMC13   1230     printed  Mar 13, 2025@20:46:37                                                                                                                                                                                                      Page 2

QAMC13    ;HISC/DAD-CONDITION: READMISSION ;9/3/93  13:13

 +1       ;;1.0;Clinical Monitoring System;;09/13/1993

EN1       ; *** CONDITION CODE

 +1        SET QAMDAYS=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:+^("P1"),1:0)

 +2        FOR ADMDT=(QAMTODAY-.0000001):0

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

               if (ADMDT'>0)!(ADMDT>(QAMTODAY+.9999999))!(ADMDT\1'?7N)

                   QUIT

               FOR QAMDFN=0:0

                   SET QAMDFN=$ORDER(^DGPM("AMV1",ADMDT,QAMDFN))

                   if QAMDFN'>0

                       QUIT

                   DO LOOP0

 +3        KILL ADMD0,QAMDAYS,ADMDT,X1,X2,X,STOPDT,QAMDC

 +4        QUIT

LOOP0      FOR ADMD0=0:0

               SET ADMD0=$ORDER(^DGPM("AMV1",ADMDT,QAMDFN,ADMD0))

               if ADMD0'>0

                   QUIT

               DO LOOP1

 +1        QUIT

LOOP1      SET X1=ADMDT

           SET X2=-QAMDAYS

           DO C^%DTC

           SET STOPDT=9999999.9999999-X

 +1        FOR QAMDC=(9999999.9999999-ADMDT):0

               SET QAMDC=$ORDER(^DGPM("ATID3",QAMDFN,QAMDC))

               if (QAMDC'>0)!(QAMDC\1'?7N)!(QAMDC>STOPDT)

                   QUIT

               SET ^UTILITY($JOB,"QAM CONDITION",QAMD1,QAMDFN)=""

               SET ^(QAMDFN,ADMDT)=ADMD0

               QUIT

 +2        QUIT

EN2       ; *** PARAMETER CODE

 +1        KILL DIR,DIRUT

           SET DIR(0)="NO^1:365:0"

           SET DIR("A")="DAYS BETWEEN DISCHARGE AND ADMISSION"

           SET DIR("B")=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:^("P1"),1:"")

           if DIR("B")=""

               KILL DIR("B")

 +2        SET DIR("?",1)="Enter the number of QAMDAYS between the patient's last discharge"

           SET DIR("?")="and current admission."

 +3        SET QAMPARAM="P1"

           DO EN3^QAMUTL1

           IF $DATA(DIRUT)

               SET Y=-1

               GOTO Y

 +4        if Y]""

               SET ^QA(743,QAMD0,"COND",QAMD1,"P1")=+Y

EXIT       KILL Y

 +1        KILL QAMPARAM

Y          QUIT

QAMC13.m