QAMC6.m

QAMC6 ;HISC/DAD-CONDITION: LENGTH OF STAY SINCE ADMISSION ;2/10/92  07:33

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

EN1 ; *** CONDITION CODE

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

 S X1=QAMTODAY,X2=-LOS D C^%DTC S (X1,ADMSTART)=X,X2=1 D C^%DTC S ADMEND=X,ADMSTART=ADMSTART-.0000001

 F ADMDT=ADMSTART:0 S ADMDT=$O(^DGPM("AMV1",ADMDT)) Q:(ADMDT'>0)!(ADMDT'<ADMEND)!(ADMDT\1'?7N)  F QAMDFN=0:0 S QAMDFN=$O(^DGPM("AMV1",ADMDT,QAMDFN)) Q:QAMDFN'>0  D LOOP0

 K LOS,X1,X2,ADMEND,ADMSTART,QAMDC

 Q

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

 Q

LOOP1 S QAMDC=$O(^DGPM("APTT3",QAMDFN,ADMDT)) Q:(QAMDC'>QAMTODAY)&QAMDC

 S ^UTILITY($J,"QAM CONDITION",QAMD1,QAMDFN)="",^(QAMDFN,QAMTODAY)=IEN

 Q

EN2 ; *** PARAMETER CODE

 K DIR,DIRUT S DIR(0)="NO^1:365:0",DIR("A")="LENGTH OF STAY",DIR("B")=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:^("P1"),1:"") K:DIR("B")="" DIR("B")

 S DIR("?",1)="Enter the LOS from the date of the patient's admission.",DIR("?")="Enter the length of stay from 1-365 days."

 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 ---QAMC6   1184     printed  Apr 09, 2024@20:47:08                                                                                                                                                                                                       Page 2

QAMC6     ;HISC/DAD-CONDITION: LENGTH OF STAY SINCE ADMISSION ;2/10/92  07:33

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

EN1       ; *** CONDITION CODE

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

 +2        SET X1=QAMTODAY

           SET X2=-LOS

           DO C^%DTC

           SET (X1,ADMSTART)=X

           SET X2=1

           DO C^%DTC

           SET ADMEND=X

           SET ADMSTART=ADMSTART-.0000001

 +3        FOR ADMDT=ADMSTART:0

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

               if (ADMDT'>0)!(ADMDT'<ADMEND)!(ADMDT\1'?7N)

                   QUIT 

               FOR QAMDFN=0:0

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

                   if QAMDFN'>0

                       QUIT 

                   DO LOOP0

 +4        KILL LOS,X1,X2,ADMEND,ADMSTART,QAMDC

 +5        QUIT 

LOOP0      FOR IEN=0:0

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

               if IEN'>0

                   QUIT 

               DO LOOP1

 +1        QUIT 

LOOP1      SET QAMDC=$ORDER(^DGPM("APTT3",QAMDFN,ADMDT))

           if (QAMDC'>QAMTODAY)&QAMDC

               QUIT 

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

           SET ^(QAMDFN,QAMTODAY)=IEN

 +2        QUIT 

EN2       ; *** PARAMETER CODE

 +1        KILL DIR,DIRUT

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

           SET DIR("A")="LENGTH OF STAY"

           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 LOS from the date of the patient's admission."

           SET DIR("?")="Enter the length of stay from 1-365 days."

 +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