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

PSJORDA.m

Go to the documentation of this file.
  1. PSJORDA ;BIR/LC BUILD DETAILED ALLERGY LIST- ;16 DEC 97 / 1:42 PM
  1. ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
  1. BEG ;
  1. NEW PSJINPT S PSJINPT=1 D BEG^PSOORDA(DFN)
  1. Q
  1. SEL ;select allergy for detail display
  1. N ORD,ORN,IEN,VALMCNT I '$G(PSJALL) S VALMSG="This patient has no Allergies!" S VALMBCK="" Q
  1. K DIR,DUOUT,DIRUT S DIR("A")="Select Allergies by number",DIR(0)="LO^1:"_PSJALL D ^DIR I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DUOUT S VALMBCK="" Q
  1. K DIR,DIRUT,DTOUT,DTOUT I +Y D FULL^VALM1 S ALST=Y D
  1. .F ORD=1:1:$L(ALST,",") Q:$P(ALST,",",ORD)']"" S ORN=$P(ALST,",",ORD) D DSPLY
  1. E S VALMBCK=""
  1. K ALST
  1. Q
  1. DSPLY ;build detailed allergy display
  1. NEW PSJINPT S PSJINPT=1 D DSPLY^PSOORDA(DFN),EN^PSJLMAL
  1. Q
  1. EXT K AGNL,CG,CLS,CPT,IG,ING,IPT,NB,OD,ODT,OG,ORC,ORT,SG,SNM,SYM,Y
  1. Q
  1. NEWSEL ;
  1. N ORD,ORN,IEN,VALMCNT I '$G(PSJALL) S VALMSG="This patient has no Allergies!" S VALMBCK="" Q
  1. S ALST=$P(XQORNOD(0),"=",2)
  1. I '$O(AGN(0)) S VALMQUIT=1 Q
  1. I $D(ALST) D FULL^VALM1 D
  1. .F ORD=1:1:$L(ALST,",") Q:$P(ALST,",",ORD)']"" S ORN=$P(ALST,",",ORD) D DSPLY
  1. E S VALMBCK=""
  1. K ALST
  1. G EXT
  1. Q