TIULMED1 ; SLC/JM - Active/Recent Med Objects Routine ;03/23/17 10:53
;;1.0;TEXT INTEGRATION UTILITIES;**38,73,92,94,202,226,290**;Jun 20, 1997;Build 548
;
; All routines here are part of the LIST entry point of TIULMED
;
ADD(TXT) ; Saves TXT in TARGET
S NEXTLINE=NEXTLINE+1
I TAB S TXT=" "_TXT
I TAB,HEADER S TXT=" "_TXT
S @TARGET@(NEXTLINE,0)=TXT
Q
ADDLNUM(TXT) ; Add text with Line Number added to front of string
S TAB=0
I HEADER D ADD($E(COUNT_") ",1,5)_TXT) I 1
E D ADD(TXT)
S TAB=1
Q
ADDL(TXT) ; Add with ADDLNUM on FIRST
I FIRST D I 1
.D ADDLNUM(TXT)
.S FIRST=0
E D ADD(TXT)
Q
ADDMED(XMODE) ; if XMODE creates XSTR, if not add med to TARGET
N DATA,FIRST,XSUM,XCOUNT,TOPLINE,WSTATUS
S FIRST=1
I XMODE S (XSUM,XCOUNT)=0,XSTR=""
E D
.S TOPLINE=NEXTLINE+1,DATA="",WSTATUS=0
.D ADDP(2)
I TYPE="UD" D I 1 ; Unit Dose Meds
.I 'XMODE D
..I DETAILED D FLUSH S DATA="Give:"
..S DATA=DATA_" "
.I $$PL(6) D ADDP(6) I 1
.E I $$PL(7) D ADDP(7) I 1
.E D ADDM("SIG")
.D ADDM("MDR"),ADDM("SCH")
.I DETAILED D FLUSH
.D ADDM("SIO")
.;I 'XMODE,+CLINORD D FLUSH,ADD("Location: "_$$GET1^DIQ(100,+$P(NODE,U,8)_",",6)) ; ajb 290
E I TYPE="OP" D I 1 ; Outpatient Meds
.I 'XMODE,DETAILED D
..I $$PL(12) D
...S DATA=DATA_" Qty:"
...D ADDP(12)
..I $$PL(11) D
...S DATA=$$STRIP(DATA_" for")
...D ADDP(11)
...S DATA=$$STRIP(DATA_" days")
..D WRAP
.I $$ML("SIG") D I 1
..I 'XMODE,DETAILED S DATA=$$STRIP(DATA_" Sig:")
..D ADDM("SIG")
.E D ADDM("SIO"),ADDM("MDR"),ADDM("SCH")
E I TYPE="IV" D ; IV meds
.I DETAILED D FLUSH
.D ADDM("A")
.I $$ML("B") D
..I 'XMODE S DATA=$$STRIP(DATA_" in")
..D ADDM("B")
.D ADDP(3)
.I DETAILED D FLUSH
.;ELR/VMP patch 226 add route and schedule to IV's
.D ADDM("SIO"),ADDM("MDR"),ADDM("SCH")
.D FLUSH
.I 'XMODE D
..N I
..F I=TOPLINE:1:NEXTLINE S @TARGET@(I,0)=$TR(@TARGET@(I,0),U," ")
..;I +CLINORD D FLUSH,ADD("Location: "_$$GET1^DIQ(100,+$P(NODE,U,8)_",",6)) ; ajb 290
I XMODE D I 1
.I XSTR="" S XSTR="_"
.E I $L(XSTR)>80 S XSTR=$E(XCOUNT_"_"_XSUM_"_"_XSTR,1,80)
E D
.D FLUSH
.S WSTATUS=1
.D ADDP(9)
.S WSTATUS=0
.I DETAILED D
..D ADDDATE(TOPLINE,$S(MEDTYPE=OUTPTYPE:"Issu",1:"Strt"),15)
..I MEDTYPE=OUTPTYPE D I 1
...N I
...I TOPLINE=NEXTLINE S I=TOPLINE+1
...E I $L(@TARGET@(TOPLINE+1,0))<48 S I=TOPLINE+1
...E S I=TOPLINE+2
...F Q:(I'>NEXTLINE) D ADD(" ")
...S @TARGET@(I,0)=$E(@TARGET@(I,0)_SPACE60,1,47)_"Refills: "_+$P(NODE,U,5)
...D ADDDATE(TOPLINE+1,"Last",10)
...D ADDDATE(TOPLINE+2,"Expr",4)
..E D
...D ADDDATE(TOPLINE+1,"Stop",4)
Q
FDT(PNUM) ;Returns formatted date from piece number
N X,Y
S Y=$P(NODE,U,PNUM)
S X=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_$E($E(Y,1,3)+1700,3,4)
Q X
ADDDATE(LINENUM,TXT,PNUM) ;Add date to TARGET
I $$PL(PNUM) D
.F Q:(LINENUM'>NEXTLINE) D ADD(" ")
.S @TARGET@(LINENUM,0)=$E(@TARGET@(LINENUM,0)_SPACE60,1,60)_TXT_":"_$$FDT(PNUM)
Q
XSUMS(STR,NOADD) ; XSUMs a string
N IDX,LEN
S LEN=$L(STR) I LEN'>0 Q
I '$G(NOADD),$L(XSTR)<99 S XSTR=XSTR_STR
F IDX=1:1:LEN S XCOUNT=XCOUNT+1,XSUM=XSUM+($A(STR,IDX)*XCOUNT)
Q
WRAP ; Wraps DATA to the output
I XMODE Q
N IDX,LEN,MAX,DATA1,DONE
S DONE=0
F Q:DONE D
.I WSTATUS S MAX=13
.E D
..I FIRST S MAX=41
..E S MAX=39
..I 'HEADER S MAX=MAX+5
..I 'DETAILED S MAX=MAX+13
.S LEN=$L(DATA)
.I 'WSTATUS,LEN<MAX S DONE=1 Q
.I LEN<MAX S IDX=LEN
.E F IDX=MAX:-1:2 Q:$E(DATA,IDX)=" "
.I IDX<3 S IDX=MAX-1
.S DATA1=$$STRIP($E(DATA,1,IDX))
.I WSTATUS D I 1
..S @TARGET@(TOPLINE,0)=$E(@TARGET@(TOPLINE,0)_SPACE60,1,LLEN)_DATA1
.E D ADDL(DATA1)
.S DATA=$$STRIP($E(DATA,IDX+1,999))
.I WSTATUS D
..S DONE=1,WSTATUS=0
..I $L(DATA)>0 D
...I TOPLINE'<NEXTLINE D ADD(" ")
...S @TARGET@(TOPLINE+1,0)=$E(@TARGET@(TOPLINE+1,0)_SPACE60,1,LLEN)_DATA
...S DATA=""
Q
STRIP(X) ; Removes Leading and Trialing Spaces
F Q:$E(X)'=" " S X=$E(X,2,999)
F Q:$E(X,$L(X))'=" " S X=$E(X,1,$L(X)-1)
Q X
ADDP(PNUM) ; Adds or XSUMs a piece of NODE
I XMODE D I 1
.D XSUMS(PNUM,1)
.D XSUMS($P(NODE,U,PNUM))
E D
.N VALUE
.S VALUE=$P(NODE,U,PNUM)
.I PNUM=9,VALUE="ACTIVE/SUSP" S VALUE="ACTIVE (S)"
.S DATA=$$STRIP(DATA_" "_VALUE)
.D WRAP
Q
ADDM(SUB,FORCE) ; Adds or XSUMs Multiple
N IDX
S IDX=0
I XMODE D I 1
.D XSUMS(SUB,1)
.F S IDX=$O(^TMP("PS",$J,INDEX,SUB,IDX)) Q:IDX="" D
..D XSUMS(^TMP("PS",$J,INDEX,SUB,IDX,0))
E D
.I $G(FORCE),DETAILED D FLUSH
.F S IDX=$O(^TMP("PS",$J,INDEX,SUB,IDX)) Q:IDX="" D
..S DATA=$$STRIP(DATA_" "_^TMP("PS",$J,INDEX,SUB,IDX,0))
..D WRAP
Q
FLUSH ; Flush the DATA buffer
I 'XMODE,DATA'="" D
.D WRAP
.I DATA'="" D ADDL(DATA) S DATA=""
Q
PL(PNUM) ;Retuns length of peice
Q $L($P(NODE,U,PNUM))
ML(SUB) ;Returns true if multiple exists and contains data
N IDX,ML
S (IDX,ML)=0
F S IDX=$O(^TMP("PS",$J,INDEX,SUB,IDX)) Q:(IDX="")!ML D
.I $L(^TMP("PS",$J,INDEX,SUB,IDX,0)) S ML=1
Q ML
ADDTITLE ;Adds a title line indicating which meds are in the list
; ALLMEDS 0 - Specifies Inpatient Meds if patient is an
; Inpatient, or Outpatient Meds if patient
; is an Outpatient
; 1 - Specifies both Inpatient, Outpatient, & Clinic
; 2 or "I" - Specifies Inpatient only
; 3 or "O" - Specifies Outpatient only
; 4 or "C" - Specifies Clinic only
N MSG,ALL,SUP,SUPFX
I ACTVONLY<2 S MSG="Active"
E S MSG=""
I '+ACTVONLY S MSG=MSG_" and "
I ACTVONLY'=1 S MSG=MSG_"Recently Expired"
S ALL=ALLMEDS
I ALL=0 D
.I ISINP S ALL=2
.E S ALL=3
S MSG=MSG_" "
; ajb 290 add clinic order meds to title and allows for clinic only
I ALL=1 S MSG=MSG_"Inpatient, Outpatient and Clinic"
I ALL=2 S MSG=MSG_"Inpatient"
I ALL=3 S MSG=MSG_"Outpatient"
I ALL=4 S MSG=MSG_"Clinic"
I ALL=5 S MSG=MSG_"Inpatient and Clinic"
I ALL=6 S MSG=MSG_"Outpatient and Clinic"
;I ALL'=3 S MSG=MSG_"Clinic"
;I ALL=2 S MSG=MSG_" and Inpatient"
;I ALL=1 S MSG=MSG_", Inpatient and "
;I ALL'=2,ALL'=4 S MSG=MSG_"Outpatient"
S MSG=MSG_" Medications" ;I ALL=4 S MSG=MSG_" and Infusions"
I SUPPLIES S SUPFX="in"
E S SUPFX="ex"
S SUPFX="("_SUPFX_"cluding Supplies):"
I $L(MSG)>51 D I 1
.D ADD(MSG)
.D ADD(SUPFX)
E D
.S MSG=MSG_" "_SUPFX
.D ADD(MSG)
D ADD(" ")
Q
WARNING ;Inserts warning about CLASSORT if needed
I CLASSORT D
.N MSG
.D ADD("* * WARNING * * Sorting by drug class may not be accurate!")
.D ADD("Medications belonging to multiple drug classes will only be listed")
.S MSG="under a single drug class."
.I UNKNOWNS S MSG=MSG_" In addition, the system is not able to"
.D ADD(MSG)
.I UNKNOWNS D ADD("determine the drug class of some medications.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIULMED1 6827 printed Apr 09, 2024@21:47:58 Page 2
TIULMED1 ; SLC/JM - Active/Recent Med Objects Routine ;03/23/17 10:53
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**38,73,92,94,202,226,290**;Jun 20, 1997;Build 548
+2 ;
+3 ; All routines here are part of the LIST entry point of TIULMED
+4 ;
ADD(TXT) ; Saves TXT in TARGET
+1 SET NEXTLINE=NEXTLINE+1
+2 IF TAB
SET TXT=" "_TXT
+3 IF TAB
IF HEADER
SET TXT=" "_TXT
+4 SET @TARGET@(NEXTLINE,0)=TXT
+5 QUIT
ADDLNUM(TXT) ; Add text with Line Number added to front of string
+1 SET TAB=0
+2 IF HEADER
DO ADD($EXTRACT(COUNT_") ",1,5)_TXT)
IF 1
+3 IF '$TEST
DO ADD(TXT)
+4 SET TAB=1
+5 QUIT
ADDL(TXT) ; Add with ADDLNUM on FIRST
+1 IF FIRST
Begin DoDot:1
+2 DO ADDLNUM(TXT)
+3 SET FIRST=0
End DoDot:1
IF 1
+4 IF '$TEST
DO ADD(TXT)
+5 QUIT
ADDMED(XMODE) ; if XMODE creates XSTR, if not add med to TARGET
+1 NEW DATA,FIRST,XSUM,XCOUNT,TOPLINE,WSTATUS
+2 SET FIRST=1
+3 IF XMODE
SET (XSUM,XCOUNT)=0
SET XSTR=""
+4 IF '$TEST
Begin DoDot:1
+5 SET TOPLINE=NEXTLINE+1
SET DATA=""
SET WSTATUS=0
+6 DO ADDP(2)
End DoDot:1
+7 ; Unit Dose Meds
IF TYPE="UD"
Begin DoDot:1
+8 IF 'XMODE
Begin DoDot:2
+9 IF DETAILED
DO FLUSH
SET DATA="Give:"
+10 SET DATA=DATA_" "
End DoDot:2
+11 IF $$PL(6)
DO ADDP(6)
IF 1
+12 IF '$TEST
IF $$PL(7)
DO ADDP(7)
IF 1
+13 IF '$TEST
DO ADDM("SIG")
+14 DO ADDM("MDR")
DO ADDM("SCH")
+15 IF DETAILED
DO FLUSH
+16 DO ADDM("SIO")
+17 ;I 'XMODE,+CLINORD D FLUSH,ADD("Location: "_$$GET1^DIQ(100,+$P(NODE,U,8)_",",6)) ; ajb 290
End DoDot:1
IF 1
+18 ; Outpatient Meds
IF '$TEST
IF TYPE="OP"
Begin DoDot:1
+19 IF 'XMODE
IF DETAILED
Begin DoDot:2
+20 IF $$PL(12)
Begin DoDot:3
+21 SET DATA=DATA_" Qty:"
+22 DO ADDP(12)
End DoDot:3
+23 IF $$PL(11)
Begin DoDot:3
+24 SET DATA=$$STRIP(DATA_" for")
+25 DO ADDP(11)
+26 SET DATA=$$STRIP(DATA_" days")
End DoDot:3
+27 DO WRAP
End DoDot:2
+28 IF $$ML("SIG")
Begin DoDot:2
+29 IF 'XMODE
IF DETAILED
SET DATA=$$STRIP(DATA_" Sig:")
+30 DO ADDM("SIG")
End DoDot:2
IF 1
+31 IF '$TEST
DO ADDM("SIO")
DO ADDM("MDR")
DO ADDM("SCH")
End DoDot:1
IF 1
+32 ; IV meds
IF '$TEST
IF TYPE="IV"
Begin DoDot:1
+33 IF DETAILED
DO FLUSH
+34 DO ADDM("A")
+35 IF $$ML("B")
Begin DoDot:2
+36 IF 'XMODE
SET DATA=$$STRIP(DATA_" in")
+37 DO ADDM("B")
End DoDot:2
+38 DO ADDP(3)
+39 IF DETAILED
DO FLUSH
+40 ;ELR/VMP patch 226 add route and schedule to IV's
+41 DO ADDM("SIO")
DO ADDM("MDR")
DO ADDM("SCH")
+42 DO FLUSH
+43 IF 'XMODE
Begin DoDot:2
+44 NEW I
+45 FOR I=TOPLINE:1:NEXTLINE
SET @TARGET@(I,0)=$TRANSLATE(@TARGET@(I,0),U," ")
+46 ;I +CLINORD D FLUSH,ADD("Location: "_$$GET1^DIQ(100,+$P(NODE,U,8)_",",6)) ; ajb 290
End DoDot:2
End DoDot:1
+47 IF XMODE
Begin DoDot:1
+48 IF XSTR=""
SET XSTR="_"
+49 IF '$TEST
IF $LENGTH(XSTR)>80
SET XSTR=$EXTRACT(XCOUNT_"_"_XSUM_"_"_XSTR,1,80)
End DoDot:1
IF 1
+50 IF '$TEST
Begin DoDot:1
+51 DO FLUSH
+52 SET WSTATUS=1
+53 DO ADDP(9)
+54 SET WSTATUS=0
+55 IF DETAILED
Begin DoDot:2
+56 DO ADDDATE(TOPLINE,$SELECT(MEDTYPE=OUTPTYPE:"Issu",1:"Strt"),15)
+57 IF MEDTYPE=OUTPTYPE
Begin DoDot:3
+58 NEW I
+59 IF TOPLINE=NEXTLINE
SET I=TOPLINE+1
+60 IF '$TEST
IF $LENGTH(@TARGET@(TOPLINE+1,0))<48
SET I=TOPLINE+1
+61 IF '$TEST
SET I=TOPLINE+2
+62 FOR
if (I'>NEXTLINE)
QUIT
DO ADD(" ")
+63 SET @TARGET@(I,0)=$EXTRACT(@TARGET@(I,0)_SPACE60,1,47)_"Refills: "_+$PIECE(NODE,U,5)
+64 DO ADDDATE(TOPLINE+1,"Last",10)
+65 DO ADDDATE(TOPLINE+2,"Expr",4)
End DoDot:3
IF 1
+66 IF '$TEST
Begin DoDot:3
+67 DO ADDDATE(TOPLINE+1,"Stop",4)
End DoDot:3
End DoDot:2
End DoDot:1
+68 QUIT
FDT(PNUM) ;Returns formatted date from piece number
+1 NEW X,Y
+2 SET Y=$PIECE(NODE,U,PNUM)
+3 SET X=$EXTRACT(Y,4,5)_"-"_$EXTRACT(Y,6,7)_"-"_$EXTRACT($EXTRACT(Y,1,3)+1700,3,4)
+4 QUIT X
ADDDATE(LINENUM,TXT,PNUM) ;Add date to TARGET
+1 IF $$PL(PNUM)
Begin DoDot:1
+2 FOR
if (LINENUM'>NEXTLINE)
QUIT
DO ADD(" ")
+3 SET @TARGET@(LINENUM,0)=$EXTRACT(@TARGET@(LINENUM,0)_SPACE60,1,60)_TXT_":"_$$FDT(PNUM)
End DoDot:1
+4 QUIT
XSUMS(STR,NOADD) ; XSUMs a string
+1 NEW IDX,LEN
+2 SET LEN=$LENGTH(STR)
IF LEN'>0
QUIT
+3 IF '$GET(NOADD)
IF $LENGTH(XSTR)<99
SET XSTR=XSTR_STR
+4 FOR IDX=1:1:LEN
SET XCOUNT=XCOUNT+1
SET XSUM=XSUM+($ASCII(STR,IDX)*XCOUNT)
+5 QUIT
WRAP ; Wraps DATA to the output
+1 IF XMODE
QUIT
+2 NEW IDX,LEN,MAX,DATA1,DONE
+3 SET DONE=0
+4 FOR
if DONE
QUIT
Begin DoDot:1
+5 IF WSTATUS
SET MAX=13
+6 IF '$TEST
Begin DoDot:2
+7 IF FIRST
SET MAX=41
+8 IF '$TEST
SET MAX=39
+9 IF 'HEADER
SET MAX=MAX+5
+10 IF 'DETAILED
SET MAX=MAX+13
End DoDot:2
+11 SET LEN=$LENGTH(DATA)
+12 IF 'WSTATUS
IF LEN<MAX
SET DONE=1
QUIT
+13 IF LEN<MAX
SET IDX=LEN
+14 IF '$TEST
FOR IDX=MAX:-1:2
if $EXTRACT(DATA,IDX)=" "
QUIT
+15 IF IDX<3
SET IDX=MAX-1
+16 SET DATA1=$$STRIP($EXTRACT(DATA,1,IDX))
+17 IF WSTATUS
Begin DoDot:2
+18 SET @TARGET@(TOPLINE,0)=$EXTRACT(@TARGET@(TOPLINE,0)_SPACE60,1,LLEN)_DATA1
End DoDot:2
IF 1
+19 IF '$TEST
DO ADDL(DATA1)
+20 SET DATA=$$STRIP($EXTRACT(DATA,IDX+1,999))
+21 IF WSTATUS
Begin DoDot:2
+22 SET DONE=1
SET WSTATUS=0
+23 IF $LENGTH(DATA)>0
Begin DoDot:3
+24 IF TOPLINE'<NEXTLINE
DO ADD(" ")
+25 SET @TARGET@(TOPLINE+1,0)=$EXTRACT(@TARGET@(TOPLINE+1,0)_SPACE60,1,LLEN)_DATA
+26 SET DATA=""
End DoDot:3
End DoDot:2
End DoDot:1
+27 QUIT
STRIP(X) ; Removes Leading and Trialing Spaces
+1 FOR
if $EXTRACT(X)'=" "
QUIT
SET X=$EXTRACT(X,2,999)
+2 FOR
if $EXTRACT(X,$LENGTH(X))'=" "
QUIT
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+3 QUIT X
ADDP(PNUM) ; Adds or XSUMs a piece of NODE
+1 IF XMODE
Begin DoDot:1
+2 DO XSUMS(PNUM,1)
+3 DO XSUMS($PIECE(NODE,U,PNUM))
End DoDot:1
IF 1
+4 IF '$TEST
Begin DoDot:1
+5 NEW VALUE
+6 SET VALUE=$PIECE(NODE,U,PNUM)
+7 IF PNUM=9
IF VALUE="ACTIVE/SUSP"
SET VALUE="ACTIVE (S)"
+8 SET DATA=$$STRIP(DATA_" "_VALUE)
+9 DO WRAP
End DoDot:1
+10 QUIT
ADDM(SUB,FORCE) ; Adds or XSUMs Multiple
+1 NEW IDX
+2 SET IDX=0
+3 IF XMODE
Begin DoDot:1
+4 DO XSUMS(SUB,1)
+5 FOR
SET IDX=$ORDER(^TMP("PS",$JOB,INDEX,SUB,IDX))
if IDX=""
QUIT
Begin DoDot:2
+6 DO XSUMS(^TMP("PS",$JOB,INDEX,SUB,IDX,0))
End DoDot:2
End DoDot:1
IF 1
+7 IF '$TEST
Begin DoDot:1
+8 IF $GET(FORCE)
IF DETAILED
DO FLUSH
+9 FOR
SET IDX=$ORDER(^TMP("PS",$JOB,INDEX,SUB,IDX))
if IDX=""
QUIT
Begin DoDot:2
+10 SET DATA=$$STRIP(DATA_" "_^TMP("PS",$JOB,INDEX,SUB,IDX,0))
+11 DO WRAP
End DoDot:2
End DoDot:1
+12 QUIT
FLUSH ; Flush the DATA buffer
+1 IF 'XMODE
IF DATA'=""
Begin DoDot:1
+2 DO WRAP
+3 IF DATA'=""
DO ADDL(DATA)
SET DATA=""
End DoDot:1
+4 QUIT
PL(PNUM) ;Retuns length of peice
+1 QUIT $LENGTH($PIECE(NODE,U,PNUM))
ML(SUB) ;Returns true if multiple exists and contains data
+1 NEW IDX,ML
+2 SET (IDX,ML)=0
+3 FOR
SET IDX=$ORDER(^TMP("PS",$JOB,INDEX,SUB,IDX))
if (IDX="")!ML
QUIT
Begin DoDot:1
+4 IF $LENGTH(^TMP("PS",$JOB,INDEX,SUB,IDX,0))
SET ML=1
End DoDot:1
+5 QUIT ML
ADDTITLE ;Adds a title line indicating which meds are in the list
+1 ; ALLMEDS 0 - Specifies Inpatient Meds if patient is an
+2 ; Inpatient, or Outpatient Meds if patient
+3 ; is an Outpatient
+4 ; 1 - Specifies both Inpatient, Outpatient, & Clinic
+5 ; 2 or "I" - Specifies Inpatient only
+6 ; 3 or "O" - Specifies Outpatient only
+7 ; 4 or "C" - Specifies Clinic only
+8 NEW MSG,ALL,SUP,SUPFX
+9 IF ACTVONLY<2
SET MSG="Active"
+10 IF '$TEST
SET MSG=""
+11 IF '+ACTVONLY
SET MSG=MSG_" and "
+12 IF ACTVONLY'=1
SET MSG=MSG_"Recently Expired"
+13 SET ALL=ALLMEDS
+14 IF ALL=0
Begin DoDot:1
+15 IF ISINP
SET ALL=2
+16 IF '$TEST
SET ALL=3
End DoDot:1
+17 SET MSG=MSG_" "
+18 ; ajb 290 add clinic order meds to title and allows for clinic only
+19 IF ALL=1
SET MSG=MSG_"Inpatient, Outpatient and Clinic"
+20 IF ALL=2
SET MSG=MSG_"Inpatient"
+21 IF ALL=3
SET MSG=MSG_"Outpatient"
+22 IF ALL=4
SET MSG=MSG_"Clinic"
+23 IF ALL=5
SET MSG=MSG_"Inpatient and Clinic"
+24 IF ALL=6
SET MSG=MSG_"Outpatient and Clinic"
+25 ;I ALL'=3 S MSG=MSG_"Clinic"
+26 ;I ALL=2 S MSG=MSG_" and Inpatient"
+27 ;I ALL=1 S MSG=MSG_", Inpatient and "
+28 ;I ALL'=2,ALL'=4 S MSG=MSG_"Outpatient"
+29 ;I ALL=4 S MSG=MSG_" and Infusions"
SET MSG=MSG_" Medications"
+30 IF SUPPLIES
SET SUPFX="in"
+31 IF '$TEST
SET SUPFX="ex"
+32 SET SUPFX="("_SUPFX_"cluding Supplies):"
+33 IF $LENGTH(MSG)>51
Begin DoDot:1
+34 DO ADD(MSG)
+35 DO ADD(SUPFX)
End DoDot:1
IF 1
+36 IF '$TEST
Begin DoDot:1
+37 SET MSG=MSG_" "_SUPFX
+38 DO ADD(MSG)
End DoDot:1
+39 DO ADD(" ")
+40 QUIT
WARNING ;Inserts warning about CLASSORT if needed
+1 IF CLASSORT
Begin DoDot:1
+2 NEW MSG
+3 DO ADD("* * WARNING * * Sorting by drug class may not be accurate!")
+4 DO ADD("Medications belonging to multiple drug classes will only be listed")
+5 SET MSG="under a single drug class."
+6 IF UNKNOWNS
SET MSG=MSG_" In addition, the system is not able to"
+7 DO ADD(MSG)
+8 IF UNKNOWNS
DO ADD("determine the drug class of some medications.")
End DoDot:1
+9 QUIT
