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 Dec 13, 2024@02:08:15 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
