| 1 | GMRAUTL ;HIRMFO/YMP,RM,WAA-ALLERGY UTILITIES ;7/28/03 08:40
|
|---|
| 2 | ;;4.0;Adverse Reaction Tracking;**17**;Mar 29, 1996
|
|---|
| 3 | DEV ;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
|
|---|
| 21 | CLOSE ; Close device, and dequeue if queued.
|
|---|
| 22 | I 'GMRAOUT D ENDPG^GMRADSP3
|
|---|
| 23 | W ! D ^%ZISC
|
|---|
| 24 | I $D(ZTQUEUED) S ZTREQ="@"
|
|---|
| 25 | Q
|
|---|
| 26 | SITE ; 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
|
|---|
| 30 | LOCK(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
|
|---|
| 35 | UNLOCK(X,Y) ; UNLOCKS ^GMR(X,Y,0)
|
|---|
| 36 | L -^GMR(X,Y,0)
|
|---|
| 37 | Q
|
|---|
| 38 | OUTTYPE(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
|
|---|
| 44 | INPTYPE(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
|
|---|
| 55 | EDTTYPE(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
|
|---|
| 69 | ASKTYP ; 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
|
|---|
| 76 | INTTYPE(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
|
|---|
| 95 | ASK(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
|
|---|
