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

ORWDAL32.m

Go to the documentation of this file. 
  1. ORWDAL32 ; SLC/REV - Allergy calls to support windows ;10-May-2012 12:54;DU
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,109,190,1007,1008,195,233,243,1010**;Dec 17, 1997;Build 47
  1.  ; Modified - 08/17/11 - IHS/MSC/MGH - ALLSRCH
  1.  ;          - 04/02/12 - IHS/MSC/MGH - Added logic to support Sign/Symptom status and "B" xref lookup for allergy status
  1. DEF(LST) ; Get dialog data for allergies
  1.  N ILST,I,X S ILST=0
  1.  S LST($$NXT)="~Allergy Types" D ALLGYTYP
  1.  S LST($$NXT)="~Reactions" D ALLGYTYP
  1.  S LST($$NXT)="~Nature of Reaction" D NATREACT
  1.  S LST($$NXT)="~Top Ten" D TOPTEN
  1.  S LST($$NXT)="~Observ/Hist" D OBSHIST
  1.  S LST($$NXT)="~Severity" D SEVERITY
  1.  Q
  1. GMRASITE(ORY) ;Return GMRA Site Params
  1.  N GMRASITE
  1.  D SITE^GMRAUTL
  1.  S ORY=$G(^GMRD(120.84,GMRASITE,0))
  1.  Q
  1. TOPTEN ;  Get top ten symptoms from Allergy Site Parameters file
  1.  N X0,I,CNT,GMRASITE S I=0,X0="",CNT=0 ;233
  1.  D SITE^GMRAUTL ;233
  1.  F  S I=$O(^GMRD(120.84,GMRASITE,1,I)),CNT=CNT+1 Q:+I=0!(CNT>10)  D  ;233
  1.  . 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
  1.  . ;233 Don't send if inactive term
  1.  . I $L($T(SCREEN^XTID)) Q:$$SCREEN^XTID(120.83,.01,X0_",")
  1.  . S LST($$NXT)="i"_X0_U_$P($G(^GMRD(120.83,X0,0)),U,1)
  1.  Q
  1. ALLSRCH(Y,X) ; Return list of partial matches  ; CHANGED TO PRODUCE TREEVIEW IN GUI
  1.  N ORX,ROOT,XP,CNT,ORFILE,ORSRC,INAC,INACT,ORIEN,ORREAX S ORIEN=0,CNT=0,ORSRC=0,ORFILE="",ORREAX=""
  1.  S ORX=X,X=$$UP^XLFSTR(X)
  1.  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
  1.  . S INACT=0,ORSRC=$G(ORSRC)+1,ORFILE=$P(ROOT,",",1)_")",ORSRC(ORSRC)=$P($T(FILENAME+ORSRC),";;",2)
  1.  . I (ORSRC'=2),(ORSRC'=6) S CNT=CNT+1,Y(CNT)=ORSRC_U_ORSRC(ORSRC)_U_U_U_"TOP"_U_"+"
  1.  . I ORSRC=1!(ORSRC=2) D
  1.  .. I $D(@ROOT@(X)) D
  1.  ... I ORSRC=1,X="OTHER ALLERGY/ADVERSE REACTION" Q  ;don't send this entry
  1.  ... ;IHS/MSC/MGH 1008
  1.  ... I ORSRC=5!(ORSRC=6) Q  ;Patch 8 don't send file 50 entries
  1.  ... ;IHS/MSC/MGH Screen out inactive allergies
  1.  ... S ORIEN=$O(@ROOT@(X,0))
  1.  ... I ORSRC=1!(ORSRC=2) S INAC=$$CHECK(ORIEN) Q:+INAC
  1.  ... ;end of mods
  1.  ... I $L($T(SCREEN^XTID)) I $$SCREEN^XTID(120.82,.01,ORIEN_",") Q  ;233 Is term active?
  1.  ... I ORSRC=2 S CNT=CNT+1,Y(CNT)=ORIEN_U_$P($G(^GMRD(120.82,+ORIEN,0)),U,1)_" <"_X_">"_ROOT
  1.  ... I ORSRC'=2  S CNT=CNT+1,Y(CNT)=ORIEN_U_X_ROOT
  1.  ... S Y(CNT)=Y(CNT)_U_$P($G(^GMRD(120.82,+Y(CNT),0)),U,2)_U_$S(ORSRC=2:1,1:ORSRC)
  1.  .. S XP=X F  S XP=$O(@ROOT@(XP)) Q:XP=""  Q:$E(XP,1,$L(X))'=X  D
  1.  ... I ORSRC=1,XP="OTHER ALLERGY/ADVERSE REACTION" Q  ;don't send this entry
  1.  ... S ORIEN=$O(@ROOT@(XP,0))
  1.  ... I ORSRC=1,XP="OTHER ALLERGY/ADVERSE REACTION" Q  ;IHS/MSC/MGH 1008
  1.  ... ;IHS/MSC/MGH Changes made to screen out inactive allergies
  1.  ... I ORSRC=5!(ORSRC=6) Q
  1.  ... I ORSRC=1!(ORSRC=2) S INAC=$$CHECK(ORIEN) Q:+INAC
  1.  ... ;End of mods
  1.  ... I $L($T(SCREEN^XTID)) I $$SCREEN^XTID(120.82,.01,ORIEN_",") Q  ;233 Is term active?
  1.  ... I ORSRC=2 S CNT=CNT+1,Y(CNT)=ORIEN_U_$P($G(^GMRD(120.82,+ORIEN,0)),U,1)_" <"_XP_">"_ROOT ; partial matches
  1.  ... I ORSRC'=2  S CNT=CNT+1,Y(CNT)=ORIEN_U_XP_ROOT
  1.  ... S Y(CNT)=Y(CNT)_U_$P($G(^GMRD(120.82,+Y(CNT),0)),U,2)_U_$S(ORSRC=2:1,1:ORSRC)
  1.  . I (ORSRC>2),(ORSRC'=4),(ORSRC'=5),(ORSRC'=6) D
  1.  .. N CODE,LIST,VAL,NAME
  1.  .. 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)
  1.  .. X CODE I $D(LIST) S ORIEN=0 F  S ORIEN=$O(LIST(ORIEN)) Q:'ORIEN  D
  1.  ... S NAME=$P(LIST(ORIEN),U,2)
  1.  ... Q:$E($P(LIST(ORIEN),U,2),1,$L(X))'=X
  1.  ... 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
  1.  ... S CNT=CNT+1,Y(CNT)=ORIEN_U_NAME_ROOT_U_"D"_U_ORSRC
  1.  . I ORSRC=4 D
  1.  .. N CODE,LIST,VAL,NAME
  1.  .. S CODE="D TRDNAME(X,.LIST)"
  1.  .. X CODE I $D(LIST) S ORIEN=0 F  S ORIEN=$O(LIST(ORIEN)) Q:'ORIEN  D
  1.  ... S NAME=$P(LIST(ORIEN),U,2)
  1.  ... Q:$E($P(LIST(ORIEN),U,2),1,$L(X))'=X
  1.  ... I $L($T(SCREEN^XTID)) I $$SCREEN^XTID(50.6,.01,+LIST(ORIEN)_",") Q
  1.  ... S CNT=CNT+1,Y(CNT)=+LIST(ORIEN)_U_NAME_ROOT_U_"D"_U_ORSRC
  1.  Q
  1. FILENAME ; Display text of filenames for search treeview
  1.  ;;VA Allergies File
  1.  ;;VA Allergies File (Synonyms)  SPACER ONLY - NOT DISPLAYED
  1.  ;;National Drug File - Generic Drug Name
  1.  ;;National Drug file - Trade Name
  1.  ;;Local Drug File
  1.  ;;Local Drug File (Synonyms)  SPACER ONLY - NOT DISPLAYED
  1.  ;;Drug Ingredients File
  1.  ;;VA Drug Class File
  1.  ;;
  1. NATREACT ; Get the NATURE OF REACTION types
  1.  ;Removing "R^Adverse Reaction" from choices below until we can add it as a choice in the nature of reaction/mechanism file
  1.  F X="A^Allergy","P^Pharmacological","U^Unknown" D
  1.  . S LST($$NXT)="i"_X
  1.  Q
  1. ALLGYTYP ; Get the allergy types
  1.  F X="D^Drug","F^Food","O^Other","DF^Drug,Food","DO^Drug,Other","FO^Food,Other","DFO^Drug,Food,Other" D
  1.  . S LST($$NXT)="i"_X
  1.  Q
  1. OBSHIST ; Observed or historical
  1.  F X="o^Observed","h^Historical" D
  1.  . S LST($$NXT)="i"_X
  1.  Q
  1. SEVERITY ; Severity
  1.  F X="3^Severe","2^Moderate","1^Mild" D
  1.  . S LST($$NXT)="i"_X
  1.  Q
  1. SYMPTOMS(Y,FROM,DIR) ; Return a subset of symptoms
  1.  ; .Return Array, Starting Text, Direction
  1.  N I,IEN,CNT,X,NAME,SUB,INACS,SYN
  1.  S I=0,CNT=44 ;233
  1.  K ^TMP($J,"SIGNS") ;233
  1.  ;The following lines were added in 233.  Now accounts for synonyms
  1.  M ^TMP($J,"SIGNS","B")=^GMRD(120.83,"B") ;233
  1.  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
  1.  .S NAME=$P(^GMRD(120.83,SUB,0),U) S ^TMP($J,"SIGNS","B",(SYN_$C(9)_"<"_NAME_">"_U_NAME),SUB)="" ;233
  1.  F  Q:I'<CNT  S FROM=$O(^TMP($J,"SIGNS","B",FROM),DIR) Q:FROM=""  D  ;233
  1.  . I FROM="OTHER REACTION" Q  ;Don't send this entry
  1.  . S IEN=0 F  S IEN=$O(^TMP($J,"SIGNS","B",FROM,IEN)) Q:'IEN  D  ;233
  1.  . . S INACS=$$CHECKS(IEN) Q:+INACS     ;IHS/MSC/MGH 1010
  1.  . . I $L($T(SCREEN^XTID)) I $$SCREEN^XTID(120.83,.01,IEN_",") Q  ;233 Is term active
  1.  . . S I=I+1
  1.  . . S Y(I)=IEN_U_FROM
  1.  Q
  1. NXT() ; Increment index of LST
  1.  S ILST=ILST+1
  1.  Q ILST
  1. EDITLOAD(Y,ORALIEN) ; Load an allergy/adverse reaction for editing
  1.  Q:+$G(ORALIEN)=0
  1.  N ORNODE,I
  1.  S ORNODE=$NAME(^TMP("GMRA",$J)),I=0
  1.  ;following patch check is made via GUI RPC call to ORWU PATCH instead
  1.  ;I '$$PATCH^XPDUTL("GMRA*4.0*21") S @ORNODE@(0)="-1^Not yet implemented",Y=ORNODE Q
  1.  D GETREC^GMRAGUI(ORALIEN,ORNODE)
  1.  S Y=ORNODE
  1.  Q
  1. EDITSAVE(ORY,ORALIEN,ORDFN,OREDITED) ; Save Edit/Add of an allergy/adverse reaction
  1.  ;following patch check is made via GUI RPC call to ORWU PATCH instead
  1.  ;I '$$PATCH^XPDUTL("GMRA*4.0*21") S Y="-1^Not yet implemented" Q
  1.  N ORNODE
  1.  S ORNODE=$NAME(^TMP("GMRA",$J))
  1.  K @ORNODE M @ORNODE=OREDITED
  1.  S ORY=0
  1.  I $G(@ORNODE@("GMRAERR"))="YES" D EIE^GMRAGUI1(ORALIEN,ORDFN,ORNODE) Q  ;Handle entered in error
  1.  I $G(@ORNODE@("GMRANKA"))="YES" D NKA^GMRAGUI1 Q
  1.  D UPDATE^GMRAGUI1(ORALIEN,ORDFN,ORNODE) Q  ;Add/edit reactions
  1.  Q
  1. SENDBULL(Y,ORDUZ,ORDFN,ORTEXT,ORCMTS) ; Send bulletin if user attempts free-text entry
  1.  I '$D(ORCMTS) D
  1.  . S Y=$$SENDREQ^GMRAPES0(ORDUZ,ORDFN,ORTEXT)
  1.  E  D
  1.  . S Y=$$SENDREQ^GMRAPES0(ORDUZ,ORDFN,ORTEXT,.ORCMTS)
  1.  Q
  1. CHECK(ORIEN) ;Check to see if allergy is active)
  1.  N VALUE,STAT,STATUS,TERMDT
  1.  S VALUE=0
  1.  S TERMDT=$O(^GMRD(120.82,ORIEN,"TERMSTATUS","B",$C(0)),-1) I TERMDT'=""  D
  1.  .S STAT=$O(^GMRD(120.82,ORIEN,"TERMSTATUS","B",TERMDT,$C(0)),-1) I STAT'=""  D
  1.  ..S STATUS=$P($G(^GMRD(120.82,ORIEN,"TERMSTATUS",STAT,0)),U,2)
  1.  ..I STATUS=0 S VALUE=1
  1.  Q VALUE
  1. CHECKS(SGN) ;Check to see if SIGN/SYMPTOM is active)
  1.  N VALUE,STAT,STATUS,SIGNDT
  1.  S VALUE=0,SIGNDT=""
  1.  S SIGNDT=$O(^GMRD(120.83,SGN,"TERMSTATUS","B",$C(0)),-1) I SIGNDT'=""  D
  1.  .S STAT=$O(^GMRD(120.83,SGN,"TERMSTATUS","B",SIGNDT,$C(0)),-1) I STAT'=""  D
  1.  ..S STATUS=$P($G(^GMRD(120.83,SGN,"TERMSTATUS",STAT,0)),U,2)
  1.  ..I STATUS=0 S VALUE=1
  1.  Q VALUE
  1. INGSRCH(NAME,LIST) ;
  1.  K ^TMP($J,"ORWDAL32")
  1.  D NAME^PSN50P41(NAME,"ORWDAL32")
  1.  I $D(^TMP($J,"ORWDAL32","P")) D
  1.  . N I S I="" F  S I=$O(^TMP($J,"ORWDAL32","P",I)) Q:I=""  D
  1.  .. N J S J=0 F  S J=$O(^TMP($J,"ORWDAL32","P",I,J)) Q:'J  S LIST(J)=J_U_I
  1.  K ^TMP($J,"ORWDAL32")
  1.  Q
  1. CLASRCH(NAME,LIST) ;
  1.  K ^TMP($J,"ORWDAL32")
  1.  D C^PSN50P65(,NAME,"ORWDAL32")
  1.  I $D(^TMP($J,"ORWDAL32","C")) D
  1.  . N I S I="" F  S I=$O(^TMP($J,"ORWDAL32","C",I)) Q:I=""  D
  1.  .. 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))
  1.  K ^TMP($J,"ORWDAL32")
  1.  Q
  1. TRDNAME(NAME,LIST) ;
  1.  K ^TMP($J,"ORWDAL32")
  1.  D ALL^PSN5067(,NAME,,"ORWDAL32")
  1.  I $D(^TMP($J,"ORWDAL32","B")) D
  1.  . N I S I="" F  S I=$O(^TMP($J,"ORWDAL32","B",I)) Q:I=""  D
  1.  .. 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))
  1.  K ^TMP($J,"ORWDAL32")
  1.  Q