PSJORDA.m

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 ---PSJORDA   1108     printed  Apr 09, 2024@21:09:41                                                                                                                                                                                                     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