TIULMED3 ; SLC/MAM - Cont. of Active/Recent Med Objects Routine ;05-Nov-2013 12:26;DU
;;1.0;TEXT INTEGRATION UTILITIES;**198,213,1013**;Jun 20, 1997;Build 33
GETCLASS ; Get Drug Class, filter out supplies BP/ELR
I +DRUGIDX D
.N TEMPNODE
.S DRUGCLAS=$$DRGCLASS^TIULMED2(DRUGIDX)
.S TEMPNODE=U_DRUGCLAS_U_$$DEA^TIULMED2(DRUGIDX)
.I 'SUPPLIES,($E(DRUGCLAS,1,2)="XA") D
..S KEEPMED='($P(TEMPNODE,U,3)["S")
Q
;
PATCHSOK() ; Function Checks for Pharmacy Package and required patches
;Returns 1 if ok, 0 if not
N CHECKOK S CHECKOK=1
I '$L($T(OCL^PSOORRL)) D S CHECKOK=0 G CKX
. D ADD^TIULMED1("Outpatient Pharmacy 7.0 Required for this Object.")
. D ADD^TIULMED1(" ")
I '$$PATCH^XPDUTL("PSO*7.0*20") D S CHECKOK=0 G CKX
. D ADD^TIULMED1("Outpatient Pharmacy Patch PSO*7.0*20 is required for this Object.")
. D ADD^TIULMED1(" ")
I '$$PATCH^XPDUTL("PSJ*5.0*22") D S CHECKOK=0 G CKX
. D ADD^TIULMED1("Inpatient Pharmacy Patch PSJ*5.0*22 is required for this Object.")
. D ADD^TIULMED1(" ")
CKX Q CHECKOK
;
SORTSAVE ;Sort & save Meds Data in TARGET
; *** Check for empty condition ***
;
I EMPTY D G SORTX
.D ADD^TIULMED1("No Medications Found")
.D ADD^TIULMED1(" ")
;
; *** Sort Meds in "C" temp xref - sort by Med Type, Status
; Med Name, and reverse issue date, followed by a counter
; to avoid erasing meds issued on the same day
;
N MED,CNT,XSTR,TIUXSTAT
N DATA,NODE
S MED="",CNT=1000000
F S MED=$O(@TARGET@("B",MED)) Q:MED="" D
.S (XSTR,TIUXSTAT)=""
.F S XSTR=$O(@TARGET@("B",MED,XSTR)) Q:XSTR="" D
.. F S TIUXSTAT=$O(@TARGET@("B",MED,XSTR,TIUXSTAT)) Q:TIUXSTAT="" D
...S NODE=@TARGET@("B",MED,XSTR,TIUXSTAT)
...S DATA=$P(NODE,U,3)_U_$P(NODE,U,5)_U_MED,CNT=CNT+1
...S @TARGET@("C",DATA,(9999999-$P(NODE,U))_CNT)=$P(NODE,U,2)_U_$P(NODE,U,4)
;
; Read sorted data and save final version to TARGET
;
N LASTCLAS,LASTMEDT,LASTSTS,COUNT,TOTAL
N INDEX,MEDTYPE,STATIDX,DRUGCLAS,TYPE,TITLE
N NODE,LASTMEDT,LASTSTS,TEMP,OLDTAB,OLDHEADR
S TITLE=$$GET^XPAR("ALL","BEHORX NONVA LABEL")
S (DATA,LASTCLAS)="",(LASTMEDT,LASTSTS,COUNT,TOTAL)=0
D WARNING^TIULMED1
F S DATA=$O(@TARGET@("C",DATA)) Q:DATA="" D
.S MEDTYPE=$E(DATA),STATIDX=$E(DATA,2)
.S DRUGCLAS=$P(DATA,U,2),MED=$P(DATA,U,3),CNT=""
.F S CNT=$O(@TARGET@("C",DATA,CNT)) Q:CNT="" D
..S INDEX=@TARGET@("C",DATA,CNT)
..S TYPE=$P(INDEX,U,2),INDEX=+INDEX
..S NODE=^TMP("PS",$J,INDEX,0)
..I $P($P(NODE,U),";")["N" S $P(NODE,U,2)=TITLE_" "_$P(NODE,U,2)
..I (MEDTYPE'=LASTMEDT)!(STATIDX'=LASTSTS) D ; Create Header
...I CLASSORT'=2,DRUGCLAS'=" " S LASTCLAS=DRUGCLAS
...I 'HEADER Q
...S LASTMEDT=MEDTYPE,LASTSTS=STATIDX,TAB=0
...I COUNT>0 D ADD^TIULMED1(" ")
...I CLASSORT D ADD^TIULMED1(" ")
...S COUNT=0
...I DETAILED D
....I MEDTYPE=OUTPTYPE D I 1
.....D ADD^TIULMED1(SPACE60_"Issue Date")
.....D ADD^TIULMED1($E($E(SPACE60,1,47)_"Status"_SPACE60,1,60)_"Last Fill")
....E D ADD^TIULMED1(SPACE60_"Start Date")
...I 'ONELIST D
....S TEMP=$S(STATIDX=1:"Active",STATIDX=2:"Pending",1:"Inactive")_" "
...E S TEMP=""
...S TEMP=TEMP_$S(MEDTYPE=INPTYPE:"Inpatient",MEDTYPE=NVATYPE:TITLE,1:"Outpatient")
...S TEMP=" "_TEMP_" Medications"
...I CLASSORT D
....I DETAILED S TEMP=TEMP_" (By Class)"
....E S TEMP=TEMP_" (By Drug Class)"
...I DETAILED D I 1
....S TEMP=$E(TEMP_SPACE60,1,47)
....I MEDTYPE=INPTYPE S TEMP=TEMP_"Status"
....E S TEMP=TEMP_"Refills"
....S TEMP=$E(TEMP_SPACE60,1,60)
....I MEDTYPE=INPTYPE S TEMP=TEMP_"Stop Date"
....E S TEMP=TEMP_"Expiration"
...E D
....S TEMP=$E(TEMP_SPACE60,1,60)_"Status"
...D ADD^TIULMED1(TEMP),ADD^TIULMED1(DASH73)
..I CLASSORT,DRUGCLAS'="",DRUGCLAS'=LASTCLAS D
...S LASTCLAS=DRUGCLAS,OLDTAB=TAB,OLDHEADR=HEADER
...S (TAB,HEADER)=0
...I COUNT>0 D ADD^TIULMED1(" ")
...I (CLASSORT=2)!(DRUGCLAS=" ") D I 1
....I DRUGCLAS=" " S TEMP=" ====== Drug Class Unknown "
....E S TEMP=" ====== Drug Class: "_DRUGCLAS_" "
...E S TEMP=" "
...S TEMP=$E(TEMP_DASH73,1,LLEN-2)
...D ADD^TIULMED1(TEMP)
...S HEADER=OLDHEADR,TAB=OLDTAB
..S COUNT=COUNT+1,TOTAL=TOTAL+1
..D ADDMED^TIULMED1(0)
I COUNT'=TOTAL D
.S TAB=0
.D ADD^TIULMED1(" ")
.D ADD^TIULMED1(TOTAL_" Total Medications")
SORTX ;
Q
;
TIULMED3 ; SLC/MAM - Cont. of Active/Recent Med Objects Routine ;05-Nov-2013 12:26;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**198,213,1013**;Jun 20, 1997;Build 33
GETCLASS ; Get Drug Class, filter out supplies BP/ELR
+1 IF +DRUGIDX
Begin DoDot:1
+2 NEW TEMPNODE
+3 SET DRUGCLAS=$$DRGCLASS^TIULMED2(DRUGIDX)
+4 SET TEMPNODE=U_DRUGCLAS_U_$$DEA^TIULMED2(DRUGIDX)
+5 IF 'SUPPLIES
IF ($EXTRACT(DRUGCLAS,1,2)="XA")
Begin DoDot:2
+6 SET KEEPMED='($PIECE(TEMPNODE,U,3)["S")
End DoDot:2
End DoDot:1
+7 QUIT
+8 ;
PATCHSOK() ; Function Checks for Pharmacy Package and required patches
+1 ;Returns 1 if ok, 0 if not
+2 NEW CHECKOK
SET CHECKOK=1
+3 IF '$LENGTH($TEXT(OCL^PSOORRL))
Begin DoDot:1
+4 DO ADD^TIULMED1("Outpatient Pharmacy 7.0 Required for this Object.")
+5 DO ADD^TIULMED1(" ")
End DoDot:1
SET CHECKOK=0
GOTO CKX
+6 IF '$$PATCH^XPDUTL("PSO*7.0*20")
Begin DoDot:1
+7 DO ADD^TIULMED1("Outpatient Pharmacy Patch PSO*7.0*20 is required for this Object.")
+8 DO ADD^TIULMED1(" ")
End DoDot:1
SET CHECKOK=0
GOTO CKX
+9 IF '$$PATCH^XPDUTL("PSJ*5.0*22")
Begin DoDot:1
+10 DO ADD^TIULMED1("Inpatient Pharmacy Patch PSJ*5.0*22 is required for this Object.")
+11 DO ADD^TIULMED1(" ")
End DoDot:1
SET CHECKOK=0
GOTO CKX
CKX QUIT CHECKOK
+1 ;
SORTSAVE ;Sort & save Meds Data in TARGET
+1 ; *** Check for empty condition ***
+2 ;
+3 IF EMPTY
Begin DoDot:1
+4 DO ADD^TIULMED1("No Medications Found")
+5 DO ADD^TIULMED1(" ")
End DoDot:1
GOTO SORTX
+6 ;
+7 ; *** Sort Meds in "C" temp xref - sort by Med Type, Status
+8 ; Med Name, and reverse issue date, followed by a counter
+9 ; to avoid erasing meds issued on the same day
+10 ;
+11 NEW MED,CNT,XSTR,TIUXSTAT
+12 NEW DATA,NODE
+13 SET MED=""
SET CNT=1000000
+14 FOR
SET MED=$ORDER(@TARGET@("B",MED))
IF MED=""
QUIT
Begin DoDot:1
+15 SET (XSTR,TIUXSTAT)=""
+16 FOR
SET XSTR=$ORDER(@TARGET@("B",MED,XSTR))
IF XSTR=""
QUIT
Begin DoDot:2
+17 FOR
SET TIUXSTAT=$ORDER(@TARGET@("B",MED,XSTR,TIUXSTAT))
IF TIUXSTAT=""
QUIT
Begin DoDot:3
+18 SET NODE=@TARGET@("B",MED,XSTR,TIUXSTAT)
+19 SET DATA=$PIECE(NODE,U,3)_U_$PIECE(NODE,U,5)_U_MED
SET CNT=CNT+1
+20 SET @TARGET@("C",DATA,(9999999-$PIECE(NODE,U))_CNT)=$PIECE(NODE,U,2)_U_$PIECE(NODE,U,4)
End DoDot:3
End DoDot:2
End DoDot:1
+21 ;
+22 ; Read sorted data and save final version to TARGET
+23 ;
+24 NEW LASTCLAS,LASTMEDT,LASTSTS,COUNT,TOTAL
+25 NEW INDEX,MEDTYPE,STATIDX,DRUGCLAS,TYPE,TITLE
+26 NEW NODE,LASTMEDT,LASTSTS,TEMP,OLDTAB,OLDHEADR
+27 SET TITLE=$$GET^XPAR("ALL","BEHORX NONVA LABEL")
+28 SET (DATA,LASTCLAS)=""
SET (LASTMEDT,LASTSTS,COUNT,TOTAL)=0
+29 DO WARNING^TIULMED1
+30 FOR
SET DATA=$ORDER(@TARGET@("C",DATA))
IF DATA=""
QUIT
Begin DoDot:1
+31 SET MEDTYPE=$EXTRACT(DATA)
SET STATIDX=$EXTRACT(DATA,2)
+32 SET DRUGCLAS=$PIECE(DATA,U,2)
SET MED=$PIECE(DATA,U,3)
SET CNT=""
+33 FOR
SET CNT=$ORDER(@TARGET@("C",DATA,CNT))
IF CNT=""
QUIT
Begin DoDot:2
+34 SET INDEX=@TARGET@("C",DATA,CNT)
+35 SET TYPE=$PIECE(INDEX,U,2)
SET INDEX=+INDEX
+36 SET NODE=^TMP("PS",$JOB,INDEX,0)
+37 IF $PIECE($PIECE(NODE,U),";")["N"
SET $PIECE(NODE,U,2)=TITLE_" "_$PIECE(NODE,U,2)
+38 ; Create Header
IF (MEDTYPE'=LASTMEDT)!(STATIDX'=LASTSTS)
Begin DoDot:3
+39 IF CLASSORT'=2
IF DRUGCLAS'=" "
SET LASTCLAS=DRUGCLAS
+40 IF 'HEADER
QUIT
+41 SET LASTMEDT=MEDTYPE
SET LASTSTS=STATIDX
SET TAB=0
+42 IF COUNT>0
DO ADD^TIULMED1(" ")
+43 IF CLASSORT
DO ADD^TIULMED1(" ")
+44 SET COUNT=0
+45 IF DETAILED
Begin DoDot:4
+46 IF MEDTYPE=OUTPTYPE
Begin DoDot:5
+47 DO ADD^TIULMED1(SPACE60_"Issue Date")
+48 DO ADD^TIULMED1($EXTRACT($EXTRACT(SPACE60,1,47)_"Status"_SPACE60,1,60)_"Last Fill")
End DoDot:5
IF 1
+49 IF '$TEST
DO ADD^TIULMED1(SPACE60_"Start Date")
End DoDot:4
+50 IF 'ONELIST
Begin DoDot:4
+51 SET TEMP=$SELECT(STATIDX=1:"Active",STATIDX=2:"Pending",1:"Inactive")_" "
End DoDot:4
+52 IF '$TEST
SET TEMP=""
+53 SET TEMP=TEMP_$SELECT(MEDTYPE=INPTYPE:"Inpatient",MEDTYPE=NVATYPE:TITLE,1:"Outpatient")
+54 SET TEMP=" "_TEMP_" Medications"
+55 IF CLASSORT
Begin DoDot:4
+56 IF DETAILED
SET TEMP=TEMP_" (By Class)"
+57 IF '$TEST
SET TEMP=TEMP_" (By Drug Class)"
End DoDot:4
+58 IF DETAILED
Begin DoDot:4
+59 SET TEMP=$EXTRACT(TEMP_SPACE60,1,47)
+60 IF MEDTYPE=INPTYPE
SET TEMP=TEMP_"Status"
+61 IF '$TEST
SET TEMP=TEMP_"Refills"
+62 SET TEMP=$EXTRACT(TEMP_SPACE60,1,60)
+63 IF MEDTYPE=INPTYPE
SET TEMP=TEMP_"Stop Date"
+64 IF '$TEST
SET TEMP=TEMP_"Expiration"
End DoDot:4
IF 1
+65 IF '$TEST
Begin DoDot:4
+66 SET TEMP=$EXTRACT(TEMP_SPACE60,1,60)_"Status"
End DoDot:4
+67 DO ADD^TIULMED1(TEMP)
DO ADD^TIULMED1(DASH73)
End DoDot:3
+68 IF CLASSORT
IF DRUGCLAS'=""
IF DRUGCLAS'=LASTCLAS
Begin DoDot:3
+69 SET LASTCLAS=DRUGCLAS
SET OLDTAB=TAB
SET OLDHEADR=HEADER
+70 SET (TAB,HEADER)=0
+71 IF COUNT>0
DO ADD^TIULMED1(" ")
+72 IF (CLASSORT=2)!(DRUGCLAS=" ")
Begin DoDot:4
+73 IF DRUGCLAS=" "
SET TEMP=" ====== Drug Class Unknown "
+74 IF '$TEST
SET TEMP=" ====== Drug Class: "_DRUGCLAS_" "
End DoDot:4
IF 1
+75 IF '$TEST
SET TEMP=" "
+76 SET TEMP=$EXTRACT(TEMP_DASH73,1,LLEN-2)
+77 DO ADD^TIULMED1(TEMP)
+78 SET HEADER=OLDHEADR
SET TAB=OLDTAB
End DoDot:3
+79 SET COUNT=COUNT+1
SET TOTAL=TOTAL+1
+80 DO ADDMED^TIULMED1(0)
End DoDot:2
End DoDot:1
+81 IF COUNT'=TOTAL
Begin DoDot:1
+82 SET TAB=0
+83 DO ADD^TIULMED1(" ")
+84 DO ADD^TIULMED1(TOTAL_" Total Medications")
End DoDot:1
SORTX ;
+1 QUIT
+2 ;
