source: WorldVistAEHR/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMGPOP0.m@ 1261

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

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1QAMGPOP0 ;HISC/DAD-BUILD A PATIENT GROUP FROM A FM SEARCH ;9/3/93 13:20
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3EN ;
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
42EXIT ;
43 K DA,DIC,DIK,QAMCOUNT,QAMFILE,QAMGNAM,QAMGRPD0,QAMGRPD1,QAMIEN,QAMTHIRD,QAQDICT,QAQFLD,X,Y,^TMP("QAM",$J)
44 Q
Note: See TracBrowser for help on using the repository browser.