Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIULMED1

TIULMED1.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; All routines here are part of the LIST entry point of TIULMED
  1.  ;
  1. ADD(TXT) ; Saves TXT in TARGET
  1.  S NEXTLINE=NEXTLINE+1
  1.  I TAB S TXT="  "_TXT
  1.  I TAB,HEADER S TXT="     "_TXT
  1.  S @TARGET@(NEXTLINE,0)=TXT
  1.  Q
  1. ADDLNUM(TXT) ; Add text with Line Number added to front of string
  1.  S TAB=0
  1.  I HEADER D ADD($E(COUNT_")     ",1,5)_TXT) I 1
  1.  E  D ADD(TXT)
  1.  S TAB=1
  1.  Q
  1. ADDL(TXT) ; Add with ADDLNUM on FIRST
  1.  I FIRST D  I 1
  1.  .D ADDLNUM(TXT)
  1.  .S FIRST=0
  1.  E  D ADD(TXT)
  1.  Q
  1. ADDMED(XMODE) ; if XMODE creates XSTR, if not add med to TARGET
  1.  N DATA,FIRST,XSUM,XCOUNT,TOPLINE,WSTATUS
  1.  S FIRST=1
  1.  I XMODE S (XSUM,XCOUNT)=0,XSTR=""
  1.  E  D
  1.  .S TOPLINE=NEXTLINE+1,DATA="",WSTATUS=0
  1.  .D ADDP(2)
  1.  I TYPE="UD" D  I 1 ; Unit Dose Meds
  1.  .I 'XMODE D
  1.  ..I DETAILED D FLUSH S DATA="Give:"
  1.  ..S DATA=DATA_" "
  1.  .I $$PL(6) D ADDP(6) I 1
  1.  .E  I $$PL(7) D ADDP(7) I 1
  1.  .E  D ADDM("SIG")
  1.  .D ADDM("MDR"),ADDM("SCH")
  1.  .I DETAILED D FLUSH
  1.  .D ADDM("SIO")
  1.  .;I 'XMODE,+CLINORD D FLUSH,ADD("Location: "_$$GET1^DIQ(100,+$P(NODE,U,8)_",",6)) ; ajb 290
  1.  E  I TYPE="OP" D  I 1 ; Outpatient Meds
  1.  .I 'XMODE,DETAILED D
  1.  ..I $$PL(12) D
  1.  ...S DATA=DATA_"  Qty:"
  1.  ...D ADDP(12)
  1.  ..I $$PL(11) D
  1.  ...S DATA=$$STRIP(DATA_" for")
  1.  ...D ADDP(11)
  1.  ...S DATA=$$STRIP(DATA_" days")
  1.  ..D WRAP
  1.  .I $$ML("SIG") D  I 1
  1.  ..I 'XMODE,DETAILED S DATA=$$STRIP(DATA_"  Sig:")
  1.  ..D ADDM("SIG")
  1.  .E  D ADDM("SIO"),ADDM("MDR"),ADDM("SCH")
  1.  E  I TYPE="IV" D  ; IV meds
  1.  .I DETAILED D FLUSH
  1.  .D ADDM("A")
  1.  .I $$ML("B") D
  1.  ..I 'XMODE S DATA=$$STRIP(DATA_" in")
  1.  ..D ADDM("B")
  1.  .D ADDP(3)
  1.  .I DETAILED D FLUSH
  1.  .;ELR/VMP patch 226 add route and schedule to IV's
  1.  .D ADDM("SIO"),ADDM("MDR"),ADDM("SCH")
  1.  .D FLUSH
  1.  .I 'XMODE D
  1.  ..N I
  1.  ..F I=TOPLINE:1:NEXTLINE S @TARGET@(I,0)=$TR(@TARGET@(I,0),U," ")
  1.  ..;I +CLINORD D FLUSH,ADD("Location: "_$$GET1^DIQ(100,+$P(NODE,U,8)_",",6)) ; ajb 290
  1.  I XMODE D  I 1
  1.  .I XSTR="" S XSTR="_"
  1.  .E  I $L(XSTR)>80 S XSTR=$E(XCOUNT_"_"_XSUM_"_"_XSTR,1,80)
  1.  E  D
  1.  .D FLUSH
  1.  .S WSTATUS=1
  1.  .D ADDP(9)
  1.  .S WSTATUS=0
  1.  .I DETAILED D
  1.  ..D ADDDATE(TOPLINE,$S(MEDTYPE=OUTPTYPE:"Issu",1:"Strt"),15)
  1.  ..I MEDTYPE=OUTPTYPE D  I 1
  1.  ...N I
  1.  ...I TOPLINE=NEXTLINE S I=TOPLINE+1
  1.  ...E  I $L(@TARGET@(TOPLINE+1,0))<48 S I=TOPLINE+1
  1.  ...E  S I=TOPLINE+2
  1.  ...F  Q:(I'>NEXTLINE)  D ADD(" ")
  1.  ...S @TARGET@(I,0)=$E(@TARGET@(I,0)_SPACE60,1,47)_"Refills: "_+$P(NODE,U,5)
  1.  ...D ADDDATE(TOPLINE+1,"Last",10)
  1.  ...D ADDDATE(TOPLINE+2,"Expr",4)
  1.  ..E  D
  1.  ...D ADDDATE(TOPLINE+1,"Stop",4)
  1.  Q
  1. FDT(PNUM) ;Returns formatted date from piece number
  1.  N X,Y
  1.  S Y=$P(NODE,U,PNUM)
  1.  S X=$E(Y,4,5)_"-"_$E(Y,6,7)_"-"_$E($E(Y,1,3)+1700,3,4)
  1.  Q X
  1. ADDDATE(LINENUM,TXT,PNUM) ;Add date to TARGET
  1.  I $$PL(PNUM) D
  1.  .F  Q:(LINENUM'>NEXTLINE)  D ADD(" ")
  1.  .S @TARGET@(LINENUM,0)=$E(@TARGET@(LINENUM,0)_SPACE60,1,60)_TXT_":"_$$FDT(PNUM)
  1.  Q
  1. XSUMS(STR,NOADD) ; XSUMs a string
  1.  N IDX,LEN
  1.  S LEN=$L(STR) I LEN'>0 Q
  1.  I '$G(NOADD),$L(XSTR)<99 S XSTR=XSTR_STR
  1.  F IDX=1:1:LEN S XCOUNT=XCOUNT+1,XSUM=XSUM+($A(STR,IDX)*XCOUNT)
  1.  Q
  1. WRAP ; Wraps DATA to the output
  1.  I XMODE Q
  1.  N IDX,LEN,MAX,DATA1,DONE
  1.  S DONE=0
  1.  F  Q:DONE  D
  1.  .I WSTATUS S MAX=13
  1.  .E  D
  1.  ..I FIRST S MAX=41
  1.  ..E  S MAX=39
  1.  ..I 'HEADER S MAX=MAX+5
  1.  ..I 'DETAILED S MAX=MAX+13
  1.  .S LEN=$L(DATA)
  1.  .I 'WSTATUS,LEN<MAX S DONE=1 Q
  1.  .I LEN<MAX S IDX=LEN
  1.  .E  F IDX=MAX:-1:2 Q:$E(DATA,IDX)=" "
  1.  .I IDX<3 S IDX=MAX-1
  1.  .S DATA1=$$STRIP($E(DATA,1,IDX))
  1.  .I WSTATUS D  I 1
  1.  ..S @TARGET@(TOPLINE,0)=$E(@TARGET@(TOPLINE,0)_SPACE60,1,LLEN)_DATA1
  1.  .E  D ADDL(DATA1)
  1.  .S DATA=$$STRIP($E(DATA,IDX+1,999))
  1.  .I WSTATUS D
  1.  ..S DONE=1,WSTATUS=0
  1.  ..I $L(DATA)>0 D
  1.  ...I TOPLINE'<NEXTLINE D ADD(" ")
  1.  ...S @TARGET@(TOPLINE+1,0)=$E(@TARGET@(TOPLINE+1,0)_SPACE60,1,LLEN)_DATA
  1.  ...S DATA=""
  1.  Q
  1. STRIP(X) ; Removes Leading and Trialing Spaces
  1.  F  Q:$E(X)'=" "  S X=$E(X,2,999)
  1.  F  Q:$E(X,$L(X))'=" "  S X=$E(X,1,$L(X)-1)
  1.  Q X
  1. ADDP(PNUM) ; Adds or XSUMs a piece of NODE
  1.  I XMODE D  I 1
  1.  .D XSUMS(PNUM,1)
  1.  .D XSUMS($P(NODE,U,PNUM))
  1.  E  D
  1.  .N VALUE
  1.  .S VALUE=$P(NODE,U,PNUM)
  1.  .I PNUM=9,VALUE="ACTIVE/SUSP" S VALUE="ACTIVE (S)"
  1.  .S DATA=$$STRIP(DATA_" "_VALUE)
  1.  .D WRAP
  1.  Q
  1. ADDM(SUB,FORCE) ; Adds or XSUMs Multiple
  1.  N IDX
  1.  S IDX=0
  1.  I XMODE D  I 1
  1.  .D XSUMS(SUB,1)
  1.  .F  S IDX=$O(^TMP("PS",$J,INDEX,SUB,IDX)) Q:IDX=""  D
  1.  ..D XSUMS(^TMP("PS",$J,INDEX,SUB,IDX,0))
  1.  E  D
  1.  .I $G(FORCE),DETAILED  D FLUSH
  1.  .F  S IDX=$O(^TMP("PS",$J,INDEX,SUB,IDX)) Q:IDX=""  D
  1.  ..S DATA=$$STRIP(DATA_" "_^TMP("PS",$J,INDEX,SUB,IDX,0))
  1.  ..D WRAP
  1.  Q
  1. FLUSH ; Flush the DATA buffer
  1.  I 'XMODE,DATA'="" D
  1.  .D WRAP
  1.  .I DATA'="" D ADDL(DATA) S DATA=""
  1.  Q
  1. PL(PNUM) ;Retuns length of peice
  1.  Q $L($P(NODE,U,PNUM))
  1. ML(SUB) ;Returns true if multiple exists and contains data
  1.  N IDX,ML
  1.  S (IDX,ML)=0
  1.  F  S IDX=$O(^TMP("PS",$J,INDEX,SUB,IDX)) Q:(IDX="")!ML  D
  1.  .I $L(^TMP("PS",$J,INDEX,SUB,IDX,0)) S ML=1
  1.  Q ML
  1. ADDTITLE ;Adds a title line indicating which meds are in the list
  1.  ;  ALLMEDS   0 - Specifies Inpatient Meds if patient is an
  1.  ;                Inpatient, or Outpatient Meds if patient
  1.  ;                is an Outpatient
  1.  ;            1 - Specifies both Inpatient, Outpatient, & Clinic
  1.  ;            2 or "I" - Specifies Inpatient only
  1.  ;            3 or "O" - Specifies Outpatient only
  1.  ;            4 or "C" - Specifies Clinic only
  1.  N MSG,ALL,SUP,SUPFX
  1.  I ACTVONLY<2 S MSG="Active"
  1.  E  S MSG=""
  1.  I '+ACTVONLY S MSG=MSG_" and "
  1.  I ACTVONLY'=1 S MSG=MSG_"Recently Expired"
  1.  S ALL=ALLMEDS
  1.  I ALL=0 D
  1.  .I ISINP S ALL=2
  1.  .E  S ALL=3
  1.  S MSG=MSG_" "
  1.  ; ajb 290 add clinic order meds to title and allows for clinic only
  1.  I ALL=1 S MSG=MSG_"Inpatient, Outpatient and Clinic"
  1.  I ALL=2 S MSG=MSG_"Inpatient"
  1.  I ALL=3 S MSG=MSG_"Outpatient"
  1.  I ALL=4 S MSG=MSG_"Clinic"
  1.  I ALL=5 S MSG=MSG_"Inpatient and Clinic"
  1.  I ALL=6 S MSG=MSG_"Outpatient and Clinic"
  1.  ;I ALL'=3 S MSG=MSG_"Clinic"
  1.  ;I ALL=2 S MSG=MSG_" and Inpatient"
  1.  ;I ALL=1 S MSG=MSG_", Inpatient and "
  1.  ;I ALL'=2,ALL'=4 S MSG=MSG_"Outpatient"
  1.  S MSG=MSG_" Medications" ;I ALL=4 S MSG=MSG_" and Infusions"
  1.  I SUPPLIES S SUPFX="in"
  1.  E  S SUPFX="ex"
  1.  S SUPFX="("_SUPFX_"cluding Supplies):"
  1.  I $L(MSG)>51 D  I 1
  1.  .D ADD(MSG)
  1.  .D ADD(SUPFX)
  1.  E  D
  1.  .S MSG=MSG_" "_SUPFX
  1.  .D ADD(MSG)
  1.  D ADD(" ")
  1.  Q
  1. WARNING ;Inserts warning about CLASSORT if needed
  1.  I CLASSORT D
  1.  .N MSG
  1.  .D ADD("* *  WARNING  * * Sorting by drug class may not be accurate!")
  1.  .D ADD("Medications belonging to multiple drug classes will only be listed")
  1.  .S MSG="under a single drug class."
  1.  .I UNKNOWNS S MSG=MSG_"  In addition, the system is not able to"
  1.  .D ADD(MSG)
  1.  .I UNKNOWNS D ADD("determine the drug class of some medications.")
  1.  Q