| 1 | QAMGPOP0 ;HISC/DAD-BUILD A PATIENT GROUP FROM A FM SEARCH ;9/3/93 13:20
|
|---|
| 2 | ;;1.0;Clinical Monitoring System;;09/13/1993
|
|---|
| 3 | EN ;
|
|---|
| 4 | K DIC S DIC="^QA(743.5,",DIC(0)="AELMNQZ",DIC("A")="Select GROUP: ",DIC("DR")=".02////2",DIC("S")="I $P(^(0),""^"",2)=2",DLAYGO=743.5
|
|---|
| 5 | W ! D ^DIC G:Y'>0 EXIT S QAMGRPD0=+Y,QAMGNAM=Y(0,0)
|
|---|
| 6 | I $O(^QA(743.5,QAMGRPD0,"GRP",0)) D G EXIT:QAMQUIT=1,EN:QAMQUIT=2
|
|---|
| 7 | . K DIR S DIR(0)="SO^M:Merge data;D:Delete data;"
|
|---|
| 8 | . S DIR("A",1)="This group already contains group members."
|
|---|
| 9 | . S DIR("A",2)="Should the newly found entries be merged with"
|
|---|
| 10 | . S DIR("A",3)="the existing entries or should the old entries"
|
|---|
| 11 | . S DIR("A",4)="be deleted prior to the search?",DIR("A",5)=""
|
|---|
| 12 | . S DIR("A")="Delete or Merge"
|
|---|
| 13 | . D ^DIR
|
|---|
| 14 | . S QAMQUIT=$S($D(DTOUT):1,$D(DUOUT):1,$D(DIROUT):1,$D(DIRUT):2,1:0)
|
|---|
| 15 | . Q:Y="M"!QAMQUIT
|
|---|
| 16 | . K ^QA(743.5,QAMGRPD0,"GRP")
|
|---|
| 17 | . Q
|
|---|
| 18 | K DIC S DIC="^DIC(",DIC(0)="AEMNQZ",DIC("A")="Select FILE TO SEARCH: ",DIC("S")="I $D(^DIC(""AC"",""QAM"",+Y))"
|
|---|
| 19 | W ! D ^DIC G:Y'>0 EXIT S QAMFILE=+Y
|
|---|
| 20 | W !!,"Searching the ",Y(0,0)," file (#",+Y,")"
|
|---|
| 21 | S DIC=QAMFILE K ^TMP("QAM",$J) D EN^DIS
|
|---|
| 22 | I $D(^QA(743.5,QAMGRPD0,"GRP",0))[0 S ^(0)="^743.51A^^"
|
|---|
| 23 | S QAMCOUNT=$P(^QA(743.5,QAMGRPD0,"GRP",0),"^",4)
|
|---|
| 24 | S QAMTHIRD=$P(^QA(743.5,QAMGRPD0,"GRP",0),"^",3),QAMGRPD1=QAMTHIRD+1
|
|---|
| 25 | W !!,"Building the ",QAMGNAM," group . . ."
|
|---|
| 26 | F QAMIEN=0:0 S QAMIEN=$O(^TMP("QAM",$J,QAMIEN)) Q:QAMIEN'>0 D
|
|---|
| 27 | . Q:$O(^QA(743.5,QAMGRPD0,"GRP","AB",QAMIEN,0))
|
|---|
| 28 | . F QAMGRPD1=QAMGRPD1:1 L +^QA(743.5,QAMGRPD0,"GRP",QAMGRPD1,0):0 Q:$T&($D(^QA(743.5,QAMGRPD0,"GRP",QAMGRPD1,0))[0) L -^QA(743.5,QAMGRPD0,"GRP",QAMGRPD1,0)
|
|---|
| 29 | . S X=^TMP("QAM",$J,QAMIEN)_";"_QAMIEN
|
|---|
| 30 | . S ^QA(743.5,QAMGRPD0,"GRP",QAMGRPD1,0)=X
|
|---|
| 31 | . L -^QA(743.5,QAMGRPD0,"GRP",QAMGRPD1,0)
|
|---|
| 32 | . S QAQADICT=743.51,QAQAFLD=.01,(D0,DA(1))=QAMGRPD0,(D1,DA)=QAMGRPD1
|
|---|
| 33 | . D ENSET^QAQAXREF
|
|---|
| 34 | . S QAMCOUNT=QAMCOUNT+1
|
|---|
| 35 | . Q
|
|---|
| 36 | S $P(^QA(743.5,QAMGRPD0,"GRP",0),"^",3,4)=$S($G(QAMGRPD1):QAMGRPD1,1:QAMTHIRD)_"^"_QAMCOUNT
|
|---|
| 37 | I $O(^TMP("QAM",$J,0))'>0 W !!,"No group entries were created !!"
|
|---|
| 38 | I $O(^QA(743.5,QAMGRPD0,"GRP",0))'>0 D
|
|---|
| 39 | . W " Deleting the ",QAMGNAM," group."
|
|---|
| 40 | . S DIK="^QA(743.5,",DA=QAMGRPD0 D ^DIK
|
|---|
| 41 | . Q
|
|---|
| 42 | EXIT ;
|
|---|
| 43 | K DA,DIC,DIK,QAMCOUNT,QAMFILE,QAMGNAM,QAMGRPD0,QAMGRPD1,QAMIEN,QAMTHIRD,QAQDICT,QAQFLD,X,Y,^TMP("QAM",$J)
|
|---|
| 44 | Q
|
|---|
