124 lines
5.9 KiB
Mathematica
124 lines
5.9 KiB
Mathematica
ORWDAL32 ; SLC/REV - Allergy calls to support windows ;5/31/05 14:14
|
|
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,190,195,233**;Dec 17, 1997
|
|
;
|
|
DEF(LST) ; Get dialog data for allergies
|
|
N ILST,I,X S ILST=0
|
|
S LST($$NXT)="~Allergy Types" D ALLGYTYP
|
|
S LST($$NXT)="~Reactions" D ALLGYTYP
|
|
S LST($$NXT)="~Nature of Reaction" D NATREACT
|
|
S LST($$NXT)="~Top Ten" D TOPTEN
|
|
S LST($$NXT)="~Observ/Hist" D OBSHIST
|
|
S LST($$NXT)="~Severity" D SEVERITY
|
|
Q
|
|
GMRASITE(ORY) ;Return GMRA Site Params
|
|
N GMRASITE
|
|
D SITE^GMRAUTL
|
|
S ORY=$G(^GMRD(120.84,GMRASITE,0))
|
|
Q
|
|
TOPTEN ; Get top ten symptoms from Allergy Site Parameters file
|
|
N X0,I,CNT,GMRASITE S I=0,X0="",CNT=0 ;233
|
|
D SITE^GMRAUTL ;233
|
|
F S I=$O(^GMRD(120.84,GMRASITE,1,I)),CNT=CNT+1 Q:+I=0!(CNT>10) D ;233
|
|
. S X0=^GMRD(120.84,GMRASITE,1,I,0) Q:'$D(^GMRD(120.83,X0)) Q:$P(^GMRD(120.83,X0,0),"^")="OTHER REACTION" ;233 Don't send this entry
|
|
. I $L($T(SCREEN^XTID)) Q:$$SCREEN^XTID(120.83,.01,X0_",") ;233 Don't send if inactive term
|
|
. S LST($$NXT)="i"_X0_U_$P($G(^GMRD(120.83,X0,0)),U,1)
|
|
Q
|
|
ALLSRCH(Y,X) ; Return list of partial matches ; CHANGED TO PRODUCE TREEVIEW IN GUI
|
|
N ORX,ROOT,XP,CNT,ORFILE,ORSRC,ORIEN,ORREAX S ORIEN=0,CNT=0,ORSRC=0,ORFILE="",ORREAX=""
|
|
S ORX=X,X=$$UP^XLFSTR(X)
|
|
F ROOT="^GMRD(120.82,""B"")","^GMRD(120.82,""D"")",$$B^PSNAPIS,$$T^PSNAPIS,"^PSDRUG(""B"")","^PSDRUG(""C"")","^PS(50.416,""P"")","^PS(50.605,""C"")" D
|
|
. S ORSRC=ORSRC+1,ORFILE=$P(ROOT,",",1)_")",ORSRC(ORSRC)=$P($T(FILENAME+ORSRC),";;",2)
|
|
. I (ORSRC'=2),(ORSRC'=6) S CNT=CNT+1,Y(CNT)=ORSRC_U_ORSRC(ORSRC)_U_U_U_"TOP"_U_"+"
|
|
. I $D(@ROOT@(X)) D
|
|
. . I ORSRC=1,X="OTHER ALLERGY/ADVERSE REACTION" Q ;don't send this entry
|
|
. . I ORSRC=5!(ORSRC=6) Q ;233 don't send file 50 entries
|
|
. . S ORIEN=$O(@ROOT@(X,0))
|
|
. . I $L($T(SCREEN^XTID)) I $$SCREEN^XTID($S(ORSRC=1!(ORSRC=2):120.82,ORSRC=3!(ORSRC=4):50.6,ORSRC=7:50.416,ORSRC=8:50.605,1:0),.01,$S(ORSRC=4:$$TGTOG^PSNAPIS(X)_",",1:ORIEN_",")) Q ;233 Is term active?
|
|
. . I ORSRC=2 S CNT=CNT+1,Y(CNT)=ORIEN_U_$P($G(^GMRD(120.82,+ORIEN,0)),U,1)_" <"_X_">"_ROOT
|
|
. . E I ORSRC=6 S CNT=CNT+1,Y(CNT)=ORIEN_U_$P($G(^PSDRUG(+ORIEN,0)),U,1)_" <"_X_">"_ROOT
|
|
. . E S CNT=CNT+1,Y(CNT)=ORIEN_U_X_ROOT
|
|
. . S ORREAX=$S($P(Y(CNT),U,3)?1"GMR".E:$P($G(^GMRD(120.82,+Y(CNT),0)),U,2),1:"D")
|
|
. . S Y(CNT)=Y(CNT)_U_ORREAX_U_$S(ORSRC=2:1,ORSRC=6:5,1:ORSRC)
|
|
. S XP=X F S XP=$O(@ROOT@(XP)) Q:XP="" Q:$E(XP,1,$L(X))'=X D
|
|
. . I ORSRC=1,XP="OTHER ALLERGY/ADVERSE REACTION" Q ;don't send this entry
|
|
. . I ORSRC=5!(ORSRC=6) Q ;233 Don't send file 50 entries
|
|
. . S ORIEN=$O(@ROOT@(XP,0))
|
|
. . I $L($T(SCREEN^XTID)) I $$SCREEN^XTID($S(ORSRC=1!(ORSRC=2):120.82,ORSRC=3!(ORSRC=4):50.6,ORSRC=7:50.416,ORSRC=8:50.605,1:0),.01,$S(ORSRC=4:$$TGTOG^PSNAPIS(XP)_",",1:ORIEN_",")) Q ;233 Is term active?
|
|
. . I ORSRC=2 S CNT=CNT+1,Y(CNT)=ORIEN_U_$P($G(^GMRD(120.82,+ORIEN,0)),U,1)_" <"_XP_">"_ROOT ; partial matches
|
|
. . E I ORSRC=6 S CNT=CNT+1,Y(CNT)=ORIEN_U_$P($G(^PSDRUG(+ORIEN,0)),U,1)_" <"_XP_">"_ROOT ; partial matches
|
|
. . E S CNT=CNT+1,Y(CNT)=ORIEN_U_XP_ROOT
|
|
. . S ORREAX=$S($P(Y(CNT),U,3)?1"GMR".E:$P($G(^GMRD(120.82,+Y(CNT),0)),U,2),1:"D")
|
|
. . S Y(CNT)=Y(CNT)_U_ORREAX_U_$S(ORSRC=2:1,ORSRC=6:5,1:ORSRC)
|
|
Q
|
|
FILENAME ; Display text of filenames for search treeview
|
|
;;VA Allergies File
|
|
;;VA Allergies File (Synonyms) SPACER ONLY - NOT DISPLAYED
|
|
;;National Drug File - Generic Drug Name
|
|
;;National Drug file - Trade Name
|
|
;;Local Drug File
|
|
;;Local Drug File (Synonyms) SPACER ONLY - NOT DISPLAYED
|
|
;;Drug Ingredients File
|
|
;;VA Drug Class File
|
|
;;
|
|
NATREACT ; Get the NATURE OF REACTION types
|
|
;Removing "R^Adverse Reaction" from choices below until we can add it as a choice in the nature of reaction/mechanism file
|
|
F X="A^Allergy","P^Pharmacological","U^Unknown" D
|
|
. S LST($$NXT)="i"_X
|
|
Q
|
|
ALLGYTYP ; Get the allergy types
|
|
F X="D^Drug","F^Food","O^Other","DF^Drug,Food","DO^Drug,Other","FO^Food,Other","DFO^Drug,Food,Other" D
|
|
. S LST($$NXT)="i"_X
|
|
Q
|
|
OBSHIST ; Observed or historical
|
|
F X="o^Observed","h^Historical" D
|
|
. S LST($$NXT)="i"_X
|
|
Q
|
|
SEVERITY ; Severity
|
|
F X="3^Severe","2^Moderate","1^Mild" D
|
|
. S LST($$NXT)="i"_X
|
|
Q
|
|
SYMPTOMS(Y,FROM,DIR) ; Return a subset of symptoms
|
|
; .Return Array, Starting Text, Direction
|
|
N I,IEN,CNT,X,NAME,SUB S I=0,CNT=44 ;233
|
|
K ^TMP($J,"SIGNS") ;233
|
|
;The following lines were added in 233. Now accounts for synonyms
|
|
M ^TMP($J,"SIGNS","B")=^GMRD(120.83,"B") ;233
|
|
S SYN="" F S SYN=$O(^GMRD(120.83,"D",SYN)) Q:SYN="" S SUB=0 F S SUB=$O(^GMRD(120.83,"D",SYN,SUB)) Q:'+SUB D ;233
|
|
.S NAME=$P(^GMRD(120.83,SUB,0),U) S ^TMP($J,"SIGNS","B",(SYN_$C(9)_"<"_NAME_">"_U_NAME),SUB)="" ;233
|
|
F Q:I'<CNT S FROM=$O(^TMP($J,"SIGNS","B",FROM),DIR) Q:FROM="" D ;233
|
|
. I FROM="OTHER REACTION" Q ;Don't send this entry
|
|
. S IEN=0 F S IEN=$O(^TMP($J,"SIGNS","B",FROM,IEN)) Q:'IEN D ;233
|
|
. . I $L($T(SCREEN^XTID)) I $$SCREEN^XTID(120.83,.01,IEN_",") Q ;233 Is term active
|
|
. . S I=I+1
|
|
. . S Y(I)=IEN_U_FROM
|
|
Q
|
|
NXT() ; Increment index of LST
|
|
S ILST=ILST+1
|
|
Q ILST
|
|
EDITLOAD(Y,ORALIEN) ; Load an allergy/adverse reaction for editing
|
|
Q:+$G(ORALIEN)=0
|
|
N ORNODE,I
|
|
S ORNODE=$NAME(^TMP("GMRA",$J)),I=0
|
|
;following patch check is made via GUI RPC call to ORWU PATCH instead
|
|
;I '$$PATCH^XPDUTL("GMRA*4.0*21") S @ORNODE@(0)="-1^Not yet implemented",Y=ORNODE Q
|
|
D GETREC^GMRAGUI(ORALIEN,ORNODE)
|
|
S Y=ORNODE
|
|
Q
|
|
EDITSAVE(ORY,ORALIEN,ORDFN,OREDITED) ; Save Edit/Add of an allergy/adverse reaction
|
|
;following patch check is made via GUI RPC call to ORWU PATCH instead
|
|
;I '$$PATCH^XPDUTL("GMRA*4.0*21") S Y="-1^Not yet implemented" Q
|
|
N ORNODE
|
|
S ORNODE=$NAME(^TMP("GMRA",$J))
|
|
K @ORNODE M @ORNODE=OREDITED
|
|
S ORY=0
|
|
I $G(@ORNODE@("GMRAERR"))="YES" D EIE^GMRAGUI1(ORALIEN,ORDFN,ORNODE) Q ;Handle entered in error
|
|
I $G(@ORNODE@("GMRANKA"))="YES" D NKA^GMRAGUI1 Q
|
|
D UPDATE^GMRAGUI1(ORALIEN,ORDFN,ORNODE) Q ;Add/edit reactions
|
|
Q
|
|
SENDBULL(Y,ORDUZ,ORDFN,ORTEXT,ORCMTS) ; Send bulletin if user attempts free-text entry
|
|
I '$D(ORCMTS) D
|
|
. S Y=$$SENDREQ^GMRAPES0(ORDUZ,ORDFN,ORTEXT)
|
|
E D
|
|
. S Y=$$SENDREQ^GMRAPES0(ORDUZ,ORDFN,ORTEXT,.ORCMTS)
|
|
Q
|