PSOPMP1 ;BIRM/MFR - Patient Medication Profile - Listmanager ;04/28/05
;;7.0;OUTPATIENT PHARMACY;**260,285,281,303,289,276,382**;DEC 1997;Build 9
;Reference to ^PSDRUG("AQ" supported by IA 3165
;Reference to EN1^GMRADPT supported by IA 10099
;Reference to ^PSXOPUTL supported by IA 2200
;
VIDEO() ; - Changes the Video Attributes for the list
;
; - Highlighting the PRESCRIPTION line if SIG is displayed
I $G(PSOSIGDP) D
. F I=1:1:LINE D
. . I $D(HIGHLN(I)) D CNTRL^VALM10(I,1,80,IOINHI,IOINORM)
;
; - Highlighting the group lines (order type and status)
I $D(GRPLN) D
. S LN=0 F I=1:1 S LN=$O(GRPLN(LN)) Q:'LN D
. . S LBL=GRPLN(LN),POS=41-($L(LBL)\2)
. . D CNTRL^VALM10(LN,1,POS-1,IOUON_IOINHI,IOINORM)
. . D CNTRL^VALM10(LN,POS,$L(LBL),IORVON_IOINHI,IORVOFF_IOINORM)
. . D CNTRL^VALM10(LN,POS+$L(LBL),81-POS-$L(LBL),IOUON_IOINHI,IOINORM)
Q
;
RV ;reverse video for flagged pending orders
N PSLIST S PSLIST=0 F PSLIST=1:1:VALMCNT D
.Q:'$D(^TMP("PSOPMP0",$J,PSLIST,"RV"))
.I $D(^TMP("PSOPMP0",$J,PSLIST,"RV")) D CNTRL^VALM10(PSLIST,1,3,IORVON,IORVOFF,0) Q
Q
;
SETHDR() ; - Displays the Header Line
N HDR,ORD,POS
;
; - Line 1
S $E(HDR,57)="ISSUE",$E(HDR,66)="LAST",$E(HDR,74)="REF",$E(HDR,78)="DAY"
S $E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,6)
; - Line 2
S HDR=" #",$E(HDR,5)="Rx#",$E(HDR,19)="DRUG",$E(HDR,49)="QTY",$E(HDR,53)="ST"
S $E(HDR,57)="DATE",$E(HDR,66)="FILL",$E(HDR,74)="REM",$E(HDR,78)="SUP"
S $E(HDR,81)="" D INSTR^VALM1(IORVON_HDR_IOINORM,1,7)
S ORD=$S(PSORDER="A":"[^]",1:"[v]")
S:PSOSRTBY="RX" POS=9 S:PSOSRTBY="DR" POS=24 S:PSOSRTBY="ID" POS=61 S:PSOSRTBY="LF" POS=70
D INSTR^VALM1(IOINHI_IORVON_ORD_IOINORM,POS,7)
Q
;
SETSIG(TYPE,RX,LINE,DFN) ; Set the SIG line
N FSIG,L,X,DIWL,DIWR
;
I TYPE="N" D Q
. K ^UTILITY($J,"W")
. S X=$$SCHED^PSONVNEW($$GET1^DIQ(55.05,RX_","_DFN,4)),DIWL=1,DIWR=71 D ^DIWP
. F L=1:1 Q:'$D(^UTILITY($J,"W",1,L)) D
. . S X="" S:L=1 $E(X,5)="SIG:" S $E(X,10)=^UTILITY($J,"W",1,L,0)
. . S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X
;
D FSIG^PSOUTLA(TYPE,+RX,71)
F L=1:1 Q:'$D(FSIG(L)) D
. S X="" S:L=1 $E(X,5)="SIG:" S $E(X,10)=FSIG(L)
. S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X
Q
;
GROUP(LBL,CNT,LINE) ; Sets a group delimiter line
N X,POS
S LBL=LBL_$S(PSORDCNT:" ("_CNT_" order"_$S(CNT>1:"s",1:"")_")",1:"")
S POS=41-($L(LBL)\2)
S X="",$P(X," ",81)="",$E(X,POS,POS-1+$L(LBL))=LBL
S LINE=LINE+1,^TMP("PSOPMP0",$J,LINE,0)=X,GRPLN(LINE)=LBL
Q
;
PENHDR(DFN) ; Sets the Header in the ^TMP("PSOHDR",$J) global for displaying individual Pending Order
N VADM,WT,HT,PSOERR,GMRA
K ^TMP("PSOHDR",$J) D ^VADPT,ADD^VADPT
S ^TMP("PSOHDR",$J,1,0)=VADM(1),^TMP("PSOHDR",$J,2,0)=$P(VADM(2),"^",2)
S ^TMP("PSOHDR",$J,3,0)=$P(VADM(3),"^",2),^TMP("PSOHDR",$J,4,0)=VADM(4),^TMP("PSOHDR",$J,5,0)=$P(VADM(5),"^",2)
S POERR=1 D RE^PSODEM K PSOERR
S ^TMP("PSOHDR",$J,6,0)=$S(+$P(WT,"^",8):$J($P(WT,"^",9),6)_" ("_$P(WT,"^")_")",1:"_______ (______)")
S ^TMP("PSOHDR",$J,7,0)=$S($P(HT,"^",8):$J($P(HT,"^",9),6)_" ("_$P(HT,"^")_")",1:"_______ (______)") K VM,WT,HT S PSOHD=7
S GMRA="0^0^111" D EN1^GMRADPT S ^TMP("PSOHDR",$J,8,0)=+$G(GMRAL)
Q
;
FILTER(RX) ; - Filter Rx's that should not be displayed
I $$GET1^DIQ(52,RX,26,"I")<PSOEXPDC Q 1
I $$GET1^DIQ(52,RX,26.1,"I"),$$GET1^DIQ(52,RX,26.1,"I")<PSOEXPDC,$$GET1^DIQ(52,RX,100,"I")>11,$$GET1^DIQ(52,RX,100,"I")'=16 Q 1
I $$GET1^DIQ(52,RX,100,"I")=""!($$GET1^DIQ(52,RX,100,"I")=13) Q 1
I $$GET1^DIQ(52,RX,.01)="" Q 1
Q 0
;
STSINFO(RX) ; Returns the Rx Status MNEMONIC^NAME
; Input: RX - Prescription IEN (#52)
;Output: Status Mnemonic ("A","DC",etc.)^Status Name ("ACTIVE","DISCONTINUED",etc.)
;
N STS
I '$D(^PSRX(RX,"STA")) Q ""
S STS=$$GET1^DIQ(52,RX,100,"I")
I STS=0 Q:$$GET1^DIQ(52,RX,26,"I")>DT PSOSTSEQ("A") Q PSOSTSEQ("E")
I STS=1 Q PSOSTSEQ("N")
I STS=3 Q PSOSTSEQ("H")
I STS=5 Q PSOSTSEQ("S")
I STS=11 Q PSOSTSEQ("E")
I STS=12 Q PSOSTSEQ("DC")
I STS=14 Q PSOSTSEQ("DP")
I STS=15 Q PSOSTSEQ("DE")
I STS=16 Q PSOSTSEQ("PH")
Q "99^UNKNOWN^??"
;
ISSDT(IEN,TYPE) ; Returns the Rx ISSUE DATE formatted MM-DD-YY
;Input: RX - Prescription IEN (#52)
; TYPE - "R":Regular Rx, "P":Pending order
N ISSDT
I TYPE="R" S ISSDT=$$GET1^DIQ(52,IEN,1,"I")
I TYPE="P" S ISSDT=$$GET1^DIQ(52.41,IEN,6,"I")
I ISSDT'="" S ISSDT=ISSDT\1
;
Q (ISSDT_"^"_$$DAT(ISSDT,"-"))
;
LSTFD(RX) ; Returns the Rx LAST FILL DATE formatted MM-DD-YY[R], where [R] = Returned to Stock
;Input: RX - Prescription IEN (#52)
N LSTFD,RTSTK,RFL
S LSTFD=$$GET1^DIQ(52,RX,101,"I")\1 I LSTFD="" Q ""
I '$$LSTRFL^PSOBPSU1(RX) D
. I $$GET1^DIQ(52,RX,32.1,"I") S RTSTK="R"
E S RFL=0 F S RFL=$O(^PSRX(RX,1,RFL)) Q:'RFL D
. I $$RXFLDT^PSOBPSUT(RX,RFL)'=LSTFD Q
. I $$GET1^DIQ(52.1,RFL_","_RX,14,"I") S RTSTK="R"
;
Q (LSTFD_"^"_$$DAT(LSTFD,"-")_$G(RTSTK))
;
REFREM(RX) ; - Returns the number of refills remaining
N REFREM,RFL
S REFREM=+$$GET1^DIQ(52,RX,9),RFL=0
F S RFL=$O(^PSRX(RX,1,RFL)) Q:'RFL S REFREM=REFREM-1
Q $S(REFREM<0:0,1:REFREM)
;
;
DAT(FMDT,SEP,Y4) ; - Formats FM dates to MM/DD/YY (SEP: Separator:"/","-",etc...)
;Input: (r) FMDT - Fileman Date
; (r) SEP - Separator
; (o) Y4 - 4 digits year flag
I $G(FMDT)="" Q ""
I '$E(FMDT,6,7)!'$E(FMDT,4,7) Q $$UP^XLFSTR($TR($$FMTE^XLFDT(FMDT)," ","-"))
Q ($E(FMDT,4,5)_SEP_$E(FMDT,6,7)_SEP_$S($G(Y4):$E(FMDT,1,3)+1700,1:$E(FMDT,2,3)))
;
COPAY(RX) ; Returns "$" is Rx has a copay and "" if not
Q $S($G(^PSRX(RX,"IB")):"$",1:"") ;*276
;
CMOP(DRUG,RX) ; Returns the CMOP indicator (">", "T", etc)
N CMOP,X,DA,PSXZ
S CMOP="" I $D(^PSDRUG("AQ",DRUG)) S CMOP=">"
I $G(RX) S DA=RX D ^PSXOPUTL I $G(PSXZ(PSXZ("L")))=0!($G(PSXZ(PSXZ("L")))=2) S CMOP="T"
Q CMOP
;
ALLERGY(LINE,DFN,POS) ; also called from PSONVAVW & PSOPMP0
; Input: LINE - (r) text to concatenate allergy information to
; DFN - (r) patient IEN used for ^GMRADTP
; POS - (o) position # to include text
;Output: LINE - modified text
N ALLERGY,PSONOAL
S (PSONOAL,ALLERGY)=""
D EN1^GMRADPT
I GMRAL S ALLERGY="<A>"
E D ALLERGY^PSOORUT2 I PSONOAL'="" S ALLERGY="<NO ALLERGY ASSESSMENT>"
S ALLERGY=IORVON_ALLERGY_IORVOFF_IOINORM
I '$G(POS) S POS=80-$L(ALLERGY)
S LINE=$$SETSTR^VALM1(ALLERGY,LINE,POS,80)
Q LINE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOPMP1 6398 printed Sep 23, 2025@20:09:11 Page 2
PSOPMP1 ;BIRM/MFR - Patient Medication Profile - Listmanager ;04/28/05
+1 ;;7.0;OUTPATIENT PHARMACY;**260,285,281,303,289,276,382**;DEC 1997;Build 9
+2 ;Reference to ^PSDRUG("AQ" supported by IA 3165
+3 ;Reference to EN1^GMRADPT supported by IA 10099
+4 ;Reference to ^PSXOPUTL supported by IA 2200
+5 ;
VIDEO() ; - Changes the Video Attributes for the list
+1 ;
+2 ; - Highlighting the PRESCRIPTION line if SIG is displayed
+3 IF $GET(PSOSIGDP)
Begin DoDot:1
+4 FOR I=1:1:LINE
Begin DoDot:2
+5 IF $DATA(HIGHLN(I))
DO CNTRL^VALM10(I,1,80,IOINHI,IOINORM)
End DoDot:2
End DoDot:1
+6 ;
+7 ; - Highlighting the group lines (order type and status)
+8 IF $DATA(GRPLN)
Begin DoDot:1
+9 SET LN=0
FOR I=1:1
SET LN=$ORDER(GRPLN(LN))
if 'LN
QUIT
Begin DoDot:2
+10 SET LBL=GRPLN(LN)
SET POS=41-($LENGTH(LBL)\2)
+11 DO CNTRL^VALM10(LN,1,POS-1,IOUON_IOINHI,IOINORM)
+12 DO CNTRL^VALM10(LN,POS,$LENGTH(LBL),IORVON_IOINHI,IORVOFF_IOINORM)
+13 DO CNTRL^VALM10(LN,POS+$LENGTH(LBL),81-POS-$LENGTH(LBL),IOUON_IOINHI,IOINORM)
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
RV ;reverse video for flagged pending orders
+1 NEW PSLIST
SET PSLIST=0
FOR PSLIST=1:1:VALMCNT
Begin DoDot:1
+2 if '$DATA(^TMP("PSOPMP0",$JOB,PSLIST,"RV"))
QUIT
+3 IF $DATA(^TMP("PSOPMP0",$JOB,PSLIST,"RV"))
DO CNTRL^VALM10(PSLIST,1,3,IORVON,IORVOFF,0)
QUIT
End DoDot:1
+4 QUIT
+5 ;
SETHDR() ; - Displays the Header Line
+1 NEW HDR,ORD,POS
+2 ;
+3 ; - Line 1
+4 SET $EXTRACT(HDR,57)="ISSUE"
SET $EXTRACT(HDR,66)="LAST"
SET $EXTRACT(HDR,74)="REF"
SET $EXTRACT(HDR,78)="DAY"
+5 SET $EXTRACT(HDR,81)=""
DO INSTR^VALM1(IORVON_HDR_IOINORM,1,6)
+6 ; - Line 2
+7 SET HDR=" #"
SET $EXTRACT(HDR,5)="Rx#"
SET $EXTRACT(HDR,19)="DRUG"
SET $EXTRACT(HDR,49)="QTY"
SET $EXTRACT(HDR,53)="ST"
+8 SET $EXTRACT(HDR,57)="DATE"
SET $EXTRACT(HDR,66)="FILL"
SET $EXTRACT(HDR,74)="REM"
SET $EXTRACT(HDR,78)="SUP"
+9 SET $EXTRACT(HDR,81)=""
DO INSTR^VALM1(IORVON_HDR_IOINORM,1,7)
+10 SET ORD=$SELECT(PSORDER="A":"[^]",1:"[v]")
+11 if PSOSRTBY="RX"
SET POS=9
if PSOSRTBY="DR"
SET POS=24
if PSOSRTBY="ID"
SET POS=61
if PSOSRTBY="LF"
SET POS=70
+12 DO INSTR^VALM1(IOINHI_IORVON_ORD_IOINORM,POS,7)
+13 QUIT
+14 ;
SETSIG(TYPE,RX,LINE,DFN) ; Set the SIG line
+1 NEW FSIG,L,X,DIWL,DIWR
+2 ;
+3 IF TYPE="N"
Begin DoDot:1
+4 KILL ^UTILITY($JOB,"W")
+5 SET X=$$SCHED^PSONVNEW($$GET1^DIQ(55.05,RX_","_DFN,4))
SET DIWL=1
SET DIWR=71
DO ^DIWP
+6 FOR L=1:1
if '$DATA(^UTILITY($JOB,"W",1,L))
QUIT
Begin DoDot:2
+7 SET X=""
if L=1
SET $EXTRACT(X,5)="SIG:"
SET $EXTRACT(X,10)=^UTILITY($JOB,"W",1,L,0)
+8 SET LINE=LINE+1
SET ^TMP("PSOPMP0",$JOB,LINE,0)=X
End DoDot:2
End DoDot:1
QUIT
+9 ;
+10 DO FSIG^PSOUTLA(TYPE,+RX,71)
+11 FOR L=1:1
if '$DATA(FSIG(L))
QUIT
Begin DoDot:1
+12 SET X=""
if L=1
SET $EXTRACT(X,5)="SIG:"
SET $EXTRACT(X,10)=FSIG(L)
+13 SET LINE=LINE+1
SET ^TMP("PSOPMP0",$JOB,LINE,0)=X
End DoDot:1
+14 QUIT
+15 ;
GROUP(LBL,CNT,LINE) ; Sets a group delimiter line
+1 NEW X,POS
+2 SET LBL=LBL_$SELECT(PSORDCNT:" ("_CNT_" order"_$SELECT(CNT>1:"s",1:"")_")",1:"")
+3 SET POS=41-($LENGTH(LBL)\2)
+4 SET X=""
SET $PIECE(X," ",81)=""
SET $EXTRACT(X,POS,POS-1+$LENGTH(LBL))=LBL
+5 SET LINE=LINE+1
SET ^TMP("PSOPMP0",$JOB,LINE,0)=X
SET GRPLN(LINE)=LBL
+6 QUIT
+7 ;
PENHDR(DFN) ; Sets the Header in the ^TMP("PSOHDR",$J) global for displaying individual Pending Order
+1 NEW VADM,WT,HT,PSOERR,GMRA
+2 KILL ^TMP("PSOHDR",$JOB)
DO ^VADPT
DO ADD^VADPT
+3 SET ^TMP("PSOHDR",$JOB,1,0)=VADM(1)
SET ^TMP("PSOHDR",$JOB,2,0)=$PIECE(VADM(2),"^",2)
+4 SET ^TMP("PSOHDR",$JOB,3,0)=$PIECE(VADM(3),"^",2)
SET ^TMP("PSOHDR",$JOB,4,0)=VADM(4)
SET ^TMP("PSOHDR",$JOB,5,0)=$PIECE(VADM(5),"^",2)
+5 SET POERR=1
DO RE^PSODEM
KILL PSOERR
+6 SET ^TMP("PSOHDR",$JOB,6,0)=$SELECT(+$PIECE(WT,"^",8):$JUSTIFY($PIECE(WT,"^",9),6)_" ("_$PIECE(WT,"^")_")",1:"_______ (______)")
+7 SET ^TMP("PSOHDR",$JOB,7,0)=$SELECT($PIECE(HT,"^",8):$JUSTIFY($PIECE(HT,"^",9),6)_" ("_$PIECE(HT,"^")_")",1:"_______ (______)")
KILL VM,WT,HT
SET PSOHD=7
+8 SET GMRA="0^0^111"
DO EN1^GMRADPT
SET ^TMP("PSOHDR",$JOB,8,0)=+$GET(GMRAL)
+9 QUIT
+10 ;
FILTER(RX) ; - Filter Rx's that should not be displayed
+1 IF $$GET1^DIQ(52,RX,26,"I")<PSOEXPDC
QUIT 1
+2 IF $$GET1^DIQ(52,RX,26.1,"I")
IF $$GET1^DIQ(52,RX,26.1,"I")<PSOEXPDC
IF $$GET1^DIQ(52,RX,100,"I")>11
IF $$GET1^DIQ(52,RX,100,"I")'=16
QUIT 1
+3 IF $$GET1^DIQ(52,RX,100,"I")=""!($$GET1^DIQ(52,RX,100,"I")=13)
QUIT 1
+4 IF $$GET1^DIQ(52,RX,.01)=""
QUIT 1
+5 QUIT 0
+6 ;
STSINFO(RX) ; Returns the Rx Status MNEMONIC^NAME
+1 ; Input: RX - Prescription IEN (#52)
+2 ;Output: Status Mnemonic ("A","DC",etc.)^Status Name ("ACTIVE","DISCONTINUED",etc.)
+3 ;
+4 NEW STS
+5 IF '$DATA(^PSRX(RX,"STA"))
QUIT ""
+6 SET STS=$$GET1^DIQ(52,RX,100,"I")
+7 IF STS=0
if $$GET1^DIQ(52,RX,26,"I")>DT
QUIT PSOSTSEQ("A")
QUIT PSOSTSEQ("E")
+8 IF STS=1
QUIT PSOSTSEQ("N")
+9 IF STS=3
QUIT PSOSTSEQ("H")
+10 IF STS=5
QUIT PSOSTSEQ("S")
+11 IF STS=11
QUIT PSOSTSEQ("E")
+12 IF STS=12
QUIT PSOSTSEQ("DC")
+13 IF STS=14
QUIT PSOSTSEQ("DP")
+14 IF STS=15
QUIT PSOSTSEQ("DE")
+15 IF STS=16
QUIT PSOSTSEQ("PH")
+16 QUIT "99^UNKNOWN^??"
+17 ;
ISSDT(IEN,TYPE) ; Returns the Rx ISSUE DATE formatted MM-DD-YY
+1 ;Input: RX - Prescription IEN (#52)
+2 ; TYPE - "R":Regular Rx, "P":Pending order
+3 NEW ISSDT
+4 IF TYPE="R"
SET ISSDT=$$GET1^DIQ(52,IEN,1,"I")
+5 IF TYPE="P"
SET ISSDT=$$GET1^DIQ(52.41,IEN,6,"I")
+6 IF ISSDT'=""
SET ISSDT=ISSDT\1
+7 ;
+8 QUIT (ISSDT_"^"_$$DAT(ISSDT,"-"))
+9 ;
LSTFD(RX) ; Returns the Rx LAST FILL DATE formatted MM-DD-YY[R], where [R] = Returned to Stock
+1 ;Input: RX - Prescription IEN (#52)
+2 NEW LSTFD,RTSTK,RFL
+3 SET LSTFD=$$GET1^DIQ(52,RX,101,"I")\1
IF LSTFD=""
QUIT ""
+4 IF '$$LSTRFL^PSOBPSU1(RX)
Begin DoDot:1
+5 IF $$GET1^DIQ(52,RX,32.1,"I")
SET RTSTK="R"
End DoDot:1
+6 IF '$TEST
SET RFL=0
FOR
SET RFL=$ORDER(^PSRX(RX,1,RFL))
if 'RFL
QUIT
Begin DoDot:1
+7 IF $$RXFLDT^PSOBPSUT(RX,RFL)'=LSTFD
QUIT
+8 IF $$GET1^DIQ(52.1,RFL_","_RX,14,"I")
SET RTSTK="R"
End DoDot:1
+9 ;
+10 QUIT (LSTFD_"^"_$$DAT(LSTFD,"-")_$GET(RTSTK))
+11 ;
REFREM(RX) ; - Returns the number of refills remaining
+1 NEW REFREM,RFL
+2 SET REFREM=+$$GET1^DIQ(52,RX,9)
SET RFL=0
+3 FOR
SET RFL=$ORDER(^PSRX(RX,1,RFL))
if 'RFL
QUIT
SET REFREM=REFREM-1
+4 QUIT $SELECT(REFREM<0:0,1:REFREM)
+5 ;
+6 ;
DAT(FMDT,SEP,Y4) ; - Formats FM dates to MM/DD/YY (SEP: Separator:"/","-",etc...)
+1 ;Input: (r) FMDT - Fileman Date
+2 ; (r) SEP - Separator
+3 ; (o) Y4 - 4 digits year flag
+4 IF $GET(FMDT)=""
QUIT ""
+5 IF '$EXTRACT(FMDT,6,7)!'$EXTRACT(FMDT,4,7)
QUIT $$UP^XLFSTR($TRANSLATE($$FMTE^XLFDT(FMDT)," ","-"))
+6 QUIT ($EXTRACT(FMDT,4,5)_SEP_$EXTRACT(FMDT,6,7)_SEP_$SELECT($GET(Y4):$EXTRACT(FMDT,1,3)+1700,1:$EXTRACT(FMDT,2,3)))
+7 ;
COPAY(RX) ; Returns "$" is Rx has a copay and "" if not
+1 ;*276
QUIT $SELECT($GET(^PSRX(RX,"IB")):"$",1:"")
+2 ;
CMOP(DRUG,RX) ; Returns the CMOP indicator (">", "T", etc)
+1 NEW CMOP,X,DA,PSXZ
+2 SET CMOP=""
IF $DATA(^PSDRUG("AQ",DRUG))
SET CMOP=">"
+3 IF $GET(RX)
SET DA=RX
DO ^PSXOPUTL
IF $GET(PSXZ(PSXZ("L")))=0!($GET(PSXZ(PSXZ("L")))=2)
SET CMOP="T"
+4 QUIT CMOP
+5 ;
ALLERGY(LINE,DFN,POS) ; also called from PSONVAVW & PSOPMP0
+1 ; Input: LINE - (r) text to concatenate allergy information to
+2 ; DFN - (r) patient IEN used for ^GMRADTP
+3 ; POS - (o) position # to include text
+4 ;Output: LINE - modified text
+5 NEW ALLERGY,PSONOAL
+6 SET (PSONOAL,ALLERGY)=""
+7 DO EN1^GMRADPT
+8 IF GMRAL
SET ALLERGY="<A>"
+9 IF '$TEST
DO ALLERGY^PSOORUT2
IF PSONOAL'=""
SET ALLERGY="<NO ALLERGY ASSESSMENT>"
+10 SET ALLERGY=IORVON_ALLERGY_IORVOFF_IOINORM
+11 IF '$GET(POS)
SET POS=80-$LENGTH(ALLERGY)
+12 SET LINE=$$SETSTR^VALM1(ALLERGY,LINE,POS,80)
+13 QUIT LINE
