- 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 ---[H[J[2J[HQAMC1 1318 printed Jan 18, 2025@02:43:07 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