[613] | 1 | ORWDAL32 ; SLC/REV - Allergy calls to support windows ;5/31/05 14:14
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,190,195,233,243**;Dec 17, 1997;Build 242
|
---|
| 3 | ;
|
---|
| 4 | DEF(LST) ; Get dialog data for allergies
|
---|
| 5 | N ILST,I,X S ILST=0
|
---|
| 6 | S LST($$NXT)="~Allergy Types" D ALLGYTYP
|
---|
| 7 | S LST($$NXT)="~Reactions" D ALLGYTYP
|
---|
| 8 | S LST($$NXT)="~Nature of Reaction" D NATREACT
|
---|
| 9 | S LST($$NXT)="~Top Ten" D TOPTEN
|
---|
| 10 | S LST($$NXT)="~Observ/Hist" D OBSHIST
|
---|
| 11 | S LST($$NXT)="~Severity" D SEVERITY
|
---|
| 12 | Q
|
---|
| 13 | GMRASITE(ORY) ;Return GMRA Site Params
|
---|
| 14 | N GMRASITE
|
---|
| 15 | D SITE^GMRAUTL
|
---|
| 16 | S ORY=$G(^GMRD(120.84,GMRASITE,0))
|
---|
| 17 | Q
|
---|
| 18 | TOPTEN ; Get top ten symptoms from Allergy Site Parameters file
|
---|
| 19 | N X0,I,CNT,GMRASITE S I=0,X0="",CNT=0 ;233
|
---|
| 20 | D SITE^GMRAUTL ;233
|
---|
| 21 | F S I=$O(^GMRD(120.84,GMRASITE,1,I)),CNT=CNT+1 Q:+I=0!(CNT>10) D ;233
|
---|
| 22 | . 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
|
---|
| 23 | . ;233 Don't send if inactive term
|
---|
| 24 | . I $L($T(SCREEN^XTID)) Q:$$SCREEN^XTID(120.83,.01,X0_",")
|
---|
| 25 | . S LST($$NXT)="i"_X0_U_$P($G(^GMRD(120.83,X0,0)),U,1)
|
---|
| 26 | Q
|
---|
| 27 | ALLSRCH(Y,X) ; Return list of partial matches ; CHANGED TO PRODUCE TREEVIEW IN GUI
|
---|
| 28 | N ORX,ROOT,XP,CNT,ORFILE,ORSRC,ORIEN,ORREAX S ORIEN=0,CNT=0,ORSRC=0,ORFILE=""
|
---|
| 29 | S ORX=X,X=$$UP^XLFSTR(X)
|
---|
| 30 | 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
|
---|
| 31 | . S ORSRC=$G(ORSRC)+1,ORFILE=$P(ROOT,",",1)_")",ORSRC(ORSRC)=$P($T(FILENAME+ORSRC),";;",2)
|
---|
| 32 | . I (ORSRC'=2),(ORSRC'=6) S CNT=CNT+1,Y(CNT)=ORSRC_U_ORSRC(ORSRC)_U_U_U_"TOP"_U_"+"
|
---|
| 33 | . I ORSRC=1!(ORSRC=2) D
|
---|
| 34 | .. I $D(@ROOT@(X)) D
|
---|
| 35 | ... I ORSRC=1,X="OTHER ALLERGY/ADVERSE REACTION" Q ;don't send this entry
|
---|
| 36 | ... S ORIEN=$O(@ROOT@(X,0))
|
---|
| 37 | ... I $L($T(SCREEN^XTID)) I $$SCREEN^XTID(120.82,.01,ORIEN_",") Q ;233 Is term active?
|
---|
| 38 | ... I ORSRC=2 S CNT=CNT+1,Y(CNT)=ORIEN_U_$P($G(^GMRD(120.82,+ORIEN,0)),U,1)_" <"_X_">"_ROOT
|
---|
| 39 | ... I ORSRC'=2 S CNT=CNT+1,Y(CNT)=ORIEN_U_X_ROOT
|
---|
| 40 | ... S Y(CNT)=Y(CNT)_U_$P($G(^GMRD(120.82,+Y(CNT),0)),U,2)_U_$S(ORSRC=2:1,1:ORSRC)
|
---|
| 41 | .. S XP=X F S XP=$O(@ROOT@(XP)) Q:XP="" Q:$E(XP,1,$L(X))'=X D
|
---|
| 42 | ... I ORSRC=1,XP="OTHER ALLERGY/ADVERSE REACTION" Q ;don't send this entry
|
---|
| 43 | ... S ORIEN=$O(@ROOT@(XP,0))
|
---|
| 44 | ... I $L($T(SCREEN^XTID)) I $$SCREEN^XTID(120.82,.01,ORIEN_",") Q ;233 Is term active?
|
---|
| 45 | ... I ORSRC=2 S CNT=CNT+1,Y(CNT)=ORIEN_U_$P($G(^GMRD(120.82,+ORIEN,0)),U,1)_" <"_XP_">"_ROOT ; partial matches
|
---|
| 46 | ... I ORSRC'=2 S CNT=CNT+1,Y(CNT)=ORIEN_U_XP_ROOT
|
---|
| 47 | ... S Y(CNT)=Y(CNT)_U_$P($G(^GMRD(120.82,+Y(CNT),0)),U,2)_U_$S(ORSRC=2:1,1:ORSRC)
|
---|
| 48 | . I (ORSRC>2),(ORSRC'=4),(ORSRC'=5),(ORSRC'=6) D
|
---|
| 49 | .. N CODE,LIST,VAL,NAME
|
---|
| 50 | .. S CODE=$S(ORSRC=3:"S VAL=$$TGTOG2^PSNAPIS(X,.LIST)",ORSRC=4:"D TRDNAME(X,.LIST)",ORSRC=7:"D INGSRCH(X,.LIST)",ORSRC=8:"D CLASRCH(X,.LIST)",1:"") Q:'$L(CODE)
|
---|
| 51 | .. X CODE I $D(LIST) S ORIEN=0 F S ORIEN=$O(LIST(ORIEN)) Q:'ORIEN D
|
---|
| 52 | ... S NAME=$P(LIST(ORIEN),U,2)
|
---|
| 53 | ... Q:$E($P(LIST(ORIEN),U,2),1,$L(X))'=X
|
---|
| 54 | ... I $L($T(SCREEN^XTID)) I $$SCREEN^XTID($S(ORSRC=3:50.6,(ORSRC=4):50.6,ORSRC=7:50.416,ORSRC=8:50.605,1:0),.01,ORIEN_",") Q
|
---|
| 55 | ... S CNT=CNT+1,Y(CNT)=ORIEN_U_NAME_ROOT_U_"D"_U_ORSRC
|
---|
| 56 | . I ORSRC=4 D
|
---|
| 57 | .. N CODE,LIST,VAL,NAME
|
---|
| 58 | .. S CODE="D TRDNAME(X,.LIST)"
|
---|
| 59 | .. X CODE I $D(LIST) S ORIEN=0 F S ORIEN=$O(LIST(ORIEN)) Q:'ORIEN D
|
---|
| 60 | ... S NAME=$P(LIST(ORIEN),U,2)
|
---|
| 61 | ... Q:$E($P(LIST(ORIEN),U,2),1,$L(X))'=X
|
---|
| 62 | ... I $L($T(SCREEN^XTID)) I $$SCREEN^XTID(50.6,.01,+LIST(ORIEN)_",") Q
|
---|
| 63 | ... S CNT=CNT+1,Y(CNT)=+LIST(ORIEN)_U_NAME_ROOT_U_"D"_U_ORSRC
|
---|
| 64 | Q
|
---|
| 65 | FILENAME ; Display text of filenames for search treeview
|
---|
| 66 | ;;VA Allergies File
|
---|
| 67 | ;;VA Allergies File (Synonyms) SPACER ONLY - NOT DISPLAYED
|
---|
| 68 | ;;National Drug File - Generic Drug Name
|
---|
| 69 | ;;National Drug file - Trade Name
|
---|
| 70 | ;;Local Drug File
|
---|
| 71 | ;;Local Drug File (Synonyms) SPACER ONLY - NOT DISPLAYED
|
---|
| 72 | ;;Drug Ingredients File
|
---|
| 73 | ;;VA Drug Class File
|
---|
| 74 | ;;
|
---|
| 75 | NATREACT ; Get the NATURE OF REACTION types
|
---|
| 76 | ;Removing "R^Adverse Reaction" from choices below until we can add it as a choice in the nature of reaction/mechanism file
|
---|
| 77 | F X="A^Allergy","P^Pharmacological","U^Unknown" D
|
---|
| 78 | . S LST($$NXT)="i"_X
|
---|
| 79 | Q
|
---|
| 80 | ALLGYTYP ; Get the allergy types
|
---|
| 81 | F X="D^Drug","F^Food","O^Other","DF^Drug,Food","DO^Drug,Other","FO^Food,Other","DFO^Drug,Food,Other" D
|
---|
| 82 | . S LST($$NXT)="i"_X
|
---|
| 83 | Q
|
---|
| 84 | OBSHIST ; Observed or historical
|
---|
| 85 | F X="o^Observed","h^Historical" D
|
---|
| 86 | . S LST($$NXT)="i"_X
|
---|
| 87 | Q
|
---|
| 88 | SEVERITY ; Severity
|
---|
| 89 | F X="3^Severe","2^Moderate","1^Mild" D
|
---|
| 90 | . S LST($$NXT)="i"_X
|
---|
| 91 | Q
|
---|
| 92 | SYMPTOMS(Y,FROM,DIR) ; Return a subset of symptoms
|
---|
| 93 | ; .Return Array, Starting Text, Direction
|
---|
| 94 | N I,IEN,CNT,X,NAME,SUB S I=0,CNT=44 ;233
|
---|
| 95 | K ^TMP($J,"SIGNS") ;233
|
---|
| 96 | ;The following lines were added in 233. Now accounts for synonyms
|
---|
| 97 | M ^TMP($J,"SIGNS","B")=^GMRD(120.83,"B") ;233
|
---|
| 98 | 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
|
---|
| 99 | .S NAME=$P(^GMRD(120.83,SUB,0),U) S ^TMP($J,"SIGNS","B",(SYN_$C(9)_"<"_NAME_">"_U_NAME),SUB)="" ;233
|
---|
| 100 | F Q:I'<CNT S FROM=$O(^TMP($J,"SIGNS","B",FROM),DIR) Q:FROM="" D ;233
|
---|
| 101 | . I FROM="OTHER REACTION" Q ;Don't send this entry
|
---|
| 102 | . S IEN=0 F S IEN=$O(^TMP($J,"SIGNS","B",FROM,IEN)) Q:'IEN D ;233
|
---|
| 103 | . . I $L($T(SCREEN^XTID)) I $$SCREEN^XTID(120.83,.01,IEN_",") Q ;233 Is term active
|
---|
| 104 | . . S I=I+1
|
---|
| 105 | . . S Y(I)=IEN_U_FROM
|
---|
| 106 | Q
|
---|
| 107 | NXT() ; Increment index of LST
|
---|
| 108 | S ILST=ILST+1
|
---|
| 109 | Q ILST
|
---|
| 110 | EDITLOAD(Y,ORALIEN) ; Load an allergy/adverse reaction for editing
|
---|
| 111 | Q:+$G(ORALIEN)=0
|
---|
| 112 | N ORNODE,I
|
---|
| 113 | S ORNODE=$NAME(^TMP("GMRA",$J)),I=0
|
---|
| 114 | ;following patch check is made via GUI RPC call to ORWU PATCH instead
|
---|
| 115 | ;I '$$PATCH^XPDUTL("GMRA*4.0*21") S @ORNODE@(0)="-1^Not yet implemented",Y=ORNODE Q
|
---|
| 116 | D GETREC^GMRAGUI(ORALIEN,ORNODE)
|
---|
| 117 | S Y=ORNODE
|
---|
| 118 | Q
|
---|
| 119 | EDITSAVE(ORY,ORALIEN,ORDFN,OREDITED) ; Save Edit/Add of an allergy/adverse reaction
|
---|
| 120 | ;following patch check is made via GUI RPC call to ORWU PATCH instead
|
---|
| 121 | ;I '$$PATCH^XPDUTL("GMRA*4.0*21") S Y="-1^Not yet implemented" Q
|
---|
| 122 | N ORNODE
|
---|
| 123 | S ORNODE=$NAME(^TMP("GMRA",$J))
|
---|
| 124 | K @ORNODE M @ORNODE=OREDITED
|
---|
| 125 | S ORY=0
|
---|
| 126 | I $G(@ORNODE@("GMRAERR"))="YES" D EIE^GMRAGUI1(ORALIEN,ORDFN,ORNODE) Q ;Handle entered in error
|
---|
| 127 | I $G(@ORNODE@("GMRANKA"))="YES" D NKA^GMRAGUI1 Q
|
---|
| 128 | D UPDATE^GMRAGUI1(ORALIEN,ORDFN,ORNODE) Q ;Add/edit reactions
|
---|
| 129 | Q
|
---|
| 130 | SENDBULL(Y,ORDUZ,ORDFN,ORTEXT,ORCMTS) ; Send bulletin if user attempts free-text entry
|
---|
| 131 | I '$D(ORCMTS) D
|
---|
| 132 | . S Y=$$SENDREQ^GMRAPES0(ORDUZ,ORDFN,ORTEXT)
|
---|
| 133 | E D
|
---|
| 134 | . S Y=$$SENDREQ^GMRAPES0(ORDUZ,ORDFN,ORTEXT,.ORCMTS)
|
---|
| 135 | Q
|
---|
| 136 | INGSRCH(NAME,LIST) ;
|
---|
| 137 | K ^TMP($J,"ORWDAL32")
|
---|
| 138 | D NAME^PSN50P41(NAME,"ORWDAL32")
|
---|
| 139 | I $D(^TMP($J,"ORWDAL32","P")) D
|
---|
| 140 | . N I S I="" F S I=$O(^TMP($J,"ORWDAL32","P",I)) Q:I="" D
|
---|
| 141 | .. N J S J=0 F S J=$O(^TMP($J,"ORWDAL32","P",I,J)) Q:'J S LIST(J)=J_U_I
|
---|
| 142 | K ^TMP($J,"ORWDAL32")
|
---|
| 143 | Q
|
---|
| 144 | CLASRCH(NAME,LIST) ;
|
---|
| 145 | K ^TMP($J,"ORWDAL32")
|
---|
| 146 | D C^PSN50P65(,NAME,"ORWDAL32")
|
---|
| 147 | I $D(^TMP($J,"ORWDAL32","C")) D
|
---|
| 148 | . N I S I="" F S I=$O(^TMP($J,"ORWDAL32","C",I)) Q:I="" D
|
---|
| 149 | .. N J S J=0 F S J=$O(^TMP($J,"ORWDAL32","C",I,J)) Q:'J S LIST(J)=J_U_$G(^TMP($J,"ORWDAL32",J,1))
|
---|
| 150 | K ^TMP($J,"ORWDAL32")
|
---|
| 151 | Q
|
---|
| 152 | TRDNAME(NAME,LIST) ;
|
---|
| 153 | K ^TMP($J,"ORWDAL32")
|
---|
| 154 | D ALL^PSN5067(,NAME,,"ORWDAL32")
|
---|
| 155 | I $D(^TMP($J,"ORWDAL32","B")) D
|
---|
| 156 | . N I S I="" F S I=$O(^TMP($J,"ORWDAL32","B",I)) Q:I="" D
|
---|
| 157 | .. N J,K S J=$O(^TMP($J,"ORWDAL32","B",I,0)) Q:'J S K=$$TGTOG^PSNAPIS(I),LIST(J)=K_U_$G(^TMP($J,"ORWDAL32",J,4))
|
---|
| 158 | K ^TMP($J,"ORWDAL32")
|
---|
| 159 | Q
|
---|