source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAUTL.m@ 1800

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

initial load of WorldVistAEHR

File size: 4.2 KB
RevLine 
[613]1GMRAUTL ;HIRMFO/YMP,RM,WAA-ALLERGY UTILITIES ;7/28/03 08:40
2 ;;4.0;Adverse Reaction Tracking;**17**;Mar 29, 1996
3DEV ;Device selecting module
4 W !
5 S GMRAZIS=$G(GMRAZIS)
6 S IOP="Q",%ZIS("B")=""
7 S %ZIS="NQ" I GMRAZIS'["Q",GMRAZIS'["M132" S %ZIS("B")="HOME" K IOP
8 D ^%ZIS I POP K GMRAZIS Q ; Select the device (not open)
9 I '$D(IO("S")) D I POP S POP=0 G DEV
10 .I $E(IOST)="P",'$D(IO("Q")) W !?4,$C(7),"PRINTED REPORTS MUST BE QUEUED.",! S POP=1
11 .Q
12 I $G(GMRAZIS)?.E1"M"1N.E D I POP S POP=0 G DEV
13 .I IOM<+$P(GMRAZIS,"M",2) W !!?4,$C(7),"THIS REPORT MUST BE SENT TO A PRINTER WITH A MARGIN OF AT LEAST "_+$P(GMRAZIS,"M",2)_"." S POP=1
14 .Q
15 I $G(GMRAZIS)?.E1"S"1N.E D I POP S POP=0 G DEV
16 . I IOSL<+$P(GMRAZIS,"S",2) W !!?4,$C(7),"THIS REPORT MUST BE SENT TO A PRINTER WITH PAGE LENGTH OF AT LEAST "_+$P(GMRAZIS,"S",2)_"." S POP=1
17 .Q
18 I '$D(IO("Q")) S IOP=ION_";"_IOST_";"_IOM_";"_IOSL,%ZIS="" D ^%ZIS I POP G DEV ; Open the device
19 K GMRAZIS
20 Q
21CLOSE ; Close device, and dequeue if queued.
22 I 'GMRAOUT D ENDPG^GMRADSP3
23 W ! D ^%ZISC
24 I $D(ZTQUEUED) S ZTREQ="@"
25 Q
26SITE ; GET SITE PARAMTER NODE
27 S GMRASITE=$O(^GMRD(120.84,"SITE",+$G(DUZ(2)),0))
28 I 'GMRASITE S GMRASITE=$O(^GMRD(120.84,"B","HOSPITAL",0)) I 'GMRASITE S GMRASITE=$O(^GMRD(120.84,0)) I 'GMRASITE S GMRASITE=1
29 Q
30LOCK(X,Y,Z) ; LOCKS ^GMR(X,Y,0). IF IT CAN RETURNS 1, ELSE RETURNS 0
31 ; OPTIONAL PAR. Z IF EXISTS AND TRUE WILL PRINT ERROR MSG IF NO LOCK
32 L +^GMR(X,Y,0):1
33 E W:$G(Z) !,$C(7),"THIS ENTRY BEING EDITED, TRY LATER."
34 Q $T
35UNLOCK(X,Y) ; UNLOCKS ^GMR(X,Y,0)
36 L -^GMR(X,Y,0)
37 Q
38OUTTYPE(GMRAY) ; INPUT VARIABLE IS INTERNAL FORMAT OF TYPE FIELD FOR
39 ; FILES 120.8 AND 120.82. THIS FUNCTION RETURNS OUTPUT VALUE
40 ; FOR THAT FIELD.
41 N FXN,X S FXN=""
42 F X=1:1:$L(GMRAY) S FXN=FXN_$S(FXN="":"",1:", ")_$P("^FOOD^DRUG^OTHER","^",$F("FDO",$E(GMRAY,X)))
43 Q FXN
44INPTYPE(GMRAEN) ; THIS PROCEDURE WILL ALLOW USER TO EDIT TYPE FIELD FOR
45 ; FILE AND ENTRY DESIGNATED IN GMRAEN. GMRAEN IS IN VARIABLE PTR.
46 ; FORMAT.
47 Q:'+GMRAEN!("^GMRD(120.82,^GMR(120.8,^"'[("^"_$P(GMRAEN,";",2)_"^"))
48 N DIE,DA,DR,GMRADEF
49 S DIE="^"_$P(GMRAEN,";",2),DA=+GMRAEN,DR=$S(DIE[120.82:1,1:3.1)_"////"
50 S GMRADEF=$P($G(@(DIE_DA_",0)")),"^",$S(DIE[120.82:2,1:20))
51 D EDTTYPE(.GMRADEF)
52 I "^^"[GMRADEF Q
53 S DR=DR_GMRADEF D ^DIE
54 Q
55EDTTYPE(GMRADEF) ; THIS PROCEDURE WILL ALLOW EMULATE THE EDITING OF
56 ; TYPE FIELD. GMRADEF IS THE VARIABLE THAT WILL BE RETURNED, AND MUST
57 ; BE PASSED BY REFERENCE. IT SHOULD BE SET TO THE DEFAULT VALUE OF
58 ; THE TYPE PRIOR TO THE EDIT AND WILL BE RETURNED AS THE NEW VALUE.
59 ; GMRAOUT WILL BE SET TO 1 IF USER ABNORMALLY EXITS.
60 Q:'$D(GMRADEF)
61 N DIR,X,Y
62 I GMRADEF'="" D
63 . S X=""
64 . I GMRADEF["D" S X=1
65 . I GMRADEF["F" S X=X_$S(X="":"",1:",")_2
66 . I GMRADEF["O" S X=X_$S(X="":"",1:",")_3
67 . S GMRADEF=X
68 . Q
69ASKTYP ; This line is where the query for type begins.
70 S DIR(0)="LA^1:3",DIR("A",1)=" 1 Drug",DIR("A",2)=" 2 Food",DIR("A",3)=" 3 Other",DIR("A")="Select Classification(s) of Causative Agent: " S:GMRADEF'="" DIR("B")=GMRADEF
71 S DIR("?")="This response must be a list or a range, e.g., 1,3 or 1-3."
72 D ^DIR
73 I $D(DIRUT) S GMRADEF="",GMRAOUT=1 Q
74 S GMRADEF="" F X=1:1:3 I Y[X S GMRADEF=GMRADEF_$E("DFO",X)
75 Q
76INTTYPE(GMRAX) ; INPUT VARIABLE IS INTERNAL VALUE OF TYPE FIELD FOR FILES
77 ; 120.8 AND 120.82. THIS PROCEDURE WILL KILL GMRAX IF IT IS INVALID,
78 ; OR WILL RETURN GMRAX IN ITS PROPER FORMAT. GMRAX MUST BE PASSED BY
79 ; REFERENCE.
80 N FXN S FXN=1
81 I $L(GMRAX)>3 D ; take text entry ($L>3) and codify or reject
82 . N I,J,K
83 . S K="" F I=1:1 S J=$TR($$UP^XLFSTR($P(GMRAX,",",I))," ") Q:J="" D
84 . . I "^DRUG^FOOD^OTHER^"[("^"_J_"^") S J=$E(J) I K'[J S K=$S(J="D":J_K,J="F":$E("D",K["D")_J_$E("O",K["O"),1:K_J)
85 . . E S FXN=0
86 . . Q
87 . I FXN S GMRAX=K
88 . Q
89 E D ; take coded entry ($L'>3) and validates/formats
90 . I $L($TR(GMRAX,"DFO"))!'$L(GMRAX)!($L(GMRAX,"D")>2)!($L(GMRAX,"F")>2)!($L(GMRAX,"O")>2) S FXN=0 Q
91 . S GMRAX=$E("D",GMRAX["D")_$E("F",GMRAX["F")_$E("O",GMRAX["O")
92 . Q
93 I 'FXN K GMRAX
94 Q
95ASK(GMRATYPE,GMRAOUT,GMRASP) ;Answer yes or no to data type questions
96 N DIR,Y,X
97 S DIR(0)="YA",DIR("A")=GMRATYPE
98 S DIR("B")=$S(GMRASP=0:"NO",1:"YES") D ^DIR
99 S:$D(DIRUT) GMRAOUT=1,GMRASP=0
100 S:'GMRAOUT GMRASP=Y
101 Q
Note: See TracBrowser for help on using the repository browser.