- PSJORDA ;BIR/LC BUILD DETAILED ALLERGY LIST- ;16 DEC 97 / 1:42 PM
- ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- BEG ;
- NEW PSJINPT S PSJINPT=1 D BEG^PSOORDA(DFN)
- Q
- SEL ;select allergy for detail display
- N ORD,ORN,IEN,VALMCNT I '$G(PSJALL) 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:"_PSJALL D ^DIR I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DUOUT S VALMBCK="" Q
- K DIR,DIRUT,DTOUT,DTOUT I +Y D FULL^VALM1 S ALST=Y D
- .F ORD=1:1:$L(ALST,",") Q:$P(ALST,",",ORD)']"" S ORN=$P(ALST,",",ORD) D DSPLY
- E S VALMBCK=""
- K ALST
- Q
- DSPLY ;build detailed allergy display
- NEW PSJINPT S PSJINPT=1 D DSPLY^PSOORDA(DFN),EN^PSJLMAL
- Q
- EXT K AGNL,CG,CLS,CPT,IG,ING,IPT,NB,OD,ODT,OG,ORC,ORT,SG,SNM,SYM,Y
- Q
- NEWSEL ;
- N ORD,ORN,IEN,VALMCNT I '$G(PSJALL) S VALMSG="This patient has no Allergies!" S VALMBCK="" Q
- S ALST=$P(XQORNOD(0),"=",2)
- I '$O(AGN(0)) S VALMQUIT=1 Q
- I $D(ALST) D FULL^VALM1 D
- .F ORD=1:1:$L(ALST,",") Q:$P(ALST,",",ORD)']"" S ORN=$P(ALST,",",ORD) D DSPLY
- E S VALMBCK=""
- K ALST
- G EXT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJORDA 1108 printed Feb 18, 2025@23:34:38 Page 2
- PSJORDA ;BIR/LC BUILD DETAILED ALLERGY LIST- ;16 DEC 97 / 1:42 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;;16 DEC 97
- BEG ;
- +1 NEW PSJINPT
- SET PSJINPT=1
- DO BEG^PSOORDA(DFN)
- +2 QUIT
- SEL ;select allergy for detail display
- +1 NEW ORD,ORN,IEN,VALMCNT
- IF '$GET(PSJALL)
- 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:"_PSJALL
- DO ^DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))
- KILL DIR,DIRUT,DTOUT,DUOUT
- SET VALMBCK=""
- QUIT
- +3 KILL DIR,DIRUT,DTOUT,DTOUT
- IF +Y
- DO FULL^VALM1
- SET ALST=Y
- Begin DoDot:1
- +4 FOR ORD=1:1:$LENGTH(ALST,",")
- if $PIECE(ALST,",",ORD)']""
- QUIT
- SET ORN=$PIECE(ALST,",",ORD)
- DO DSPLY
- End DoDot:1
- +5 IF '$TEST
- SET VALMBCK=""
- +6 KILL ALST
- +7 QUIT
- DSPLY ;build detailed allergy display
- +1 NEW PSJINPT
- SET PSJINPT=1
- DO DSPLY^PSOORDA(DFN)
- DO EN^PSJLMAL
- +2 QUIT
- EXT KILL AGNL,CG,CLS,CPT,IG,ING,IPT,NB,OD,ODT,OG,ORC,ORT,SG,SNM,SYM,Y
- +1 QUIT
- NEWSEL ;
- +1 NEW ORD,ORN,IEN,VALMCNT
- IF '$GET(PSJALL)
- SET VALMSG="This patient has no Allergies!"
- SET VALMBCK=""
- QUIT
- +2 SET ALST=$PIECE(XQORNOD(0),"=",2)
- +3 IF '$ORDER(AGN(0))
- SET VALMQUIT=1
- QUIT
- +4 IF $DATA(ALST)
- DO FULL^VALM1
- Begin DoDot:1
- +5 FOR ORD=1:1:$LENGTH(ALST,",")
- if $PIECE(ALST,",",ORD)']""
- QUIT
- SET ORN=$PIECE(ALST,",",ORD)
- DO DSPLY
- End DoDot:1
- +6 IF '$TEST
- SET VALMBCK=""
- +7 KILL ALST
- +8 GOTO EXT
- +9 QUIT