- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDAL32.m
r613 r623 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 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**;Dec 17, 1997 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 . I $L($T(SCREEN^XTID)) Q:$$SCREEN^XTID(120.83,.01,X0_",") ;233 Don't send if inactive term 24 . S LST($$NXT)="i"_X0_U_$P($G(^GMRD(120.83,X0,0)),U,1) 25 Q 26 ALLSRCH(Y,X) ; Return list of partial matches ; CHANGED TO PRODUCE TREEVIEW IN GUI 27 N ORX,ROOT,XP,CNT,ORFILE,ORSRC,ORIEN,ORREAX S ORIEN=0,CNT=0,ORSRC=0,ORFILE="",ORREAX="" 28 S ORX=X,X=$$UP^XLFSTR(X) 29 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 30 . S ORSRC=ORSRC+1,ORFILE=$P(ROOT,",",1)_")",ORSRC(ORSRC)=$P($T(FILENAME+ORSRC),";;",2) 31 . I (ORSRC'=2),(ORSRC'=6) S CNT=CNT+1,Y(CNT)=ORSRC_U_ORSRC(ORSRC)_U_U_U_"TOP"_U_"+" 32 . I $D(@ROOT@(X)) D 33 . . I ORSRC=1,X="OTHER ALLERGY/ADVERSE REACTION" Q ;don't send this entry 34 . . I ORSRC=5!(ORSRC=6) Q ;233 don't send file 50 entries 35 . . S ORIEN=$O(@ROOT@(X,0)) 36 . . 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? 37 . . I ORSRC=2 S CNT=CNT+1,Y(CNT)=ORIEN_U_$P($G(^GMRD(120.82,+ORIEN,0)),U,1)_" <"_X_">"_ROOT 38 . . E I ORSRC=6 S CNT=CNT+1,Y(CNT)=ORIEN_U_$P($G(^PSDRUG(+ORIEN,0)),U,1)_" <"_X_">"_ROOT 39 . . E S CNT=CNT+1,Y(CNT)=ORIEN_U_X_ROOT 40 . . S ORREAX=$S($P(Y(CNT),U,3)?1"GMR".E:$P($G(^GMRD(120.82,+Y(CNT),0)),U,2),1:"D") 41 . . S Y(CNT)=Y(CNT)_U_ORREAX_U_$S(ORSRC=2:1,ORSRC=6:5,1:ORSRC) 42 . S XP=X F S XP=$O(@ROOT@(XP)) Q:XP="" Q:$E(XP,1,$L(X))'=X D 43 . . I ORSRC=1,XP="OTHER ALLERGY/ADVERSE REACTION" Q ;don't send this entry 44 . . I ORSRC=5!(ORSRC=6) Q ;233 Don't send file 50 entries 45 . . S ORIEN=$O(@ROOT@(XP,0)) 46 . . 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? 47 . . I ORSRC=2 S CNT=CNT+1,Y(CNT)=ORIEN_U_$P($G(^GMRD(120.82,+ORIEN,0)),U,1)_" <"_XP_">"_ROOT ; partial matches 48 . . E I ORSRC=6 S CNT=CNT+1,Y(CNT)=ORIEN_U_$P($G(^PSDRUG(+ORIEN,0)),U,1)_" <"_XP_">"_ROOT ; partial matches 49 . . E S CNT=CNT+1,Y(CNT)=ORIEN_U_XP_ROOT 50 . . S ORREAX=$S($P(Y(CNT),U,3)?1"GMR".E:$P($G(^GMRD(120.82,+Y(CNT),0)),U,2),1:"D") 51 . . S Y(CNT)=Y(CNT)_U_ORREAX_U_$S(ORSRC=2:1,ORSRC=6:5,1:ORSRC) 52 Q 53 FILENAME ; Display text of filenames for search treeview 54 ;;VA Allergies File 55 ;;VA Allergies File (Synonyms) SPACER ONLY - NOT DISPLAYED 56 ;;National Drug File - Generic Drug Name 57 ;;National Drug file - Trade Name 58 ;;Local Drug File 59 ;;Local Drug File (Synonyms) SPACER ONLY - NOT DISPLAYED 60 ;;Drug Ingredients File 61 ;;VA Drug Class File 62 ;; 63 NATREACT ; Get the NATURE OF REACTION types 64 ;Removing "R^Adverse Reaction" from choices below until we can add it as a choice in the nature of reaction/mechanism file 65 F X="A^Allergy","P^Pharmacological","U^Unknown" D 66 . S LST($$NXT)="i"_X 67 Q 68 ALLGYTYP ; Get the allergy types 69 F X="D^Drug","F^Food","O^Other","DF^Drug,Food","DO^Drug,Other","FO^Food,Other","DFO^Drug,Food,Other" D 70 . S LST($$NXT)="i"_X 71 Q 72 OBSHIST ; Observed or historical 73 F X="o^Observed","h^Historical" D 74 . S LST($$NXT)="i"_X 75 Q 76 SEVERITY ; Severity 77 F X="3^Severe","2^Moderate","1^Mild" D 78 . S LST($$NXT)="i"_X 79 Q 80 SYMPTOMS(Y,FROM,DIR) ; Return a subset of symptoms 81 ; .Return Array, Starting Text, Direction 82 N I,IEN,CNT,X,NAME,SUB S I=0,CNT=44 ;233 83 K ^TMP($J,"SIGNS") ;233 84 ;The following lines were added in 233. Now accounts for synonyms 85 M ^TMP($J,"SIGNS","B")=^GMRD(120.83,"B") ;233 86 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 87 .S NAME=$P(^GMRD(120.83,SUB,0),U) S ^TMP($J,"SIGNS","B",(SYN_$C(9)_"<"_NAME_">"_U_NAME),SUB)="" ;233 88 F Q:I'<CNT S FROM=$O(^TMP($J,"SIGNS","B",FROM),DIR) Q:FROM="" D ;233 89 . I FROM="OTHER REACTION" Q ;Don't send this entry 90 . S IEN=0 F S IEN=$O(^TMP($J,"SIGNS","B",FROM,IEN)) Q:'IEN D ;233 91 . . I $L($T(SCREEN^XTID)) I $$SCREEN^XTID(120.83,.01,IEN_",") Q ;233 Is term active 92 . . S I=I+1 93 . . S Y(I)=IEN_U_FROM 94 Q 95 NXT() ; Increment index of LST 96 S ILST=ILST+1 97 Q ILST 98 EDITLOAD(Y,ORALIEN) ; Load an allergy/adverse reaction for editing 99 Q:+$G(ORALIEN)=0 100 N ORNODE,I 101 S ORNODE=$NAME(^TMP("GMRA",$J)),I=0 102 ;following patch check is made via GUI RPC call to ORWU PATCH instead 103 ;I '$$PATCH^XPDUTL("GMRA*4.0*21") S @ORNODE@(0)="-1^Not yet implemented",Y=ORNODE Q 104 D GETREC^GMRAGUI(ORALIEN,ORNODE) 105 S Y=ORNODE 106 Q 107 EDITSAVE(ORY,ORALIEN,ORDFN,OREDITED) ; Save Edit/Add of an allergy/adverse reaction 108 ;following patch check is made via GUI RPC call to ORWU PATCH instead 109 ;I '$$PATCH^XPDUTL("GMRA*4.0*21") S Y="-1^Not yet implemented" Q 110 N ORNODE 111 S ORNODE=$NAME(^TMP("GMRA",$J)) 112 K @ORNODE M @ORNODE=OREDITED 113 S ORY=0 114 I $G(@ORNODE@("GMRAERR"))="YES" D EIE^GMRAGUI1(ORALIEN,ORDFN,ORNODE) Q ;Handle entered in error 115 I $G(@ORNODE@("GMRANKA"))="YES" D NKA^GMRAGUI1 Q 116 D UPDATE^GMRAGUI1(ORALIEN,ORDFN,ORNODE) Q ;Add/edit reactions 117 Q 118 SENDBULL(Y,ORDUZ,ORDFN,ORTEXT,ORCMTS) ; Send bulletin if user attempts free-text entry 119 I '$D(ORCMTS) D 120 . S Y=$$SENDREQ^GMRAPES0(ORDUZ,ORDFN,ORTEXT) 121 E D 122 . S Y=$$SENDREQ^GMRAPES0(ORDUZ,ORDFN,ORTEXT,.ORCMTS) 123 Q
Note:
See TracChangeset
for help on using the changeset viewer.
