QAMC1.m

QAMC1 ;HISC/DAD-CONDITION: AGE ;2/10/92  07:33

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

EN1 ; *** CONDITION CODE

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

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

 Q:UPPERAGE+LOWERAGE'>0

 S X1=QAMTODAY,X2=-1*(UPPERAGE*365.25+1) D C^%DTC S START=$S(UPPERAGE'>0:0,1:X)

 S X1=QAMTODAY,X2=-1*(LOWERAGE*365.25) D C^%DTC S END=X

 F QAMDOB=START:0:END S QAMDOB=$O(^DPT("ADOB",QAMDOB)) Q:QAMDOB'>0!(QAMDOB>END)!(QAMDOB\1'?7N)  F QAMDFN=0:0 S QAMDFN=$O(^DPT("ADOB",QAMDOB,QAMDFN)) Q:QAMDFN'>0  D LOOP1

 K LOWERAGE,UPPERAGE,X1,X2,X,START,QAMDOB,END

 Q

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

 Q

EN2 ; *** PARAMETER CODE

 K DIR,DIRUT S DIR(0)="NO^1:130:0",DIR("A")="LOWER AGE LIMIT",DIR("B")=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P1"))#2:+^("P1"),1:"") K:DIR("B")="" DIR("B")

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

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

2 K DIR,DIRUT S DIR(0)="NO^"_$S(QAMY>0:QAMY,1:1)_":130:0",DIR("A")="UPPER AGE LIMIT",DIR("B")=$S($D(^QA(743,QAMD0,"COND",QAMD1,"P2"))#2:+^("P2"),1:"") K:DIR("B")="" DIR("B")

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

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

EXIT K Y

Y K QAMPARAM

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QAMC1   1318     printed  Apr 09, 2024@20:46:55                                                                                                                                                                                                       Page 2

QAMC1     ;HISC/DAD-CONDITION: AGE ;2/10/92  07:33

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

EN1       ; *** CONDITION CODE

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

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

 +3        if UPPERAGE+LOWERAGE'>0

               QUIT 

 +4        SET X1=QAMTODAY

           SET X2=-1*(UPPERAGE*365.25+1)

           DO C^%DTC

           SET START=$SELECT(UPPERAGE'>0:0,1:X)

 +5        SET X1=QAMTODAY

           SET X2=-1*(LOWERAGE*365.25)

           DO C^%DTC

           SET END=X

 +6        FOR QAMDOB=START:0:END

               SET QAMDOB=$ORDER(^DPT("ADOB",QAMDOB))

               if QAMDOB'>0!(QAMDOB>END)!(QAMDOB\1'?7N)

                   QUIT 

               FOR QAMDFN=0:0

                   SET QAMDFN=$ORDER(^DPT("ADOB",QAMDOB,QAMDFN))

                   if QAMDFN'>0

                       QUIT 

                   DO LOOP1

 +7        KILL LOWERAGE,UPPERAGE,X1,X2,X,START,QAMDOB,END

 +8        QUIT 

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

           SET ^(QAMDFN,QAMTODAY)=QAMDFN

 +1        QUIT 

EN2       ; *** PARAMETER CODE

 +1        KILL DIR,DIRUT

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

           SET DIR("A")="LOWER AGE LIMIT"

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

           if DIR("B")=""

               KILL DIR("B")

 +2        SET QAMPARAM="P1"

           DO EN3^QAMUTL1

           IF $DATA(DIRUT)

               SET Y=-1

               GOTO Y

 +3        if Y]""

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

           SET QAMY=Y

2          KILL DIR,DIRUT

           SET DIR(0)="NO^"_$SELECT(QAMY>0:QAMY,1:1)_":130:0"

           SET DIR("A")="UPPER AGE LIMIT"

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

           if DIR("B")=""

               KILL DIR("B")

 +1        SET QAMPARAM="P2"

           DO EN3^QAMUTL1

           IF $DATA(DIRUT)

               SET Y=-1

               GOTO Y

 +2        if Y]""

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

EXIT       KILL Y

Y          KILL QAMPARAM

 +1        QUIT