QAMEDT2 ;HISC/DAD-PROGRAMMER MONITOR EDIT ;9/10/93 13:20
;;1.0;Clinical Monitoring System;;09/13/1993
EN1 ;
K QAMSEPR8 S $P(QAMSEPR8,"=",81)=""
K DIC,DIDEL,DINUM S DIC="^QA(743,",DIC(0)="AELMNQ",DIC("A")="Select MONITOR: ",DLAYGO=743
W ! D ^DIC K DIC G:Y'>0 EXIT S QAMD0=+Y
S QAMFIN=$S($D(^QA(743,QAMD0,0))#2:$P(^(0),"^",5),1:"")
S QAMMSGS="EW" D ^QAMSANE W !
I Y=1!(Y=-1&QAMFIN) K DR S DIE="^QA(743,",DR="7//UNDER CONSTRUCTION",DA=QAMD0 D ^DIE G:$D(Y) EXIT
S QAMFIN=$S($D(^QA(743,QAMD0,0))#2:$P(^(0),"^",5),1:"")
K DR S DIE="^QA(743,",DR=".01;.02;1;2;3",DA=QAMD0 D ^DIE G:$D(Y)!($D(DA)[0) EN1
K DR S DIE="^QA(743,",DR="4",DR(2,743.04)=".01;S QAM=+$S($D(^QA(743.91,+X,0))#2:$P(^(0),""^"",2),1:0),Y=$S(QAM:Y,1:""@1"");1;S Y=0;@1;1///@",DA=QAMD0 D ^DIE G:$D(Y) EN1
G:QAMFIN C1
S QAMAUTO("OLD6")=$S($D(^QA(743,QAMD0,0))#2:$P(^(0),"^",4),1:"")
K DR S DIE="^QA(743,",DR="6//YES",DA=QAMD0 D ^DIE G:$D(Y) EN1
S QAMAUTO("NEW6")=$S($D(^QA(743,QAMD0,0))#2:$P(^(0),"^",4),1:"")
D:QAMAUTO("OLD6")'=QAMAUTO("NEW6") DELCR
K ^UTILITY($J,"COND") F QAMD1=0:0 S QAMD1=$O(^QA(743,QAMD0,"COND",QAMD1)) Q:QAMD1'>0 S ^UTILITY($J,"COND",QAMD1)=^QA(743,QAMD0,"COND",QAMD1,0)
S QAMDFLT=0
20 K DIC,DTOUT,DUOUT,QAMOUT S:$D(^QA(743,QAMD0,"COND",0))[0 ^(0)="^743.01PA^^"
S DIC="^QA(743,"_QAMD0_",""COND"",",DIC(0)="ELMNQZ",DIC("A")="Select CONDITION: ",DLAYGO=743,(D0,DA(1))=QAMD0
S Y=+$P(^QA(743,QAMD0,"COND",0),"^",3),Y=$S($D(^QA(743,QAMD0,"COND",Y,0))#2:+^(0),1:0),DIC("B")=$S(QAMDFLT:"",$D(^QA(743.3,Y,0))#2:$P(^(0),"^"),1:"") K:DIC("B")="" DIC("B")
W !,DIC("A"),$S($D(DIC("B"))#2:DIC("B")_"//",1:"")," " R X:DTIME
S:('$T)!($E(X)="^") X="^",Y=-1,QAMOUT=1 I '$D(QAMOUT) S:(X="")&($D(DIC("B")))#2 X=DIC("B")
W:X?1."?" !?5,"You may enter '?CONDITION' (e.g., ?AGE) at the 'Select CONDITION:'",!?5,"prompt to see a description of a condition or range of conditions.",!?5,"Enter '?*' to see the descriptions for all conditions."
I (X?1."?"1AN.ANP)!(X?1."?"1."*".E) D EN4^QAMUTL1 G 20
D:$D(QAMOUT)[0 ^DIC K DIC G:($E(X)="?")!((Y'>0)&(X]"")&($E(X)'="^")) 20 S QAMD1=+Y,QAMDFLT=1 S:$D(DTOUT)!$D(DUOUT) QAMOUT=1 G CONT:$D(QAMOUT)!(X="")
S QAMSVCND=+$G(^QA(743,QAMD0,"COND",QAMD1,0))
K DR S DIE="^QA(743,"_QAMD0_",""COND"",",DR=".01",DA(1)=QAMD0,DA=QAMD1 D ^DIE G:$D(Y)!($D(DA)[0) 20
I QAMSVCND'=+$G(^QA(743,QAMD0,"COND",QAMD1,0)) F QA=1:1:5 K ^QA(743,QAMD0,"COND",QAMD1,"P"_QA)
D EN3^QAMUTL0 G:$D(Y) 20
K DR S DIE="^QA(743,"_QAMD0_",""COND"",",DR="1",DA(1)=QAMD0,DA=QAMD1 D ^DIE G 20
CONT F QAMD1=0:0 S QAMD1=$O(^UTILITY($J,"COND",QAMD1)) Q:QAMD1'>0 I ^UTILITY($J,"COND",QAMD1)'=$S($D(^QA(743,QAMD0,"COND",QAMD1,0))#2:^(0),1:"") D DELR G ONWARD
F QAMD1=0:0 S QAMD1=$O(^QA(743,QAMD0,"COND",QAMD1)) Q:QAMD1'>0 I ^QA(743,QAMD0,"COND",QAMD1,0)'=$S($D(^UTILITY($J,"COND",QAMD1))#2:^(QAMD1),1:"") D DELR Q
ONWARD K ^UTILITY($J,"COND") G:$D(QAMOUT) EN1
G C2:$S($D(^QA(743,QAMD0,"COND",0))[0:1,$P(^(0),"^",4)'>0:1,1:0)
W !!,QAMSEPR8 S DA=QAMD0 D EN2^QAMUTL0 K DR S DIE="^QA(743,",DR="25",DA=QAMD0 D ^DIE G:$D(Y) EN1
G:'$D(^QA(743,QAMD0,"COND","AS",1)) C3
W !!,QAMSEPR8 S DA=QAMD0 D EN5^QAMUTL0 K DR S DIE="^QA(743,",DR="26",DA=QAMD0 D ^DIE G:$D(Y) EN1
C3 W !!,QAMSEPR8 S DA=QAMD0 D EN1^QAMUTL1 K DR S DIE="^QA(743,",DR="64",DA=QAMD0 D ^DIE G:$D(Y) EN1
W !!,QAMSEPR8,!
C2 K DR S DIE="^QA(743,",DR="50;52",DA=QAMD0 D ^DIE G:$D(Y) EN1
S QAM=$S($D(^QA(743,QAMD0,1))#2:$P(^(1),"^",3),1:"") K DR S DR="51"_$S(QAM["%":";53",1:"T;53///@")_";63",DIE="^QA(743,",DA=QAMD0 D ^DIE G:$D(Y) EN1
C1 S QAM=$S($D(^QA(743,QAMD0,1))#2:$P(^(1),"^",3),1:"") K DR S DIE="^QA(743,",DR="30;57//NO;58//NO;59//NO;60//NO;61"_$S(QAM["%":"",1:"T")_"//NO",DA=QAMD0 D ^DIE G:$D(Y) EN1
S QA=$S($D(^QA(743,QAMD0,1))#2:^(1),1:"") I $P(QA,"^",10)+$P(QA,"^",11)+$P(QA,"^",12) K DR S DIE="^QA(743,",DR="62",DA=QAMD0 D ^DIE G:$D(Y) EN1
K DR S DIE="^QA(743,",DR="200;100;55;56;54//OFF",DA=QAMD0 D ^DIE G:$D(Y) EN1
S QAMMSGS="EW" D ^QAMSANE G:Y=-1 EN1 W !
K DR S DIE="^QA(743,",DR="7//UNDER CONSTRUCTION",DA=QAMD0 D ^DIE
G EN1
EXIT ;
K %Y,D0,D1,DA,DI,DIC,DIE,DIK,DLAYGO,DQ,DR,J,QA,QAM,QAMAUTO,QAMD0,QAMOUT,QAMFIN,QAMSEPR8,QAMSVCND,X,Y
Q
DELCR ; *** DELETE CONDITIONS AND RELATIONSHIP
F QAMD1=0:0 S QAMD1=$O(^QA(743,QAMD0,"COND",QAMD1)) Q:QAMD1'>0 S DA=QAMD1,DA(1)=QAMD0,DIK="^QA(743,"_DA(1)_",""COND""," D ^DIK
DELR K DR S DIE="^QA(743,",DR="25///@;26///@;64///@",DA=QAMD0 D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMEDT2 4404 printed Dec 13, 2024@01:42:19 Page 2
QAMEDT2 ;HISC/DAD-PROGRAMMER MONITOR EDIT ;9/10/93 13:20
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
EN1 ;
+1 KILL QAMSEPR8
SET $PIECE(QAMSEPR8,"=",81)=""
+2 KILL DIC,DIDEL,DINUM
SET DIC="^QA(743,"
SET DIC(0)="AELMNQ"
SET DIC("A")="Select MONITOR: "
SET DLAYGO=743
+3 WRITE !
DO ^DIC
KILL DIC
if Y'>0
GOTO EXIT
SET QAMD0=+Y
+4 SET QAMFIN=$SELECT($DATA(^QA(743,QAMD0,0))#2:$PIECE(^(0),"^",5),1:"")
+5 SET QAMMSGS="EW"
DO ^QAMSANE
WRITE !
+6 IF Y=1!(Y=-1&QAMFIN)
KILL DR
SET DIE="^QA(743,"
SET DR="7//UNDER CONSTRUCTION"
SET DA=QAMD0
DO ^DIE
if $DATA(Y)
GOTO EXIT
+7 SET QAMFIN=$SELECT($DATA(^QA(743,QAMD0,0))#2:$PIECE(^(0),"^",5),1:"")
+8 KILL DR
SET DIE="^QA(743,"
SET DR=".01;.02;1;2;3"
SET DA=QAMD0
DO ^DIE
if $DATA(Y)!($DATA(DA)[0)
GOTO EN1
+9 KILL DR
SET DIE="^QA(743,"
SET DR="4"
SET DR(2,743.04)=".01;S QAM=+$S($D(^QA(743.91,+X,0))#2:$P(^(0),""^"",2),1:0),Y=$S(QAM:Y,1:""@1"");1;S Y=0;@1;1///@"
SET DA=QAMD0
DO ^DIE
if $DATA(Y)
GOTO EN1
+10 if QAMFIN
GOTO C1
+11 SET QAMAUTO("OLD6")=$SELECT($DATA(^QA(743,QAMD0,0))#2:$PIECE(^(0),"^",4),1:"")
+12 KILL DR
SET DIE="^QA(743,"
SET DR="6//YES"
SET DA=QAMD0
DO ^DIE
if $DATA(Y)
GOTO EN1
+13 SET QAMAUTO("NEW6")=$SELECT($DATA(^QA(743,QAMD0,0))#2:$PIECE(^(0),"^",4),1:"")
+14 if QAMAUTO("OLD6")'=QAMAUTO("NEW6")
DO DELCR
+15 KILL ^UTILITY($JOB,"COND")
FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743,QAMD0,"COND",QAMD1))
if QAMD1'>0
QUIT
SET ^UTILITY($JOB,"COND",QAMD1)=^QA(743,QAMD0,"COND",QAMD1,0)
+16 SET QAMDFLT=0
20 KILL DIC,DTOUT,DUOUT,QAMOUT
if $DATA(^QA(743,QAMD0,"COND",0))[0
SET ^(0)="^743.01PA^^"
+1 SET DIC="^QA(743,"_QAMD0_",""COND"","
SET DIC(0)="ELMNQZ"
SET DIC("A")="Select CONDITION: "
SET DLAYGO=743
SET (D0,DA(1))=QAMD0
+2 SET Y=+$PIECE(^QA(743,QAMD0,"COND",0),"^",3)
SET Y=$SELECT($DATA(^QA(743,QAMD0,"COND",Y,0))#2:+^(0),1:0)
SET DIC("B")=$SELECT(QAMDFLT:"",$DATA(^QA(743.3,Y,0))#2:$PIECE(^(0),"^"),1:"")
if DIC("B")=""
KILL DIC("B")
+3 WRITE !,DIC("A"),$SELECT($DATA(DIC("B"))#2:DIC("B")_"//",1:"")," "
READ X:DTIME
+4 if ('$TEST)!($EXTRACT(X)="^")
SET X="^"
SET Y=-1
SET QAMOUT=1
IF '$DATA(QAMOUT)
if (X="")&($DATA(DIC("B")))#2
SET X=DIC("B")
+5 if X?1."?"
WRITE !?5,"You may enter '?CONDITION' (e.g., ?AGE) at the 'Select CONDITION:'",!?5,"prompt to see a description of a condition or range of conditions.",!?5,"Enter '?*' to see the descriptions for all conditions."
+6 IF (X?1."?"1AN.ANP)!(X?1."?"1."*".E)
DO EN4^QAMUTL1
GOTO 20
+7 if $DATA(QAMOUT)[0
DO ^DIC
KILL DIC
if ($EXTRACT(X)="?")!((Y'>0)&(X]"")&($EXTRACT(X)'="^"))
GOTO 20
SET QAMD1=+Y
SET QAMDFLT=1
if $DATA(DTOUT)!$DATA(DUOUT)
SET QAMOUT=1
if $DATA(QAMOUT)!(X="")
GOTO CONT
+8 SET QAMSVCND=+$GET(^QA(743,QAMD0,"COND",QAMD1,0))
+9 KILL DR
SET DIE="^QA(743,"_QAMD0_",""COND"","
SET DR=".01"
SET DA(1)=QAMD0
SET DA=QAMD1
DO ^DIE
if $DATA(Y)!($DATA(DA)[0)
GOTO 20
+10 IF QAMSVCND'=+$GET(^QA(743,QAMD0,"COND",QAMD1,0))
FOR QA=1:1:5
KILL ^QA(743,QAMD0,"COND",QAMD1,"P"_QA)
+11 DO EN3^QAMUTL0
if $DATA(Y)
GOTO 20
+12 KILL DR
SET DIE="^QA(743,"_QAMD0_",""COND"","
SET DR="1"
SET DA(1)=QAMD0
SET DA=QAMD1
DO ^DIE
GOTO 20
CONT FOR QAMD1=0:0
SET QAMD1=$ORDER(^UTILITY($JOB,"COND",QAMD1))
if QAMD1'>0
QUIT
IF ^UTILITY($JOB,"COND",QAMD1)'=$SELECT($DATA(^QA(743,QAMD0,"COND",QAMD1,0))#2:^(0),1:"")
DO DELR
GOTO ONWARD
+1 FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743,QAMD0,"COND",QAMD1))
if QAMD1'>0
QUIT
IF ^QA(743,QAMD0,"COND",QAMD1,0)'=$SELECT($DATA(^UTILITY($JOB,"COND",QAMD1))#2:^(QAMD1),1:"")
DO DELR
QUIT
ONWARD KILL ^UTILITY($JOB,"COND")
if $DATA(QAMOUT)
GOTO EN1
+1 if $SELECT($DATA(^QA(743,QAMD0,"COND",0))[0:1,$PIECE(^(0),"^",4)'>0:1,1:0)
GOTO C2
+2 WRITE !!,QAMSEPR8
SET DA=QAMD0
DO EN2^QAMUTL0
KILL DR
SET DIE="^QA(743,"
SET DR="25"
SET DA=QAMD0
DO ^DIE
if $DATA(Y)
GOTO EN1
+3 if '$DATA(^QA(743,QAMD0,"COND","AS",1))
GOTO C3
+4 WRITE !!,QAMSEPR8
SET DA=QAMD0
DO EN5^QAMUTL0
KILL DR
SET DIE="^QA(743,"
SET DR="26"
SET DA=QAMD0
DO ^DIE
if $DATA(Y)
GOTO EN1
C3 WRITE !!,QAMSEPR8
SET DA=QAMD0
DO EN1^QAMUTL1
KILL DR
SET DIE="^QA(743,"
SET DR="64"
SET DA=QAMD0
DO ^DIE
if $DATA(Y)
GOTO EN1
+1 WRITE !!,QAMSEPR8,!
C2 KILL DR
SET DIE="^QA(743,"
SET DR="50;52"
SET DA=QAMD0
DO ^DIE
if $DATA(Y)
GOTO EN1
+1 SET QAM=$SELECT($DATA(^QA(743,QAMD0,1))#2:$PIECE(^(1),"^",3),1:"")
KILL DR
SET DR="51"_$SELECT(QAM["%":";53",1:"T;53///@")_";63"
SET DIE="^QA(743,"
SET DA=QAMD0
DO ^DIE
if $DATA(Y)
GOTO EN1
C1 SET QAM=$SELECT($DATA(^QA(743,QAMD0,1))#2:$PIECE(^(1),"^",3),1:"")
KILL DR
SET DIE="^QA(743,"
SET DR="30;57//NO;58//NO;59//NO;60//NO;61"_$SELECT(QAM["%":"",1:"T")_"//NO"
SET DA=QAMD0
DO ^DIE
if $DATA(Y)
GOTO EN1
+1 SET QA=$SELECT($DATA(^QA(743,QAMD0,1))#2:^(1),1:"")
IF $PIECE(QA,"^",10)+$PIECE(QA,"^",11)+$PIECE(QA,"^",12)
KILL DR
SET DIE="^QA(743,"
SET DR="62"
SET DA=QAMD0
DO ^DIE
if $DATA(Y)
GOTO EN1
+2 KILL DR
SET DIE="^QA(743,"
SET DR="200;100;55;56;54//OFF"
SET DA=QAMD0
DO ^DIE
if $DATA(Y)
GOTO EN1
+3 SET QAMMSGS="EW"
DO ^QAMSANE
if Y=-1
GOTO EN1
WRITE !
+4 KILL DR
SET DIE="^QA(743,"
SET DR="7//UNDER CONSTRUCTION"
SET DA=QAMD0
DO ^DIE
+5 GOTO EN1
EXIT ;
+1 KILL %Y,D0,D1,DA,DI,DIC,DIE,DIK,DLAYGO,DQ,DR,J,QA,QAM,QAMAUTO,QAMD0,QAMOUT,QAMFIN,QAMSEPR8,QAMSVCND,X,Y
+2 QUIT
DELCR ; *** DELETE CONDITIONS AND RELATIONSHIP
+1 FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743,QAMD0,"COND",QAMD1))
if QAMD1'>0
QUIT
SET DA=QAMD1
SET DA(1)=QAMD0
SET DIK="^QA(743,"_DA(1)_",""COND"","
DO ^DIK
DELR KILL DR
SET DIE="^QA(743,"
SET DR="25///@;26///@;64///@"
SET DA=QAMD0
DO ^DIE
+1 QUIT
