GMRAUTL ;HIRMFO/YMP,RM,WAA-ALLERGY UTILITIES ;7/28/03  08:40
 ;;4.0;Adverse Reaction Tracking;**17**;Mar 29, 1996
DEV ;Device selecting module
 W !
 S GMRAZIS=$G(GMRAZIS)
 S IOP="Q",%ZIS("B")=""
 S %ZIS="NQ" I GMRAZIS'["Q",GMRAZIS'["M132" S %ZIS("B")="HOME" K IOP
 D ^%ZIS I POP K GMRAZIS Q  ; Select the device (not open)
 I '$D(IO("S")) D  I POP S POP=0 G DEV
 .I $E(IOST)="P",'$D(IO("Q")) W !?4,$C(7),"PRINTED REPORTS MUST BE QUEUED.",! S POP=1
 .Q
 I $G(GMRAZIS)?.E1"M"1N.E D  I POP S POP=0 G DEV
 .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
 .Q
 I $G(GMRAZIS)?.E1"S"1N.E D  I POP S POP=0 G DEV
 . 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
 .Q
 I '$D(IO("Q")) S IOP=ION_";"_IOST_";"_IOM_";"_IOSL,%ZIS="" D ^%ZIS I POP G DEV ; Open the device
 K GMRAZIS
 Q
CLOSE ; Close device, and dequeue if queued.
 I 'GMRAOUT D ENDPG^GMRADSP3
 W ! D ^%ZISC
 I $D(ZTQUEUED) S ZTREQ="@"
 Q
SITE ; GET SITE PARAMTER NODE
 S GMRASITE=$O(^GMRD(120.84,"SITE",+$G(DUZ(2)),0))
 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
 Q
LOCK(X,Y,Z) ; LOCKS ^GMR(X,Y,0).  IF IT CAN RETURNS 1, ELSE RETURNS 0
 ; OPTIONAL PAR. Z IF EXISTS AND TRUE WILL PRINT ERROR MSG IF NO LOCK
 L +^GMR(X,Y,0):1
 E  W:$G(Z) !,$C(7),"THIS ENTRY BEING EDITED, TRY LATER."
 Q $T
UNLOCK(X,Y) ; UNLOCKS ^GMR(X,Y,0)
 L -^GMR(X,Y,0)
 Q
OUTTYPE(GMRAY) ; INPUT VARIABLE IS INTERNAL FORMAT OF TYPE FIELD FOR
 ; FILES 120.8 AND 120.82.  THIS FUNCTION RETURNS OUTPUT VALUE
 ; FOR THAT FIELD.
 N FXN,X S FXN=""
 F X=1:1:$L(GMRAY) S FXN=FXN_$S(FXN="":"",1:", ")_$P("^FOOD^DRUG^OTHER","^",$F("FDO",$E(GMRAY,X)))
 Q FXN
INPTYPE(GMRAEN) ; THIS PROCEDURE WILL ALLOW USER TO EDIT TYPE FIELD FOR
 ; FILE AND ENTRY DESIGNATED IN GMRAEN.  GMRAEN IS IN VARIABLE PTR.
 ; FORMAT.
 Q:'+GMRAEN!("^GMRD(120.82,^GMR(120.8,^"'[("^"_$P(GMRAEN,";",2)_"^"))
 N DIE,DA,DR,GMRADEF
 S DIE="^"_$P(GMRAEN,";",2),DA=+GMRAEN,DR=$S(DIE[120.82:1,1:3.1)_"////"
 S GMRADEF=$P($G(@(DIE_DA_",0)")),"^",$S(DIE[120.82:2,1:20))
 D EDTTYPE(.GMRADEF)
 I "^^"[GMRADEF Q
 S DR=DR_GMRADEF D ^DIE
 Q
EDTTYPE(GMRADEF) ; THIS PROCEDURE WILL ALLOW EMULATE THE EDITING OF
 ; TYPE FIELD.  GMRADEF IS THE VARIABLE THAT WILL BE RETURNED, AND MUST
 ; BE PASSED BY REFERENCE.  IT SHOULD BE SET TO THE DEFAULT VALUE OF
 ; THE TYPE PRIOR TO THE EDIT AND WILL BE RETURNED AS THE NEW VALUE.
 ; GMRAOUT WILL BE SET TO 1 IF USER ABNORMALLY EXITS.
 Q:'$D(GMRADEF)
 N DIR,X,Y
 I GMRADEF'="" D
 .   S X=""
 .   I GMRADEF["D" S X=1
 .   I GMRADEF["F" S X=X_$S(X="":"",1:",")_2
 .   I GMRADEF["O" S X=X_$S(X="":"",1:",")_3
 .   S GMRADEF=X
 .   Q
ASKTYP ; This line is where the query for type begins.
 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
 S DIR("?")="This response must be a list or a range, e.g., 1,3 or 1-3."
 D ^DIR
 I $D(DIRUT) S GMRADEF="",GMRAOUT=1 Q
 S GMRADEF="" F X=1:1:3 I Y[X S GMRADEF=GMRADEF_$E("DFO",X)
 Q
INTTYPE(GMRAX) ; INPUT VARIABLE IS INTERNAL VALUE OF TYPE FIELD FOR FILES
 ; 120.8 AND 120.82.  THIS PROCEDURE WILL KILL GMRAX IF IT IS INVALID,
 ; OR WILL RETURN GMRAX IN ITS PROPER FORMAT.  GMRAX MUST BE PASSED BY
 ; REFERENCE.
 N FXN S FXN=1
 I $L(GMRAX)>3 D  ; take text entry ($L>3) and codify or reject
 .   N I,J,K
 .   S K="" F I=1:1 S J=$TR($$UP^XLFSTR($P(GMRAX,",",I))," ") Q:J=""  D
 .   .   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)
 .   .   E  S FXN=0
 .   .   Q
 .   I FXN S GMRAX=K
 .   Q
 E  D  ; take coded entry ($L'>3) and validates/formats
 .   I $L($TR(GMRAX,"DFO"))!'$L(GMRAX)!($L(GMRAX,"D")>2)!($L(GMRAX,"F")>2)!($L(GMRAX,"O")>2) S FXN=0 Q
 .   S GMRAX=$E("D",GMRAX["D")_$E("F",GMRAX["F")_$E("O",GMRAX["O")
 .   Q
 I 'FXN K GMRAX
 Q
ASK(GMRATYPE,GMRAOUT,GMRASP) ;Answer yes or no to data type questions
 N DIR,Y,X
 S DIR(0)="YA",DIR("A")=GMRATYPE
 S DIR("B")=$S(GMRASP=0:"NO",1:"YES") D ^DIR
 S:$D(DIRUT) GMRAOUT=1,GMRASP=0
 S:'GMRAOUT GMRASP=Y
 Q