source: FOIAVistA/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMEDT7.m@ 1608

Last change on this file since 1608 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1QAMEDT7 ;HISC/DAD-PROGRAMMER EDIT DATA ELEMENTS FILE ;2/10/92 07:33
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3 D HOME^%ZIS
4ASKELEM ;
5 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 !
6 G ASKELEM:($D(DA)[0)!($D(Y)),ASKDD:$O(^QA(743.4,QAMD0,"DD",0))'>0
7 K QAMUNDL S QAMEDT7=1,QAMQUIT=0,$P(QAMUNDL,"=",81)="" D LOOP^QAMPINQ3 W ! S QAMD0=QAMD0SAV
8ASKOK ;
9 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
10 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 "."
11 W !
12ASKDD ;
13 R !,"(SUB) DICT. #: ",X:DTIME S:('$T)!(X="") X="^" G:$E(X)="^" ASKELEM S (QAMDD,QAMDD(0))=$P(X,",")
14 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
15 I $D(^DD(QAMDD,0))[0 W " ??",*7,!!?5,"*** `",QAMDD,"' IS NOT A VALID (SUB) DICTIONARY NUMBER ***",! G ASKDD
16 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
17ASKFLD ;
18 R !,"(SUB) FIELD #: ",X:DTIME S:('$T)!(X="") X="^" G:$E(X)="^" ASKELEM S QAMFLD=X
19FLD I QAMFLD'=+QAMFLD W:$E(QAMFLD)'="?" " ??",*7 W !!?5,"Enter the (sub) field number for this data element.",! G ASKFLD
20 I $D(^DD(QAMDD,QAMFLD,0))[0 W " ??",*7,!!?5,"*** `",QAMFLD,"' IS NOT A VALID (SUB) FIELD NUMBER ***",! G ASKFLD
21 I $P(^DD(QAMDD,QAMFLD,0),"^",2) W " ??",*7,!!?5,"*** YOU MAY NOT PICK THE TOP FIELD OF A MULTIPLE ***",! G ASKFLD
22 W " ",$P(^DD(QAMDD,QAMFLD,0),"^"),!!,"Building path to data element" S QAMCOUNT=1 K QAMPATH
23LOOP ;
24 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))
25 I QAMFLD'>0 W !!?5,"*** THERE IS A PROBLEM WITH THE",*7,!?5,"*** ^DD(",QAMDD,",""SB"",",QAMDD(0),",",!?5,"*** CROSS REFERENCE",*7,! G ASKELEM
26 S QAMDD(0)=QAMDD,QAMCOUNT=QAMCOUNT+1 G LOOP
27DONE1 ;
28 S QAMPARNT=$P(^QA(743.4,QAMD0,0),"^",3),QAMPARNT(0)=$S($D(^DIC(QAMPARNT,0))#2:$P(^(0),"^"),1:"")
29 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
30 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
31 S DIK="^QA(743.4,"_QAMD0_",""DD"",",(D0,DA(1))=QAMD0 D IXALL^DIK
32 K QAMUNDL S QAMEDT7=1,QAMQUIT=0,$P(QAMUNDL,"=",81)="" D LOOP^QAMPINQ3 S QAMD0=QAMD0SAV
33DONE2 ;
34 S DIE="^QA(743.4,",DR="20;25;28;26;27;21;22;24;23;40",DA=QAMD0 W ! D ^DIE G ASKELEM
35EXIT ;
36 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
37 Q
Note: See TracBrowser for help on using the repository browser.