- PSOORDA ;ISC-BHAM/LC - build detailed allergy list ;Aug 05, 2021@09:28:21
- ;;7.0;OUTPATIENT PHARMACY;**44,139,152,186,441**;DEC 1997;Build 208
- ;External reference to EN1^GMRADPT supported by DBIA 10099
- ;External reference to EN1^GMRAOR2 supported by DBIA 2422
- ;
- ;Inpatient Pharmacy's DBIA 2211 allows reference to ^TMP("PSJAL" and ^TMP("PSJDA"
- ;
- ;PSO*7*186 Newing of variables to protect their global values
- ;
- BEG(DFN) N VALMCNT,DR,IEN S GMRA="0^0^111",IEN=0 D EN1^GMRADPT
- NEW PSONSP S PSONSP=$S($G(PSJINPT):"PSJDA",1:"PSODA")
- K ^TMP(PSONSP,$J) I 'GMRAL S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=$S($G(GMRAL)=0:"No Known Allergies",'GMRAL:"Patient has not been asked about allergies",1:"")
- S (OT,FD,DG,LTO,VY,NVY,VDG,VDGF,VDGFO,VDGO,VFD,VFDO,VOT,NDG,NDGF,NDGFO,NDGO,NFD,NFDO,NOT)=0,(NU,TY)="" D:$G(GMRAL)
- .F DR=0:0 S DR=$O(GMRAL(DR)) Q:'DR S AG($S($P(GMRAL(DR),"^",4):1,1:2),$P(GMRAL(DR),"^",7),$P(GMRAL(DR),"^",2))=DR_"^"_$P(GMRAL(DR),"^",2)_"^"_+$P(GMRAL(DR),"^",4)_"^"_+$P(GMRAL(DR),"^",8)
- .F S NU=$O(AG(NU)) Q:'NU S:NU=1 VY=1 S:NU=2 NVY=1 F S TY=$O(AG(NU,TY)) Q:TY="" D
- ..S:VY&(TY="D") VDG=1 S:VY&(TY="DF") VDGF=1 S:VY&(TY="DFO") VDGFO=1 S:VY&(TY="DO") VDGO=1 S:VY&(TY="F") VFD=1 S:VY&(TY="FO") VFDO=1 S:VY&(TY="O") VOT=1
- ..S:NVY&(TY="D") NDG=1 S:NVY&(TY="DF") NDGF=1 S:NVY&(TY="DFO") NDGFO=1 S:NVY&(TY="DO") NDGO=1 S:NVY&(TY="F") NFD=1 S:NVY&(TY="FO") NFDO=1 S:NVY&(TY="O") NOT=1
- .S:VY IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Verified"
- .S:VDG IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug: "
- .S AL="" F S AL=$O(AG(1,"D",AL)) Q:AL="" D
- ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_DG_" "_AL,AGN(DG)=$P(AG(1,"D",AL),"^")
- .S:VDGF IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug/Food: "
- .S AL="" F S AL=$O(AG(1,"DF",AL)) Q:AL="" D
- ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_DG_" "_AL,AGN(DG)=$P(AG(1,"DF",AL),"^")
- .S:VDGFO IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug/Food/Other: "
- .S AL="" F S AL=$O(AG(1,"DFO",AL)) Q:AL="" D
- ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_DG_" "_AL,AGN(DG)=$P(AG(1,"DFO",AL),"^")
- .S:VDGO IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug/Other: "
- .S AL="" F S AL=$O(AG(1,"DO",AL)) Q:AL="" D
- ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_DG_" "_AL,AGN(DG)=$P(AG(1,"DO",AL),"^")
- .S:VFD IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Food: "
- .S AL="" F S AL=$O(AG(1,"F",AL)) Q:AL="" D
- ..S FD=FD+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(FD+DG)_" "_AL,AGN(FD+DG)=$P(AG(1,"F",AL),"^")
- .S:VFDO IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Food/Other: "
- .S AL="" F S AL=$O(AG(1,"FO",AL)) Q:AL="" D
- ..S FD=FD+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(FD+DG)_" "_AL,AGN(FD+DG)=$P(AG(1,"FO",AL),"^")
- .S:VOT IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Other: "
- .S AL="" F S AL=$O(AG(1,"O",AL)) Q:AL="" D
- ..S OT=OT+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(OT+FD+DG)_" "_AL,AGN(OT+FD+DG)=$P(AG(1,"O",AL),"^")
- .S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" ",LTO=(OT+FD+DG),(OT,FD,DG)=0
- .S:NVY IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)="Non-Verified"
- .S:NDG IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug: "
- .S AL="" F S AL=$O(AG(2,"D",AL)) Q:AL="" D
- ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(DG+LTO)_" "_AL,AGN(DG+LTO)=$P(AG(2,"D",AL),"^")
- .S:NDGF IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug/Food: "
- .S AL="" F S AL=$O(AG(2,"DF",AL)) Q:AL="" D
- ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(DG+LTO)_" "_AL,AGN(DG+LTO)=$P(AG(2,"DF",AL),"^")
- .S:NDGFO IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug/Food/Other: "
- .S AL="" F S AL=$O(AG(2,"DFO",AL)) Q:AL="" D
- ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(DG+LTO)_" "_AL,AGN(DG+LTO)=$P(AG(2,"DFO",AL),"^")
- .S:NDGO IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug/Other: "
- .S AL="" F S AL=$O(AG(2,"DO",AL)) Q:AL="" D
- ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(DG+LTO)_" "_AL,AGN(DG+LTO)=$P(AG(2,"DO",AL),"^")
- .S:NFD IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Food: "
- .S AL="" F S AL=$O(AG(2,"F",AL)) Q:AL="" D
- ..S FD=FD+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(FD+DG+LTO)_" "_AL,AGN(FD+DG+LTO)=$P(AG(2,"F",AL),"^")
- .S:NFDO IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Food/Other: "
- .S AL="" F S AL=$O(AG(2,"FO",AL)) Q:AL="" D
- ..S FD=FD+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(FD+DG+LTO)_" "_AL,AGN(FD+DG+LTO)=$P(AG(2,"FO",AL),"^")
- .S:NOT IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Other: "
- .S AL="" F S AL=$O(AG(2,"O",AL)) Q:AL="" D
- ..S OT=OT+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(OT+FD+DG+LTO)_" "_AL,AGN(OT+FD+DG+LTO)=$P(AG(2,"O",AL),"^")
- S PSODA=IEN,PSOALL=(OT+FD+DG+LTO)
- S:$D(PSJINPT) PSJDA=IEN,PSJALL=(OT+FD+DG+LTO)
- K AL,AG,DG,FD,GMRA,GMRAL,LTO,NU,OT,TY,VY,VDG,VDGF,VDGFO,VDGO,VFD,VFDO,VOT,NDG,NDGF,NDGFO,NDGO,NFD,NFDO,NOT,NVY
- Q
- SEL ;select allergy for detail display
- N ORD,ORN,IEN,VALMCNT I '$G(PSOALL) S VALMSG="This patient has no Allergies!" S VALMBCK="" Q
- K DIR,DUOUT,DIRUT S DIR("A")="Select Allergies by number",DIR(0)="LO^1:"_PSOALL D ^DIR I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DUOUT S VALMBCK="" Q
- SELAL N ORD,ORN,IEN,VALMCNT ;PSO*7*186
- K DIR,DIRUT,DTOUT,DTOUT S PSOELSE=+Y I +Y S ALST=Y D FULL^VALM1 D
- .F ORD=1:1:$L(ALST,",") Q:$P(ALST,",",ORD)']"" S ORN=+$P(ALST,",",ORD) D DSPLY(DFN)
- ;S PSONSP=$S($G(PSJINPT):"PSJAL",1:"PSODA")
- I 'PSOELSE S VALMBCK=""
- K ALST,PSOELSE
- Q
- DSPLY(DFN) ;build detailed allergy display
- NEW PSONSP S PSONSP=$S($G(PSJINPT):"PSJAL",1:"PSOAL")
- K ^TMP(PSONSP,$J),AGNL S IEN=0,NB=$G(AGN(ORN)) D EN1^GMRAOR2(NB,"AGNL")
- S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Causative Agent: "_$P(AGNL,"^")
- S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "
- S ^TMP(PSONSP,$J,IEN,0)=^TMP(PSONSP,$J,IEN,0)_" Severity: "
- I $D(AGNL("O")) D
- . S I="" F S I=$O(AGNL("O",I)) Q:I="" D
- . . I $P(AGNL("O",I),"^",2)="" Q
- . . S X=$$DT(+AGNL("O",I))_" "_$P(AGNL("O",I),"^",2)
- . . I I=$O(AGNL("O","")) S ^TMP(PSONSP,$J,IEN,0)=^TMP(PSONSP,$J,IEN,0)_X Q
- . . S IEN=IEN+1,$E(^TMP(PSONSP,$J,IEN,0),63)=X
- I $D(AGNL("H")) D
- . S X=$S(+$G(AGNL("H")):$$DT(+AGNL("H"))_" ",1:"")
- . S X=X_$P(AGNL("H"),"^",2)
- . S ^TMP(PSONSP,$J,IEN,0)=^TMP(PSONSP,$J,IEN,0)_X Q
- . ;S IEN=IEN+1,$E(^TMP(PSONSP,$J,IEN,0),63)=X
- ;get ingredients
- S (ING,ING1)="" I $D(AGNL("I")) F IT=0:1 S IN=$O(AGNL("I",IT)) Q:'IN D
- .S:$L(ING_";"_$P($G(AGNL("I",IN)),"^"))>230 ING1=ING1_";"_$P($G(AGNL("I",IN)),"^")
- .S:$L(ING_";"_$P($G(AGNL("I",IN)),"^"))<230 ING=ING_";"_$P($G(AGNL("I",IN)),"^")
- S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Ingredients: ",ING=$E(ING,2,99999),ING1=$E(ING1,2,99999)
- ING F IG=1:1:$L(ING) Q:$P(ING,";",IG)="" S LCC=IG,LC=0
- F IG=1:1:$L(ING) Q:$P(ING,";",IG)="" D
- .S:$L(^TMP(PSONSP,$J,IEN,0)_$P(ING,";",IG))>50 LC=LC+1,IEN=IEN+1,$P(^TMP(PSONSP,$J,IEN,0)," ",19)=" "
- .S ^TMP(PSONSP,$J,IEN,0)=$G(^TMP(PSONSP,$J,IEN,0))_$P(ING,";",IG)_$S($G(LC)=0&($G(IG)=LCC):"",$G(IG)<LCC:", ",$G(LC)>0&($G(IG)=LCC):"",$G(LC)>0&($G(IG)<LCC):", ",1:"")
- I '$D(ING2)&($G(ING1)]"") S ING2=1,ING=ING1 G ING
- S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)="" S ODT=$S($D(AGNL("C",1)):$P(AGNL("C",1),"^"),1:"*******.******"),OD=$P(ODT,".")
- ;
- ;get drug class
- S CLS="" I $D(AGNL("V")) F CT=0:1 S CPT=$O(AGNL("V",CT)) Q:'CPT S CLS=CLS_","_$P($G(AGNL("V",CPT)),"^",2)
- S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" VA Drug Class: ",CLS=$E(CLS,2,99999)
- F CG=1:1:$L(CLS) Q:$P(CLS,",",CG)="" S LCC=CG,LC=0
- F CG=1:1:$L(CLS) Q:$P(CLS,",",CG)="" D
- .S:$L(^TMP(PSONSP,$J,IEN,0)_$P(CLS,",",CG))>50 IEN=IEN+1,$P(^TMP(PSONSP,$J,IEN,0)," ",19)=" "
- .S ^TMP(PSONSP,$J,IEN,0)=$G(^TMP(PSONSP,$J,IEN,0))_$P(CLS,",",CG)_$S($G(LC)=0&($G(CG)=LCC):"",$G(CG)<LCC:", ",$G(LC)>0&($G(CG)=LCC):"",$G(LC)>0&($G(CG)<LCC):", ",1:"")
- ;
- S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Originated: "_$E(OD,4,5)_"/"_$E(OD,6,7)_"/"_$E(OD,2,3)
- S ^TMP(PSONSP,$J,IEN,0)=^TMP(PSONSP,$J,IEN,0)_" Originator: "_$P(AGNL,"^",2)
- S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Verified: "_$S($P(AGNL,"^",4)="VERIFIED":"Yes",$P(AGNL,"^",4)="NOT VERIFIED":"No ",1:" ")
- S ^TMP(PSONSP,$J,IEN,0)=^TMP(PSONSP,$J,IEN,0)_" OBS/Hist: "_$P(AGNL,"^",5)
- S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=""
- ;get originator comments
- S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Comments: " ;,ORC=$E(ORC,2,99999)
- ;S ORC="" I $D(AGNL("C",1)) F ORT=0:0 S ORT=$O(AGNL("C",1,ORT)) Q:'ORT!(ORT>8)!($L(ORC)+$L($G(AGNL("C",1,ORT,0)))>432) S ORC=ORC_";"_$G(AGNL("C",1,ORT,0))
- ;S ORC=$E(ORC,2,99999) F OG=1:1:$L(ORC) Q:$P(ORC,";",OG)="" S:$L(^TMP(PSONSP,$J,IEN,0)_$P(ORC,";",OG))>75 IEN=IEN+1,$P(^TMP(PSONSP,$J,IEN,0)," ",1)=" " S ^TMP(PSONSP,$J,IEN,0)=$G(^TMP(PSONSP,$J,IEN,0))_" "_$P(ORC,";",OG)
- I $D(AGNL("C",1)) F ORT=0:0 S ORT=$O(AGNL("C",1,ORT)) Q:'ORT S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=$G(AGNL("C",1,ORT,0))
- ;get signs/symptoms
- S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=""
- S SYM="" I $D(AGNL("S")) F SNM=0:0 S SNM=$O(AGNL("S",SNM)) Q:'SNM S SYM=SYM_","_$G(AGNL("S",SNM))
- S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Signs/Symptoms: ",SYM=$E(SYM,2,99999)
- F SG=1:1:$L(SYM) Q:$P(SYM,",",SG)="" S LCC=SG,LC=0
- F SG=1:1:$L(SYM) Q:$P(SYM,",",SG)="" D
- .S:$L(^TMP(PSONSP,$J,IEN,0)_$P(SYM,",",SG))>50 IEN=IEN+1,$P(^TMP(PSONSP,$J,IEN,0)," ",19)=" "
- .S ^TMP(PSONSP,$J,IEN,0)=$G(^TMP(PSONSP,$J,IEN,0))_$P(SYM,",",SG)_$S($G(LC)=0&($G(SG)=LCC):"",$G(SG)<LCC:", ",$G(LC)>0&($G(SG)=LCC):"",$G(LC)>0&($G(SG)<LCC):", ",1:"")
- S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Mechanism: "_$P(AGNL,"^",6)
- ;
- I $D(PSJINPT) S PSJAL=IEN D EXT Q
- S PSOAL=IEN D EN^PSOLMAL
- EXT K AGNL,CG,CLS,CPT,CT,IG,IN,ING,ING1,ING2,IPT,IT,LC,LCC,NB,NUM,OD,ODT,OG,ORC,ORT,SG,SNM,SYM,Y
- Q
- DT(DT) ; - Convert FM Date to MM/DD/YYYY
- Q $E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORDA 9767 printed Jan 18, 2025@03:32:56 Page 2
- PSOORDA ;ISC-BHAM/LC - build detailed allergy list ;Aug 05, 2021@09:28:21
- +1 ;;7.0;OUTPATIENT PHARMACY;**44,139,152,186,441**;DEC 1997;Build 208
- +2 ;External reference to EN1^GMRADPT supported by DBIA 10099
- +3 ;External reference to EN1^GMRAOR2 supported by DBIA 2422
- +4 ;
- +5 ;Inpatient Pharmacy's DBIA 2211 allows reference to ^TMP("PSJAL" and ^TMP("PSJDA"
- +6 ;
- +7 ;PSO*7*186 Newing of variables to protect their global values
- +8 ;
- BEG(DFN) NEW VALMCNT,DR,IEN
- SET GMRA="0^0^111"
- SET IEN=0
- DO EN1^GMRADPT
- +1 NEW PSONSP
- SET PSONSP=$SELECT($GET(PSJINPT):"PSJDA",1:"PSODA")
- +2 KILL ^TMP(PSONSP,$JOB)
- IF 'GMRAL
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=$SELECT($GET(GMRAL)=0:"No Known Allergies",'GMRAL:"Patient has not been asked about allergies",1:"")
- +3 SET (OT,FD,DG,LTO,VY,NVY,VDG,VDGF,VDGFO,VDGO,VFD,VFDO,VOT,NDG,NDGF,NDGFO,NDGO,NFD,NFDO,NOT)=0
- SET (NU,TY)=""
- if $GET(GMRAL)
- Begin DoDot:1
- +4 FOR DR=0:0
- SET DR=$ORDER(GMRAL(DR))
- if 'DR
- QUIT
- SET AG($SELECT($PIECE(GMRAL(DR),"^",4):1,1:2),$PIECE(GMRAL(DR),"^",7),$PIECE(GMRAL(DR),"^",2))=DR_"^"_$PIECE(GMRAL(DR),"^",2)_"^"_+$PIECE(GMRAL(DR),"^",4)_"^"_+$PIECE(GMRAL(DR),"^",8)
- +5 FOR
- SET NU=$ORDER(AG(NU))
- if 'NU
- QUIT
- if NU=1
- SET VY=1
- if NU=2
- SET NVY=1
- FOR
- SET TY=$ORDER(AG(NU,TY))
- if TY=""
- QUIT
- Begin DoDot:2
- +6 if VY&(TY="D")
- SET VDG=1
- if VY&(TY="DF")
- SET VDGF=1
- if VY&(TY="DFO")
- SET VDGFO=1
- if VY&(TY="DO")
- SET VDGO=1
- if VY&(TY="F")
- SET VFD=1
- if VY&(TY="FO")
- SET VFDO=1
- if VY&(TY="O")
- SET VOT=1
- +7 if NVY&(TY="D")
- SET NDG=1
- if NVY&(TY="DF")
- SET NDGF=1
- if NVY&(TY="DFO")
- SET NDGFO=1
- if NVY&(TY="DO")
- SET NDGO=1
- if NVY&(TY="F")
- SET NFD=1
- if NVY&(TY="FO")
- SET NFDO=1
- if NVY&(TY="O")
- SET NOT=1
- End DoDot:2
- +8 if VY
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Verified"
- +9 if VDG
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Drug: "
- +10 SET AL=""
- FOR
- SET AL=$ORDER(AG(1,"D",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +11 SET DG=DG+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_DG_" "_AL
- SET AGN(DG)=$PIECE(AG(1,"D",AL),"^")
- End DoDot:2
- +12 if VDGF
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Drug/Food: "
- +13 SET AL=""
- FOR
- SET AL=$ORDER(AG(1,"DF",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +14 SET DG=DG+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_DG_" "_AL
- SET AGN(DG)=$PIECE(AG(1,"DF",AL),"^")
- End DoDot:2
- +15 if VDGFO
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Drug/Food/Other: "
- +16 SET AL=""
- FOR
- SET AL=$ORDER(AG(1,"DFO",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +17 SET DG=DG+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_DG_" "_AL
- SET AGN(DG)=$PIECE(AG(1,"DFO",AL),"^")
- End DoDot:2
- +18 if VDGO
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Drug/Other: "
- +19 SET AL=""
- FOR
- SET AL=$ORDER(AG(1,"DO",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +20 SET DG=DG+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_DG_" "_AL
- SET AGN(DG)=$PIECE(AG(1,"DO",AL),"^")
- End DoDot:2
- +21 if VFD
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Food: "
- +22 SET AL=""
- FOR
- SET AL=$ORDER(AG(1,"F",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +23 SET FD=FD+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_(FD+DG)_" "_AL
- SET AGN(FD+DG)=$PIECE(AG(1,"F",AL),"^")
- End DoDot:2
- +24 if VFDO
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Food/Other: "
- +25 SET AL=""
- FOR
- SET AL=$ORDER(AG(1,"FO",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +26 SET FD=FD+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_(FD+DG)_" "_AL
- SET AGN(FD+DG)=$PIECE(AG(1,"FO",AL),"^")
- End DoDot:2
- +27 if VOT
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Other: "
- +28 SET AL=""
- FOR
- SET AL=$ORDER(AG(1,"O",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +29 SET OT=OT+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_(OT+FD+DG)_" "_AL
- SET AGN(OT+FD+DG)=$PIECE(AG(1,"O",AL),"^")
- End DoDot:2
- +30 SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "
- SET LTO=(OT+FD+DG)
- SET (OT,FD,DG)=0
- +31 if NVY
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)="Non-Verified"
- +32 if NDG
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Drug: "
- +33 SET AL=""
- FOR
- SET AL=$ORDER(AG(2,"D",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +34 SET DG=DG+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_(DG+LTO)_" "_AL
- SET AGN(DG+LTO)=$PIECE(AG(2,"D",AL),"^")
- End DoDot:2
- +35 if NDGF
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Drug/Food: "
- +36 SET AL=""
- FOR
- SET AL=$ORDER(AG(2,"DF",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +37 SET DG=DG+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_(DG+LTO)_" "_AL
- SET AGN(DG+LTO)=$PIECE(AG(2,"DF",AL),"^")
- End DoDot:2
- +38 if NDGFO
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Drug/Food/Other: "
- +39 SET AL=""
- FOR
- SET AL=$ORDER(AG(2,"DFO",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +40 SET DG=DG+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_(DG+LTO)_" "_AL
- SET AGN(DG+LTO)=$PIECE(AG(2,"DFO",AL),"^")
- End DoDot:2
- +41 if NDGO
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Drug/Other: "
- +42 SET AL=""
- FOR
- SET AL=$ORDER(AG(2,"DO",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +43 SET DG=DG+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_(DG+LTO)_" "_AL
- SET AGN(DG+LTO)=$PIECE(AG(2,"DO",AL),"^")
- End DoDot:2
- +44 if NFD
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Food: "
- +45 SET AL=""
- FOR
- SET AL=$ORDER(AG(2,"F",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +46 SET FD=FD+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_(FD+DG+LTO)_" "_AL
- SET AGN(FD+DG+LTO)=$PIECE(AG(2,"F",AL),"^")
- End DoDot:2
- +47 if NFDO
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Food/Other: "
- +48 SET AL=""
- FOR
- SET AL=$ORDER(AG(2,"FO",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +49 SET FD=FD+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_(FD+DG+LTO)_" "_AL
- SET AGN(FD+DG+LTO)=$PIECE(AG(2,"FO",AL),"^")
- End DoDot:2
- +50 if NOT
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Other: "
- +51 SET AL=""
- FOR
- SET AL=$ORDER(AG(2,"O",AL))
- if AL=""
- QUIT
- Begin DoDot:2
- +52 SET OT=OT+1
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "_(OT+FD+DG+LTO)_" "_AL
- SET AGN(OT+FD+DG+LTO)=$PIECE(AG(2,"O",AL),"^")
- End DoDot:2
- End DoDot:1
- +53 SET PSODA=IEN
- SET PSOALL=(OT+FD+DG+LTO)
- +54 if $DATA(PSJINPT)
- SET PSJDA=IEN
- SET PSJALL=(OT+FD+DG+LTO)
- +55 KILL AL,AG,DG,FD,GMRA,GMRAL,LTO,NU,OT,TY,VY,VDG,VDGF,VDGFO,VDGO,VFD,VFDO,VOT,NDG,NDGF,NDGFO,NDGO,NFD,NFDO,NOT,NVY
- +56 QUIT
- SEL ;select allergy for detail display
- +1 NEW ORD,ORN,IEN,VALMCNT
- IF '$GET(PSOALL)
- SET VALMSG="This patient has no Allergies!"
- SET VALMBCK=""
- QUIT
- +2 KILL DIR,DUOUT,DIRUT
- SET DIR("A")="Select Allergies by number"
- SET DIR(0)="LO^1:"_PSOALL
- DO ^DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))
- KILL DIR,DIRUT,DTOUT,DUOUT
- SET VALMBCK=""
- QUIT
- SELAL ;PSO*7*186
- NEW ORD,ORN,IEN,VALMCNT
- +1 KILL DIR,DIRUT,DTOUT,DTOUT
- SET PSOELSE=+Y
- IF +Y
- SET ALST=Y
- DO FULL^VALM1
- Begin DoDot:1
- +2 FOR ORD=1:1:$LENGTH(ALST,",")
- if $PIECE(ALST,",",ORD)']""
- QUIT
- SET ORN=+$PIECE(ALST,",",ORD)
- DO DSPLY(DFN)
- End DoDot:1
- +3 ;S PSONSP=$S($G(PSJINPT):"PSJAL",1:"PSODA")
- +4 IF 'PSOELSE
- SET VALMBCK=""
- +5 KILL ALST,PSOELSE
- +6 QUIT
- DSPLY(DFN) ;build detailed allergy display
- +1 NEW PSONSP
- SET PSONSP=$SELECT($GET(PSJINPT):"PSJAL",1:"PSOAL")
- +2 KILL ^TMP(PSONSP,$JOB),AGNL
- SET IEN=0
- SET NB=$GET(AGN(ORN))
- DO EN1^GMRAOR2(NB,"AGNL")
- +3 SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Causative Agent: "_$PIECE(AGNL,"^")
- +4 SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" "
- +5 SET ^TMP(PSONSP,$JOB,IEN,0)=^TMP(PSONSP,$JOB,IEN,0)_" Severity: "
- +6 IF $DATA(AGNL("O"))
- Begin DoDot:1
- +7 SET I=""
- FOR
- SET I=$ORDER(AGNL("O",I))
- if I=""
- QUIT
- Begin DoDot:2
- +8 IF $PIECE(AGNL("O",I),"^",2)=""
- QUIT
- +9 SET X=$$DT(+AGNL("O",I))_" "_$PIECE(AGNL("O",I),"^",2)
- +10 IF I=$ORDER(AGNL("O",""))
- SET ^TMP(PSONSP,$JOB,IEN,0)=^TMP(PSONSP,$JOB,IEN,0)_X
- QUIT
- +11 SET IEN=IEN+1
- SET $EXTRACT(^TMP(PSONSP,$JOB,IEN,0),63)=X
- End DoDot:2
- End DoDot:1
- +12 IF $DATA(AGNL("H"))
- Begin DoDot:1
- +13 SET X=$SELECT(+$GET(AGNL("H")):$$DT(+AGNL("H"))_" ",1:"")
- +14 SET X=X_$PIECE(AGNL("H"),"^",2)
- +15 SET ^TMP(PSONSP,$JOB,IEN,0)=^TMP(PSONSP,$JOB,IEN,0)_X
- QUIT
- +16 ;S IEN=IEN+1,$E(^TMP(PSONSP,$J,IEN,0),63)=X
- End DoDot:1
- +17 ;get ingredients
- +18 SET (ING,ING1)=""
- IF $DATA(AGNL("I"))
- FOR IT=0:1
- SET IN=$ORDER(AGNL("I",IT))
- if 'IN
- QUIT
- Begin DoDot:1
- +19 if $LENGTH(ING_";"_$PIECE($GET(AGNL("I",IN)),"^"))>230
- SET ING1=ING1_";"_$PIECE($GET(AGNL("I",IN)),"^")
- +20 if $LENGTH(ING_";"_$PIECE($GET(AGNL("I",IN)),"^"))<230
- SET ING=ING_";"_$PIECE($GET(AGNL("I",IN)),"^")
- End DoDot:1
- +21 SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Ingredients: "
- SET ING=$EXTRACT(ING,2,99999)
- SET ING1=$EXTRACT(ING1,2,99999)
- ING FOR IG=1:1:$LENGTH(ING)
- if $PIECE(ING,";",IG)=""
- QUIT
- SET LCC=IG
- SET LC=0
- +1 FOR IG=1:1:$LENGTH(ING)
- if $PIECE(ING,";",IG)=""
- QUIT
- Begin DoDot:1
- +2 if $LENGTH(^TMP(PSONSP,$JOB,IEN,0)_$PIECE(ING,";",IG))>50
- SET LC=LC+1
- SET IEN=IEN+1
- SET $PIECE(^TMP(PSONSP,$JOB,IEN,0)," ",19)=" "
- +3 SET ^TMP(PSONSP,$JOB,IEN,0)=$GET(^TMP(PSONSP,$JOB,IEN,0))_$PIECE(ING,";",IG)_$SELECT($GET(LC)=0&($GET(IG)=LCC):"",$GET(IG)<LCC:", ",$GET(LC)>0&($GET(IG)=LCC):"",$GET(LC)>0&($GET(IG)<LCC):", ",1:"")
- End DoDot:1
- +4 IF '$DATA(ING2)&($GET(ING1)]"")
- SET ING2=1
- SET ING=ING1
- GOTO ING
- +5 SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=""
- SET ODT=$SELECT($DATA(AGNL("C",1)):$PIECE(AGNL("C",1),"^"),1:"*******.******")
- SET OD=$PIECE(ODT,".")
- +6 ;
- +7 ;get drug class
- +8 SET CLS=""
- IF $DATA(AGNL("V"))
- FOR CT=0:1
- SET CPT=$ORDER(AGNL("V",CT))
- if 'CPT
- QUIT
- SET CLS=CLS_","_$PIECE($GET(AGNL("V",CPT)),"^",2)
- +9 SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" VA Drug Class: "
- SET CLS=$EXTRACT(CLS,2,99999)
- +10 FOR CG=1:1:$LENGTH(CLS)
- if $PIECE(CLS,",",CG)=""
- QUIT
- SET LCC=CG
- SET LC=0
- +11 FOR CG=1:1:$LENGTH(CLS)
- if $PIECE(CLS,",",CG)=""
- QUIT
- Begin DoDot:1
- +12 if $LENGTH(^TMP(PSONSP,$JOB,IEN,0)_$PIECE(CLS,",",CG))>50
- SET IEN=IEN+1
- SET $PIECE(^TMP(PSONSP,$JOB,IEN,0)," ",19)=" "
- +13 SET ^TMP(PSONSP,$JOB,IEN,0)=$GET(^TMP(PSONSP,$JOB,IEN,0))_$PIECE(CLS,",",CG)_$SELECT($GET(LC)=0&($GET(CG)=LCC):"",$GET(CG)<LCC:", ",$GET(LC)>0&($GET(CG)=LCC):"",$GET(LC)>0&($GET(CG)<LCC):", ",1:"")
- End DoDot:1
- +14 ;
- +15 SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Originated: "_$EXTRACT(OD,4,5)_"/"_$EXTRACT(OD,6,7)_"/"_$EXTRACT(OD,2,3)
- +16 SET ^TMP(PSONSP,$JOB,IEN,0)=^TMP(PSONSP,$JOB,IEN,0)_" Originator: "_$PIECE(AGNL,"^",2)
- +17 SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Verified: "_$SELECT($PIECE(AGNL,"^",4)="VERIFIED":"Yes",$PIECE(AGNL,"^",4)="NOT VERIFIED":"No ",1:" ")
- +18 SET ^TMP(PSONSP,$JOB,IEN,0)=^TMP(PSONSP,$JOB,IEN,0)_" OBS/Hist: "_$PIECE(AGNL,"^",5)
- +19 SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=""
- +20 ;get originator comments
- +21 ;,ORC=$E(ORC,2,99999)
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Comments: "
- +22 ;S ORC="" I $D(AGNL("C",1)) F ORT=0:0 S ORT=$O(AGNL("C",1,ORT)) Q:'ORT!(ORT>8)!($L(ORC)+$L($G(AGNL("C",1,ORT,0)))>432) S ORC=ORC_";"_$G(AGNL("C",1,ORT,0))
- +23 ;S ORC=$E(ORC,2,99999) F OG=1:1:$L(ORC) Q:$P(ORC,";",OG)="" S:$L(^TMP(PSONSP,$J,IEN,0)_$P(ORC,";",OG))>75 IEN=IEN+1,$P(^TMP(PSONSP,$J,IEN,0)," ",1)=" " S ^TMP(PSONSP,$J,IEN,0)=$G(^TMP(PSONSP,$J,IEN,0))_" "_$P(ORC,";",OG)
- +24 IF $DATA(AGNL("C",1))
- FOR ORT=0:0
- SET ORT=$ORDER(AGNL("C",1,ORT))
- if 'ORT
- QUIT
- SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=$GET(AGNL("C",1,ORT,0))
- +25 ;get signs/symptoms
- +26 SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=""
- +27 SET SYM=""
- IF $DATA(AGNL("S"))
- FOR SNM=0:0
- SET SNM=$ORDER(AGNL("S",SNM))
- if 'SNM
- QUIT
- SET SYM=SYM_","_$GET(AGNL("S",SNM))
- +28 SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Signs/Symptoms: "
- SET SYM=$EXTRACT(SYM,2,99999)
- +29 FOR SG=1:1:$LENGTH(SYM)
- if $PIECE(SYM,",",SG)=""
- QUIT
- SET LCC=SG
- SET LC=0
- +30 FOR SG=1:1:$LENGTH(SYM)
- if $PIECE(SYM,",",SG)=""
- QUIT
- Begin DoDot:1
- +31 if $LENGTH(^TMP(PSONSP,$JOB,IEN,0)_$PIECE(SYM,",",SG))>50
- SET IEN=IEN+1
- SET $PIECE(^TMP(PSONSP,$JOB,IEN,0)," ",19)=" "
- +32 SET ^TMP(PSONSP,$JOB,IEN,0)=$GET(^TMP(PSONSP,$JOB,IEN,0))_$PIECE(SYM,",",SG)_$SELECT($GET(LC)=0&($GET(SG)=LCC):"",$GET(SG)<LCC:", ",$GET(LC)>0&($GET(SG)=LCC):"",$GET(LC)>0&($GET(SG)<LCC):", ",1:"")
- End DoDot:1
- +33 SET IEN=IEN+1
- SET ^TMP(PSONSP,$JOB,IEN,0)=" Mechanism: "_$PIECE(AGNL,"^",6)
- +34 ;
- +35 IF $DATA(PSJINPT)
- SET PSJAL=IEN
- DO EXT
- QUIT
- +36 SET PSOAL=IEN
- DO EN^PSOLMAL
- EXT KILL AGNL,CG,CLS,CPT,CT,IG,IN,ING,ING1,ING2,IPT,IT,LC,LCC,NB,NUM,OD,ODT,OG,ORC,ORT,SG,SNM,SYM,Y
- +1 QUIT
- DT(DT) ; - Convert FM Date to MM/DD/YYYY
- +1 QUIT $EXTRACT(DT,4,5)_"/"_$EXTRACT(DT,6,7)_"/"_$EXTRACT(DT,2,3)