Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRAUTL

GMRAUTL.m

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