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

HMPCORD5.m

Go to the documentation of this file. 
  1. HMPCORD5 ;SLC/AGP,ASMR/EJK,RRB - Retrieved Orderable Items;Sep 1, 2016 17:27:27
  1.  ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; DE2497/RRB - Removed unused variable, HMP777
  1.  ;
  1.  ; DE6652 - JD - 9/1/16: Removed code behind synching sign-symptom domain for operational data.
  1.  ;                       SIGNS tag.
  1.  ;
  1.  Q
  1.  ;
  1. IMMTYPE ;
  1.  N ORWLST,ORDT,HMPIMM
  1.  S (ORWLST,ORDT)=""
  1.  S (HMPCNT,HMPLAST,HMPI)=0
  1.  N IMM
  1.  ;D IMMTYPE^ORWPCE2(.ORWLST,ORDT)   ;use existing broker call ORWPCE GET IMMUNIZATION TYPE
  1.  N IEN,CNT,BINDEX S (IEN,CNT)=0
  1.  S:'$G(ORDT) ORDT=DT
  1.  ; ^AUTTIMM - IMMUNIZATION file #9999999.14, ***DBIA2454 subscription needed***
  1.  F  S IEN=$O(^AUTTIMM(IEN)) Q:IEN=""!(IEN'?1N.N)  D
  1.  . I $D(^AUTTIMM(IEN,0))#2,+$P(^(0),"^",7)=0 S CNT=CNT+1,ORWLST(CNT)=IEN_"^"_$G(^(0))
  1.  . Q
  1.  S IMM="",HMPIMM=""
  1.  F  S IMM=$O(ORWLST(IMM)) Q:IMM=""  D
  1.  . S HMPIMM("localId")=$P(ORWLST(IMM),"^",1)  ;get the ien for each item found
  1.  . S HMPIMM("name")=$P(ORWLST(IMM),"^",2) ;get the name for each item found
  1.  . S HMPIMM("mnemonic")=$P(ORWLST(IMM),"^",3)  ;get the mnemonic for each entry
  1.  . S HMPIMM("uid")=$$SETUID^HMPUTILS("immunization",,HMPIMM("localId"))  ;set the uid string
  1.  . S HMPCNT=HMPCNT+1
  1.  . D ADD^HMPEF("HMPIMM") S HMPLAST=HMPCNT  ;add it to the JSON results array
  1.  . Q
  1.  S HMPFINI=1
  1.  Q
  1.  ;
  1. ALLTYPE ; deprecated
  1.  ;N ORX,ROOT,XP,CNT,ORFILE,ORSRC,ORIEN,ORREAX,ALLCNT,ALLLAST,ALLITEM
  1.  ;S ORIEN=0,CNT=0,ORSRC=0,ORFILE="",ALLCNT=0,ALLLAST=0
  1.  ;S X=""
  1.  ;F ROOT="^GMRD(120.82)","^PSNDF(50.6)","^PSNDF(50.67)","^PSDRUG(""B"")","^PS(50.416)","^PS(50.605)" D
  1.  ;F ROOT="^GMRD(120.82,""B"")","^GMRD(120.82,""D"")","^PSDRUG(""C"")","^PS(50.416,""P"")","^PS(50.605,""C"")",$$B^PSNAPIS,$$T^PSNAPIS,"^PSDRUG(""B"")" D
  1.  ;F ROOT="^GMRD(120.82,""B"")","^PSDRUG(""C"")","^PS(50.416,""P"")","^PS(50.605,""C"")",$$B^PSNAPIS,$$T^PSNAPIS,"^PSDRUG(""B"")" D
  1.  ;. S ORSRC=$G(ORSRC)+1,ORFILE=$P(ROOT,",",1)_")",ORSRC(ORSRC)=$P($T(FILENAME+ORSRC),";;",2)
  1.  ;. I (ORSRC'=2),(ORSRC'=6) S:'$D(Y(ORIEN_";"_ROOT)) CNT=CNT+1,Y(ORIEN_";"_ROOT)=ORSRC_U_ORSRC(ORSRC)_U_U_U_"TOP"_U_"+"
  1.  ;. I ORSRC=1!(ORSRC=2) D
  1.  ;.. F  S X=$O(@ROOT@(X)) Q:X=""  D
  1.  ;... I ORSRC=1,X="OTHER ALLERGY/ADVERSE REACTION" Q  ;don't send this entry
  1.  ;... S ORIEN=$O(@ROOT@(X,0))
  1.  ;... I $L($T(SCREEN^XTID)) I $$SCREEN^XTID(120.82,.01,ORIEN_",") Q  ;233 Is term active?
  1.  ;... I ORSRC=2 S:'$D(Y(ORIEN_";"_ROOT)) CNT=CNT+1,Y(ORIEN_";"_ROOT)=ORIEN_U_$P($G(^GMRD(120.82,+ORIEN,0)),U,1)_" <"_X_">"_ROOT
  1.  ;... I ORSRC'=2  S:'$D(Y(ORIEN_";"_ROOT)) CNT=CNT+1,Y(ORIEN_";"_ROOT)=ORIEN_U_X_ROOT
  1.  ;... S Y(ORIEN_";"_ROOT)=Y(ORIEN_";"_ROOT)_U_$P($G(^GMRD(120.82,+ORIEN,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 $L($T(SCREEN^XTID)) I $$SCREEN^XTID(120.82,.01,ORIEN_",") Q  ;233 Is term active?
  1.  ;... I ORSRC=2 S:'$D(Y(ORIEN_";"_ROOT)) CNT=CNT+1,Y(ORIEN_";"_ROOT)=ORIEN_U_$P($G(^GMRD(120.82,+ORIEN,0)),U,1)_" <"_XP_">"_ROOT ; partial matches
  1.  ;... I ORSRC'=2  S:'$D(Y(ORIEN_";"_ROOT)) CNT=CNT+1,Y(ORIEN_";"_ROOT)=ORIEN_U_XP_ROOT
  1.  ;... S:'$D(Y(ORIEN_";"_ROOT)) Y(ORIEN_";"_ROOT)=Y(ORIEN_";"_ROOT)_U_$P($G(^GMRD(120.82,+ORIEN,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:'$D(Y(ORIEN_";"_ROOT)) CNT=CNT+1,Y(ORIEN_";"_ROOT)=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:'$D(Y(ORIEN_";"_ROOT)) CNT=CNT+1,Y(ORIEN_";"_ROOT)=+LIST(ORIEN)_U_NAME_ROOT_U_"D"_U_ORSRC
  1.  ;S CNT=""
  1.  ;F  S CNT=$O(Y(CNT)) Q:CNT=""  D
  1.  ;. K ALLERGY
  1.  ;. S ALLITEM=$G(Y(CNT))
  1.  ;. I Y(CNT)["^TOP^+" Q
  1.  ;. I Y(CNT)'["^TOP^+" D
  1.  ;.. S ALLERGY("localId")=$P(ALLITEM,"^",1)
  1.  ;.. S ALLERGY("name")=$P(ALLITEM,"^",2)
  1.  ;.. S ALLERGY("root")=$P(ALLITEM,"^",3)
  1.  ;.. S ALLERGY("uid")=$$SETUID^HMPUTILS("allergy-list",,ALLERGY("localId")_";"_$TR(ALLERGY("root"),"""",""))  ;set the uid string
  1.  ;.. S HMPCNT=$G(HMPCNT)+1 D ADD^HMPEF("ALLERGY") S HMPLAST=HMPCNT
  1.  ;.. Q
  1.  ;. Q
  1.  ;S HMPFINI=1
  1.  ;K X,Y
  1.  Q
  1.  ;
  1. VTYPE ; ;VITALS TYPE
  1.  N IEN
  1.  S (HMPCNT,HMPI,HMPLAST,IEN)=0
  1.  F  S IEN=$O(^GMRD(120.51,IEN)) Q:IEN=""!(IEN'?1N.N)  D
  1.  . S VTYPE("localId")=IEN
  1.  . S VTYPE("name")=$P(^GMRD(120.51,IEN,0),"^",1)
  1.  . S VTYPE("abbreviation")=$P(^GMRD(120.51,IEN,0),"^",2)
  1.  . S VTYPE("rate")=$P(^GMRD(120.51,IEN,0),"^",4)
  1.  . I VTYPE("rate")]"" S VTYPE("rate")=$S(VTYPE("rate")=1:"YES",1:"NO")
  1.  . S VTYPE("pce")=$P(^GMRD(120.51,IEN,0),"^",7)
  1.  . S VTYPE("vuid")="urn:va:vuid:"_$P($G(^GMRD(120.51,IEN,"VUID")),"^",1)
  1.  . S VTYPE("masterVuid")=$P($G(^GMRD(120.51,IEN,"VUID")),"^",2)
  1.  . I VTYPE("masterVuid")]"" S VTYPE("masterVuid")=$S(VTYPE("masterVuid")=1:"YES",1:"NO")
  1.  . S VTYPE("effective")=$P($G(^GMRD(120.51,IEN,"TERMSTATUS",1,0)),"^",1)
  1.  . I VTYPE("effective")]"" S VTYPE("effective")=$$JSONDT^HMPUTILS(VTYPE("effective"))
  1.  . S VTYPE("status")=$P($G(^GMRD(120.51,IEN,"TERMSTATUS",1,0)),"^",2)
  1.  . I VTYPE("status")]"" S VTYPE("status")=$S(VTYPE("status")=1:"ACTIVE",1:"INACTIVE")
  1.  . S VTYPE("uid")=$$SETUID^HMPUTILS("vital-type",,VTYPE("localId"))
  1.  . S HMPCNT=HMPCNT+1 D ADD^HMPEF("VTYPE") S HMPLAST=HMPCNT
  1.  S HMPFINI=1
  1.  K VTYPE
  1.  Q
  1.  ;
  1. VQUAL ; VITALS QUALIFIER
  1.  N IEN,I
  1.  S (HMPCNT,HMPI,HMPLAST,IEN)=0
  1.  F  S IEN=$O(^GMRD(120.52,IEN)) Q:IEN=""!(IEN'?1N.N)  D
  1.  . S VQUAL("localId")=IEN
  1.  . S VQUAL("synonym")=$P(^GMRD(120.52,IEN,0),"^",2)
  1.  . S I=0
  1.  . K VQUAL("vtype") ;ejk - stop bleed over from previous extracts. 
  1.  . F  S I=$O(^GMRD(120.52,IEN,1,I)) Q:I=""!(I'?1N.N)  D
  1.  .. S VQUAL("vtype",I,"vitalType")=$P($G(^GMRD(120.52,IEN,1,I,0)),"^",1)
  1.  .. S VQUAL("vtype",I,"category")=$P($G(^GMRD(120.52,IEN,1,I,0)),"^",2)
  1.  .. ;ejk DE294 - vital type and vital category need to be presented as urn entries and not the name
  1.  .. ;I VQUAL("vtype",I,"vitalType")]"" S VQUAL("vtype",I,"vitalType")=$P($G(^GMRD(120.51,I,0)),"^",1)
  1.  .. ;I VQUAL("vtype",I,"category")]"" S VQUAL("vtype",I,"category")=$P($G(^GMRD(120.53,I,0)),"^",1)
  1.  .. I VQUAL("vtype",I,"vitalType")]"" S VQUAL("vtype",I,"vitalType")=$$SETUID^HMPUTILS("vital-type",,VQUAL("vtype",I,"vitalType"))
  1.  .. I VQUAL("vtype",I,"category")]"" S VQUAL("vtype",I,"category")=$$SETUID^HMPUTILS("vital-category",,VQUAL("vtype",I,"category"))
  1.  .. Q
  1.  . S VQUAL("vuid")="urn:va:vuid:"_$P($G(^GMRD(120.52,IEN,"VUID")),"^",1)
  1.  . S VQUAL("masterVuid")=$P($G(^GMRD(120.52,IEN,"VUID")),"^",2)
  1.  . I VQUAL("masterVuid")]"" S VQUAL("masterVuid")=$S(VQUAL("masterVuid")=1:"YES",1:"NO")
  1.  . S VQUAL("effectiveDate")=$P($G(^GMRD(120.52,IEN,"TERMSTATUS",1,0)),"^",1)
  1.  . I VQUAL("effectiveDate")]"" S VQUAL("effectiveDate")=$$JSONDT^HMPUTILS(VQUAL("effectiveDate"))
  1.  . S VQUAL("status")=$P($G(^GMRD(120.52,IEN,"TERMSTATUS",1,0)),"^",2)
  1.  . I VQUAL("status")]"" S VQUAL("status")=$S(VQUAL("status")=1:"ACTIVE",1:"INACTIVE")
  1.  . S VQUAL("uid")=$$SETUID^HMPUTILS("vital-qualifier",,VQUAL("localId"))
  1.  . S VQUAL("qualifier")=$$SETUID^HMPUTILS("vital-qualifier",,VQUAL("localId"))
  1.  . ;ejk DE295 do not include qualifier if it is the same value as the uid
  1.  . I VQUAL("uid")=VQUAL("qualifier") K VQUAL("qualifier")
  1.  . S HMPCNT=HMPCNT+1 D ADD^HMPEF("VQUAL") S HMPLAST=HMPCNT
  1.  S HMPFINI=1
  1.  K VQUAL
  1.  Q
  1.  ;
  1. VCAT ;VITALS CATAGORY
  1.  N IEN,I
  1.  S (HMPCNT,HMPI,HMPLAST,IEN)=0
  1.  F  S IEN=$O(^GMRD(120.53,IEN)) Q:IEN=""!(IEN'?1N.N)  D
  1.  . S VCAT("localId")=IEN
  1.  . I $P($G(^GMRD(120.53,IEN,0)),"^",1)]"" S VCAT("category")=$P(^GMRD(120.53,IEN,0),"^",1)
  1.  . I $P($G(^GMRD(120.53,IEN,0)),"^",2)]"" S VCAT("synonym")=$P(^GMRD(120.53,IEN,0),"^",2)
  1.  . I $G(VCAT("synonym"))="" K VCAT("synonym")
  1.  . S I=0
  1.  . ;EJK - kill off vtype array to stop inheriting values from previous extracts
  1.  . K VCAT("vtype")
  1.  . F  S I=$O(^GMRD(120.53,IEN,1,I)) Q:I=""!(I'?1N.N)  D
  1.  .. ;ejk DE298 do not send null values. 
  1.  .. I $P($G(^GMRD(120.53,IEN,1,I,0)),"^",1)]"" S VCAT("vtype",I,"vitalType")=$P($G(^GMRD(120.53,IEN,1,I,0)),"^",1)
  1.  .. I VCAT("vtype",I,"vitalType")]"" S VCAT("vtype",I,"vitalType")=$$SETUID^HMPUTILS("vital-type",,VCAT("vtype",I,"vitalType"))
  1.  .. I $P($G(^GMRD(120.53,IEN,1,I,0)),"^",3)]"" S VCAT("vtype",I,"maxEntries")=$P($G(^GMRD(120.53,IEN,1,I,0)),"^",3)
  1.  .. I $P($G(^GMRD(120.53,IEN,1,I,0)),"^",5)]"" S VCAT("vtype",I,"printOrder")=$P($G(^GMRD(120.53,IEN,1,I,0)),"^",5)
  1.  .. I $P($G(^GMRD(120.53,IEN,1,I,0)),"^",6)]"" S VCAT("vtype",I,"editOrder")=$P($G(^GMRD(120.53,IEN,1,I,0)),"^",6)
  1.  .. I $P($G(^GMRD(120.53,IEN,1,I,0)),"^",7)]"" S VCAT("vtype",I,"defaultQualifier")=$P($G(^GMRD(120.53,IEN,1,I,0)),"^",7),VCAT("vtype",I,"defaultQualifier")=$$SETUID^HMPUTILS("vital-qualifier",,VCAT("vtype",I,"defaultQualifier"))
  1.  .. Q
  1.  . S VCAT("vuid")="urn:va:vuid:"_$P($G(^GMRD(120.53,IEN,"VUID")),"^",1)
  1.  . S VCAT("masterVuid")=$P($G(^GMRD(120.53,IEN,"VUID")),"^",2)
  1.  . I VCAT("masterVuid")]"" S VCAT("masterVuid")=$S(VCAT("masterVuid")=1:"YES",1:"NO")
  1.  . S VCAT("effectiveDate")=$P($G(^GMRD(120.53,IEN,"TERMSTATUS",1,0)),"^",1)
  1.  . I VCAT("effectiveDate")]"" S VCAT("effectiveDate")=$$JSONDT^HMPUTILS(VCAT("effectiveDate"))
  1.  . S VCAT("status")=$P($G(^GMRD(120.53,IEN,"TERMSTATUS",1,0)),"^",2)
  1.  . I VCAT("status")]"" S VCAT("status")=$S(VCAT("status")=1:"ACTIVE",1:"INACTIVE")
  1.  . S VCAT("uid")=$$SETUID^HMPUTILS("vital-category",,VCAT("localId"))
  1.  . S HMPCNT=HMPCNT+1 D ADD^HMPEF("VCAT") S HMPLAST=HMPCNT
  1.  . Q
  1.  S HMPFINI=1
  1.  K VCAT
  1.  Q
  1.  ;
  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
  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.  ;;