source: WorldVistAEHR/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMUTL0.m@ 789

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

initial load of WorldVistAEHR
File size: 3.5 KB
RevLine 
[613]1QAMUTL0 ;HISC/DAD-MONITORING TOOL UTILITIES ;10/22/93 08:34
2 ;;1.0;Clinical Monitoring System;**1**;09/13/1993
3EN1 ; *** CHECKS FOR A VALID RELATIONSHIP AMONG THE CONDITIONS
4 ; *** USED BY FIELD: 743,25
5 N C S QAM("X")=X G:$TR(X,"(C!'&0123456789)")]"" XBAD1 G:X?1.N XBAD1
6 S X="I "_QAM("X") D ^DIM G:'$D(X) XBAD1 S QAM("C")=""
7 F QAM=0:0 S QAM=$O(^QA(743,D0,"COND",QAM)) Q:QAM'>0 S @("C"_QAM_"=1") S QAM("C")=QAM("C")_"C"_QAM_"^"
8 S X="XBAD1^QAMUTL0",@^%ZOSF("TRAP") S X="I "_QAM("X") X X
9 ;F QAM=1:1 Q:$P(QAM("C"),"^",QAM)="" G:X'[$P(QAM("C"),"^",QAM) XBAD1
10XOK1 S X="",@^%ZOSF("TRAP"),X=QAM("X") K QAM G 1
11XBAD1 S X="",@^%ZOSF("TRAP") K QAM,X
121 F QAM=0:0 S QAM=$O(^QA(743,D0,"COND",QAM)) Q:QAM'>0 K @("C"_QAM)
13 Q
14EN2 ; *** DISPLAY HELP SCREEN OF CONDITIONS
15 ; *** USED BEFORE EDIT OF FALL OUT RELATIONSHIP FIELD (743,25)
16 Q:$D(^QA(743,DA,"COND",0))[0 Q:$P(^(0),"^",4)'>0
17 W !!?3,"CODE",?15,"CONDITION",!?2,"------",?14,"-----------"
18 F QAMD1=0:0 S QAMD1=$O(^QA(743,DA,"COND",QAMD1)) Q:QAMD1'>0 S QAM=$S($D(^QA(743,DA,"COND",QAMD1,0))#2:+^(0),1:0),QAM=$S($D(^QA(743.3,QAM,0))#2:$P(^(0),"^"),1:"") W !?3,$J("C"_QAMD1,3),?15,QAM
19 W !
20 Q
21EN3 ; *** ASK PARAMETERS ON CONDITIONS
22 ; *** USED BY ALL EDITS ON THE CONDITION MULTIPLE
23 K Y
24 S QAM=+$S($D(^QA(743,QAMD0,"COND",QAMD1,0))#2:^(0),1:0) Q:QAM'>0
25 Q:$P($G(^QA(743.3,QAM,0)),"^",2)'>0
26 S QAMPCODE=$S($D(^QA(743.3,QAM,"PARM"))#2:^("PARM"),1:"") Q:QAMPCODE=""
27 S X=$P(QAMPCODE,"^",$L(QAMPCODE,"^")) X ^%ZOSF("TEST") I X QAMPCODE
28 Q
29EN4 ; *** CHECKS FOR A VALID RELATIONSHIP AMONG THE CONDITIONS
30 ; *** USED BY FIELD: 743,26
31 Q:'$D(^QA(743,D0,"COND","AS",1))
32 N C S QAM("X")=X G:$TR(X,"(C!'&0123456789)")]"" XBAD4 G:X?1.N XBAD4
33 S X="I "_QAM("X") D ^DIM G:'$D(X) XBAD4 S QAM("C")=""
34 F QAM=0:0 S QAM=$O(^QA(743,D0,"COND",QAM)) Q:QAM'>0 I $P(^QA(743,D0,"COND",QAM,0),"^",2) S @("C"_QAM_"=1") S QAM("C")=QAM("C")_"C"_QAM_"^"
35 S X="XBAD4^QAMUTL0",@^%ZOSF("TRAP") S X="I "_QAM("X") X X
36 ;F QAM=1:1 Q:$P(QAM("C"),"^",QAM)="" G:X'[$P(QAM("C"),"^",QAM) XBAD4
37XOK4 S X="",@^%ZOSF("TRAP"),X=QAM("X") K QAM G 4
38XBAD4 S X="",@^%ZOSF("TRAP") K QAM,X
394 F QAM=0:0 S QAM=$O(^QA(743,D0,"COND",QAM)) Q:QAM'>0 K @("C"_QAM)
40 Q
41EN5 ; *** DISPLAY HELP SCREEN OF CONDITIONS
42 ; *** USED BEFORE EDIT OF SAMPLE RELATIONSHIP FIELD (743,26)
43 Q:$D(^QA(743,DA,"COND",0))[0 Q:$P(^(0),"^",4)'>0 Q:'$D(^QA(743,DA,"COND","AS",1))
44 W !!?3,"CODE",?15,"CONDITION",!?2,"------",?14,"-----------"
45 F QAMD1=0:0 S QAMD1=$O(^QA(743,DA,"COND",QAMD1)) Q:QAMD1'>0 S QAM=$S($D(^QA(743,DA,"COND",QAMD1,0))#2:^(0),1:0) I $P(QAM,"^",2) S QAM=$S($D(^QA(743.3,+QAM,0))#2:$P(^(0),"^"),1:"") W !?3,$J("C"_QAMD1,3),?15,QAM
46 W !
47 Q
48EN6 ; *** MOST RECENT PATIENT MOVEMENT (FILE #405)
49 ; *** USED AS DATA BY FIELD 743.4,40
50 ; PUT MOST DESIRED TRANSACTION TYPES AT THE BEGINNING OF QAMXREF E.G.
51 ; QAMXREF="6^2^1^3" SCAN: SPECIALTY XFR, WARD XFR, ADMISSION, DISCHARGE
52 S QAMDTPT(1)=0 Q:$D(QAMXREF)[0
53 F QA=1:1:$L(QAMXREF,"^") S QA(0)=$P(QAMXREF,"^",QA),QAM=+$O(^DGPM("ATID"_QA(0),QAMDFN,9999999.9999998-QAMEVENT)),QAMDTPT(1)=+$O(^DGPM("ATID"_QA(0),QAMDFN,QAM,0)) Q:QAMDTPT(1)
54 K QAMXREF Q
55EN7 ; *** SCREEN FOR OTHER DATA TO CAPTURE, USED BY FIELD 743,30
56 I 0
57 F QA=0:0 S QA=$O(^QA(743.3,"AELEM",+Y,QA)) Q:QA'>0 I $O(^QA(743,D0,"COND","B",QA,0))>0 Q
58 K QA Q
59EN8 ; *** INPUT TRANSFORM FOR GROUP MEMBER SUB-FIELD 743.51,.01
60 N D,DIC,DICR,DIX,DO,Y S X=$S(X[";":$P(X,";"),1:X),Y=-1,DIC(0)="EMQZ",DIC=$S($D(^QA(743.5,DA(1),0))#2:+$P(^(0),"^",2),1:0),DIC=$S($D(^DIC(DIC,0,"GL"))#2:^("GL"),1:"") G:DIC="" 8 D DO^DIC1,^DIC S X=$S($D(Y(0,0))#2:Y(0,0)_";"_+Y,1:"")
618 K:Y'>0 X Q
Note: See TracBrowser for help on using the repository browser.