QAMEDT7 ;HISC/DAD-PROGRAMMER EDIT DATA ELEMENTS FILE ;2/10/92 07:33
;;1.0;Clinical Monitoring System;;09/13/1993
D HOME^%ZIS
ASKELEM ;
S DIC="^QA(743.4,",DIC(0)="AELMNQ",DIC("A")="Select DATA ELEMENT: ",DLAYGO=743.4 W ! D ^DIC K DIC G:Y'>0 EXIT S (DA,QAMD0,QAMD0SAV)=+Y,DIE="^QA(743.4,",DR=".01;.03" D ^DIE W !
G ASKELEM:($D(DA)[0)!($D(Y)),ASKDD:$O(^QA(743.4,QAMD0,"DD",0))'>0
K QAMUNDL S QAMEDT7=1,QAMQUIT=0,$P(QAMUNDL,"=",81)="" D LOOP^QAMPINQ3 W ! S QAMD0=QAMD0SAV
ASKOK ;
W !,"Is the path to this data element OK" S %=1 D YN^DICN G DONE2:%=1,ASKELEM:%=-1 I '% W !!?5,"Enter Y(es) to leave the path unchanged.",!?5,"Enter N(o) to rebuild the path for this element.",! G ASKOK
W !!,"Deleting path to data element" F QAMD1=0:0 S QAMD1=$O(^QA(743.4,QAMD0,"DD",QAMD1)) Q:QAMD1'>0 S DIK="^QA(743.4,"_QAMD0_",""DD"",",(D0,DA(1))=QAMD0,(D1,DA)=QAMD1 D ^DIK W "."
W !
ASKDD ;
R !,"(SUB) DICT. #: ",X:DTIME S:('$T)!(X="") X="^" G:$E(X)="^" ASKELEM S (QAMDD,QAMDD(0))=$P(X,",")
I QAMDD'=+QAMDD W:$E(QAMDD)'="?" " ??",*7 W !!?5,"Enter the (sub) dictionary number where the field you want resides.",!?5,"You may enter (sub) Dictionary#,Field# if you wish to bypass the",!?5,"(SUB) FIELD # prompt (e.g. 2.98,.001).",! G ASKDD
I $D(^DD(QAMDD,0))[0 W " ??",*7,!!?5,"*** `",QAMDD,"' IS NOT A VALID (SUB) DICTIONARY NUMBER ***",! G ASKDD
W " ",$S($D(^DIC(QAMDD,0))#2:$P(^(0),"^")_" FILE",1:$P(^DD(QAMDD,0),"^")) I X["," S (QAMFLD,X)=$P(X,",",2) G FLD
ASKFLD ;
R !,"(SUB) FIELD #: ",X:DTIME S:('$T)!(X="") X="^" G:$E(X)="^" ASKELEM S QAMFLD=X
FLD I QAMFLD'=+QAMFLD W:$E(QAMFLD)'="?" " ??",*7 W !!?5,"Enter the (sub) field number for this data element.",! G ASKFLD
I $D(^DD(QAMDD,QAMFLD,0))[0 W " ??",*7,!!?5,"*** `",QAMFLD,"' IS NOT A VALID (SUB) FIELD NUMBER ***",! G ASKFLD
I $P(^DD(QAMDD,QAMFLD,0),"^",2) W " ??",*7,!!?5,"*** YOU MAY NOT PICK THE TOP FIELD OF A MULTIPLE ***",! G ASKFLD
W " ",$P(^DD(QAMDD,QAMFLD,0),"^"),!!,"Building path to data element" S QAMCOUNT=1 K QAMPATH
LOOP ;
W "." S QAMPATH(100-QAMCOUNT)=QAMDD_"^"_QAMFLD,QAMDD=$S($D(^DD(QAMDD,0,"UP"))#2:^("UP"),1:"") G:QAMDD'>0 DONE1 S QAMFLD=$O(^DD(QAMDD,"SB",QAMDD(0),0))
I QAMFLD'>0 W !!?5,"*** THERE IS A PROBLEM WITH THE",*7,!?5,"*** ^DD(",QAMDD,",""SB"",",QAMDD(0),",",!?5,"*** CROSS REFERENCE",*7,! G ASKELEM
S QAMDD(0)=QAMDD,QAMCOUNT=QAMCOUNT+1 G LOOP
DONE1 ;
S QAMPARNT=$P(^QA(743.4,QAMD0,0),"^",3),QAMPARNT(0)=$S($D(^DIC(QAMPARNT,0))#2:$P(^(0),"^"),1:"")
I $S($D(QAMPATH(100-QAMCOUNT))[0:1,+QAMPATH(100-QAMCOUNT)'=QAMPARNT:1,1:0) W !!,?5,"*** INVALID PATH FOR THE `",QAMPARNT(0),"' FILE (#",QAMPARNT,") ***",*7,! G ASKDD
S:$D(^QA(743.4,QAMD0,"DD",0))[0 ^(0)="^743.42A^^" S QAMCOUNT=0 F QA=0:0 S QA=$O(QAMPATH(QA)) Q:QA'>0 S QAMCOUNT=QAMCOUNT+1 S ^QA(743.4,QAMD0,"DD",QAMCOUNT,0)=QAMPATH(QA)_"^"_QAMCOUNT
S DIK="^QA(743.4,"_QAMD0_",""DD"",",(D0,DA(1))=QAMD0 D IXALL^DIK
K QAMUNDL S QAMEDT7=1,QAMQUIT=0,$P(QAMUNDL,"=",81)="" D LOOP^QAMPINQ3 S QAMD0=QAMD0SAV
DONE2 ;
S DIE="^QA(743.4,",DR="20;25;28;26;27;21;22;24;23;40",DA=QAMD0 W ! D ^DIE G ASKELEM
EXIT ;
K %,%Y,BY,D0,D1,DA,DHD,DIC,DIE,DIK,DIOEND,DLAYGO,DQ,DR,FLDS,FR,IOP,J,L,QA,QAM,QAMCOUNT,QAMD0,QAMD0SAV,QAMD1,QAMDATA,QAMDD,QAMEDT7,QAMELEM,QAMFILE,QAMFLD,QAMHDR1,QAMHDR2,QAMPARNT,QAMPATH,QAMQUIT,QAMUNDL,TO,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMEDT7 3300 printed Oct 16, 2024@17:43:16 Page 2
QAMEDT7 ;HISC/DAD-PROGRAMMER EDIT DATA ELEMENTS FILE ;2/10/92 07:33
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
+2 DO HOME^%ZIS
ASKELEM ;
+1 SET DIC="^QA(743.4,"
SET DIC(0)="AELMNQ"
SET DIC("A")="Select DATA ELEMENT: "
SET DLAYGO=743.4
WRITE !
DO ^DIC
KILL DIC
if Y'>0
GOTO EXIT
SET (DA,QAMD0,QAMD0SAV)=+Y
SET DIE="^QA(743.4,"
SET DR=".01;.03"
DO ^DIE
WRITE !
+2 if ($DATA(DA)[0)!($DATA(Y))
GOTO ASKELEM
if $ORDER(^QA(743.4,QAMD0,"DD",0))'>0
GOTO ASKDD
+3 KILL QAMUNDL
SET QAMEDT7=1
SET QAMQUIT=0
SET $PIECE(QAMUNDL,"=",81)=""
DO LOOP^QAMPINQ3
WRITE !
SET QAMD0=QAMD0SAV
ASKOK ;
+1 WRITE !,"Is the path to this data element OK"
SET %=1
DO YN^DICN
if %=1
GOTO DONE2
if %=-1
GOTO ASKELEM
IF '%
WRITE !!?5,"Enter Y(es) to leave the path unchanged.",!?5,"Enter N(o) to rebuild the path for this element.",!
GOTO ASKOK
+2 WRITE !!,"Deleting path to data element"
FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743.4,QAMD0,"DD",QAMD1))
if QAMD1'>0
QUIT
SET DIK="^QA(743.4,"_QAMD0_",""DD"","
SET (D0,DA(1))=QAMD0
SET (D1,DA)=QAMD1
DO ^DIK
WRITE "."
+3 WRITE !
ASKDD ;
+1 READ !,"(SUB) DICT. #: ",X:DTIME
if ('$TEST)!(X="")
SET X="^"
if $EXTRACT(X)="^"
GOTO ASKELEM
SET (QAMDD,QAMDD(0))=$PIECE(X,",")
+2 IF QAMDD'=+QAMDD
if $EXTRACT(QAMDD)'="?"
WRITE " ??",*7
WRITE !!?5,"Enter the (sub) dictionary number where the field you want resides.",!?5,"You may enter (sub) Dictionary#,Field# if you wish to bypass the",!?5,"(SUB) FIELD # prompt (e.g. 2.98,.001).",!
GOTO ASKDD
+3 IF $DATA(^DD(QAMDD,0))[0
WRITE " ??",*7,!!?5,"*** `",QAMDD,"' IS NOT A VALID (SUB) DICTIONARY NUMBER ***",!
GOTO ASKDD
+4 WRITE " ",$SELECT($DATA(^DIC(QAMDD,0))#2:$PIECE(^(0),"^")_" FILE",1:$PIECE(^DD(QAMDD,0),"^"))
IF X[","
SET (QAMFLD,X)=$PIECE(X,",",2)
GOTO FLD
ASKFLD ;
+1 READ !,"(SUB) FIELD #: ",X:DTIME
if ('$TEST)!(X="")
SET X="^"
if $EXTRACT(X)="^"
GOTO ASKELEM
SET QAMFLD=X
FLD IF QAMFLD'=+QAMFLD
if $EXTRACT(QAMFLD)'="?"
WRITE " ??",*7
WRITE !!?5,"Enter the (sub) field number for this data element.",!
GOTO ASKFLD
+1 IF $DATA(^DD(QAMDD,QAMFLD,0))[0
WRITE " ??",*7,!!?5,"*** `",QAMFLD,"' IS NOT A VALID (SUB) FIELD NUMBER ***",!
GOTO ASKFLD
+2 IF $PIECE(^DD(QAMDD,QAMFLD,0),"^",2)
WRITE " ??",*7,!!?5,"*** YOU MAY NOT PICK THE TOP FIELD OF A MULTIPLE ***",!
GOTO ASKFLD
+3 WRITE " ",$PIECE(^DD(QAMDD,QAMFLD,0),"^"),!!,"Building path to data element"
SET QAMCOUNT=1
KILL QAMPATH
LOOP ;
+1 WRITE "."
SET QAMPATH(100-QAMCOUNT)=QAMDD_"^"_QAMFLD
SET QAMDD=$SELECT($DATA(^DD(QAMDD,0,"UP"))#2:^("UP"),1:"")
if QAMDD'>0
GOTO DONE1
SET QAMFLD=$ORDER(^DD(QAMDD,"SB",QAMDD(0),0))
+2 IF QAMFLD'>0
WRITE !!?5,"*** THERE IS A PROBLEM WITH THE",*7,!?5,"*** ^DD(",QAMDD,",""SB"",",QAMDD(0),",",!?5,"*** CROSS REFERENCE",*7,!
GOTO ASKELEM
+3 SET QAMDD(0)=QAMDD
SET QAMCOUNT=QAMCOUNT+1
GOTO LOOP
DONE1 ;
+1 SET QAMPARNT=$PIECE(^QA(743.4,QAMD0,0),"^",3)
SET QAMPARNT(0)=$SELECT($DATA(^DIC(QAMPARNT,0))#2:$PIECE(^(0),"^"),1:"")
+2 IF $SELECT($DATA(QAMPATH(100-QAMCOUNT))[0:1,+QAMPATH(100-QAMCOUNT)'=QAMPARNT:1,1:0)
WRITE !!,?5,"*** INVALID PATH FOR THE `",QAMPARNT(0),"' FILE (#",QAMPARNT,") ***",*7,!
GOTO ASKDD
+3 if $DATA(^QA(743.4,QAMD0,"DD",0))[0
SET ^(0)="^743.42A^^"
SET QAMCOUNT=0
FOR QA=0:0
SET QA=$ORDER(QAMPATH(QA))
if QA'>0
QUIT
SET QAMCOUNT=QAMCOUNT+1
SET ^QA(743.4,QAMD0,"DD",QAMCOUNT,0)=QAMPATH(QA)_"^"_QAMCOUNT
+4 SET DIK="^QA(743.4,"_QAMD0_",""DD"","
SET (D0,DA(1))=QAMD0
DO IXALL^DIK
+5 KILL QAMUNDL
SET QAMEDT7=1
SET QAMQUIT=0
SET $PIECE(QAMUNDL,"=",81)=""
DO LOOP^QAMPINQ3
SET QAMD0=QAMD0SAV
DONE2 ;
+1 SET DIE="^QA(743.4,"
SET DR="20;25;28;26;27;21;22;24;23;40"
SET DA=QAMD0
WRITE !
DO ^DIE
GOTO ASKELEM
EXIT ;
+1 KILL %,%Y,BY,D0,D1,DA,DHD,DIC,DIE,DIK,DIOEND,DLAYGO,DQ,DR,FLDS,FR,IOP,J,L,QA,QAM,QAMCOUNT,QAMD0,QAMD0SAV,QAMD1,QAMDATA,QAMDD,QAMEDT7,QAMELEM,QAMFILE,QAMFLD,QAMHDR1,QAMHDR2,QAMPARNT,QAMPATH,QAMQUIT,QAMUNDL,TO,X,Y
+2 QUIT
