ALPBFRM1 ;DAL/SED -STANDARD PRINT FORMATTING UTIL ;Feb 6, 2021@15:27
;;3.0;BAR CODE MED ADMIN;**8,48,69,59,73,87,125,108,135**;Mar 2004;Build 5
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;*69 move code to print Long Wp special istructions lines near end of
; a grid boundary
;*73 - add code to print Clinc Name above meds in detail lines and
; Location in heading.
;*87 - add Remove timing string to print on grid from new Db RM fld.
;*108- add display of order items that are hazardous to handle and/or
; hazardous to dispose
;
F132(DATA,DAYS,MLCNT,RESULTS,ALPPAT) ; format data into a 132-column
; output array...
; DATA = an array containing a specific order node for a selected
; patient in file 53.7
; DAYS = a number that represents the number of initial boxes
; (1 box = 1 day) to add to lines 4-10 (max=7 -- note that
; this is usually a 3-day MAR, but a 7-day MAR could be
; returned from this format utility)
; MLCNT = Number of Med-log entries to print with orders
; RESULTS = an array passed by reference into which the formatted
; entry is set up returns a formatted array in RESULTS
; (note: total line count is returned at RESULTS(0))
I $D(DATA)="" Q
;
N ALPBADM,ALPBDAYS,ALPBDRUG,ALPBIBOX,ALPBNBOX,ALPBPBOX,ALPBSTOP,ALPBTEXT,ALPBTIME,ALPBX,DATE,LINE,BOLDON,BOLDOFF,X,ALPBPRNG,ALPBFLG,ALPBPRN,ALPBMLC,ALPBTSTART
N AD,AINDX,ALPBRM,ALPBDOA,REMTIM,ALPBNOAS,I,J ;*87,*135
; to use BOLD, comment out the next line and remove comments from
; the following five lines...
S BOLDON="<<",BOLDOFF=">>"
;S X="IOINHI;IOINORM"
;D ENDR^%ZISS
;S BOLDON=$G(IOINHI)
;S BOLDOFF=$G(IOINORM)
;D KILL^%ZISS
;
;S MLCNT=$S(+$P($G(^ALPB(53.71,1,2)),U,4)>0:+$P(^ALPB(53.71,1,2),U,4),1:1)
I $G(DAYS)="" S DAYS=3
I DAYS>7 S DAYS=7
S DATE=$$DT^XLFDT()
D FDATES^ALPBUTL(DATE,DAYS,.ALPBDAYS)
; get administration timing (needed for formatting various lines)
S ALPBX=$P($G(DATA(4)),"^",4)
I ALPBX="" S ALPBADM=0
REMOV S ALPBRM=$P($G(DATA(4.5)),U) ;define remove string *87
S ALPBDOA=$P($G(DATA(4.5)),U,2)
I ALPBX'="" D ;normal admin times specified
.S AINDX=$L(ALPBX,"-")+1
.S ALPBADM=0
.F I=1:1 Q:$P(ALPBX,"-",I)="" D
..S ALPBADM(I)=$P(ALPBX,"-",I)
..S ALPBADM=ALPBADM+1
..;add RM times to end of admin array, also insert RM label 1st *87
..I ALPBRM]"" D
...S:I=1 ALPBADM(AINDX)="Remove ",ALPBADM=ALPBADM+1
...S ALPBADM(I+AINDX)=$P(ALPBRM,"-",I) ;I=remove tm for this admin I
...S ALPBADM=ALPBADM+1
I ALPBX="",ALPBRM]"" D ;one time sched, no admin times specified
.S ALPBADM(1)="Remove ",ALPBADM(2)=$P(ALPBRM,"-",1)
;
; line 1...
S RESULTS(1)=""
S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),2)_"Location" ;*73
S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),66)_"Admin"
; line 2...
S RESULTS(2)="Start"
S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),25)_"Stop"
S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),66)_"Times"
S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),74)_ALPBDAYS(0)
I DAYS=3 S RESULTS(2)=RESULTS(2)_" Notes"
; line 3...
S RESULTS(3)=$$REPEAT^XLFSTR("-",132)
; line 4...Clinic Name or INPATIENT ;*73
S RESULTS(4)=$S($P(DATA(0),U,5)="":" INPATIENT",1:" "_$P(DATA(0),U,5)) ;*73
; line 5... ;*73
; start and stop date/times...
S RESULTS(5)=$S($P($G(DATA(1)),"^")'="":$$FMTE^XLFDT($P(DATA(1),"^")),1:"Not on file") ;*73
S RESULTS(5)=$$PAD^ALPBUTL(RESULTS(5),25)_$S($P($G(DATA(1)),"^",2)'="":$$FMTE^XLFDT($P(DATA(1),"^",2)),1:"Not on file") ;73
;
; end of fixed line format, continue...
S LINE=5 ;*73
; get drug(s)...
I +$O(DATA(7,0)) D
.S LINE=LINE+1
.S RESULTS(LINE)=""
.S ALPBX=0
.F S ALPBX=$O(DATA(7,ALPBX)) Q:'ALPBX D
..S ALPBDRUG=$G(BOLDON)_$P(DATA(7,ALPBX,0),"^",2)_$G(BOLDOFF)
..;S RESULTS(LINE)=$G(RESULTS(LINE))_$P(DATA(7,ALPBX,0),"^",2)
..N HZ,TAB,SPC S HZ="" ;*108
..S $P(HZ,"|",1)=$S($G(DATA("HAZTOHAND")):"<<HAZ Handle>>",1:$J("",12)) ;*108
..I $G(DATA("HAZTODISP")) S $P(HZ,"|",2)="<<HAZ Dispose>>" ;*108
..S RESULTS(LINE)=$G(RESULTS(LINE))_ALPBDRUG
..I HZ]"" S LINE=LINE+1,RESULTS(LINE)=$J("",5)_$TR(HZ,"|"," ") ;*108
..S LINE=LINE+1,RESULTS(LINE)=$J("",66)
..K ALPBDRUG
..I +$O(DATA(7,ALPBX)) S LINE=LINE+1
; any additives...
I +$O(DATA(8,0)) D
.S LINE=LINE+1
.S RESULTS(LINE)=" Additive(s): "
.S ALPBX=0
.F S ALPBX=$O(DATA(8,ALPBX)) Q:'ALPBX D
..S ALPBDRUG=$P(DATA(8,ALPBX,0),"^",2)
..; if UNITS is not already contained in ADDITIVE NAME, add it...
..I $P(DATA(8,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$P(DATA(8,ALPBX,0),"^",3)) S ALPBDRUG=ALPBDRUG_" "_$P(DATA(8,ALPBX,0),"^",3)
..S ALPBDRUG=$G(BOLDON)_ALPBDRUG_$G(BOLDOFF)
..S RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG
..K ALPBDRUG
..I +$O(DATA(8,ALPBX)) D
...S LINE=LINE+1
...S RESULTS(LINE)=" "
...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
.K ALPBX
; any solutions...
I +$O(DATA(9,0)) D
.S LINE=LINE+1
.S RESULTS(LINE)=" Solution(s): "
.S ALPBX=0
.F S ALPBX=$O(DATA(9,ALPBX)) Q:'ALPBX D
..S ALPBDRUG=$P(DATA(9,ALPBX,0),"^",2)
..; if UNITS is not already contained in SOLUTION NAME, add it...
..I $P(DATA(9,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$P(DATA(9,ALPBX,0),"^",3)) S ALPBDRUG=ALPBDRUG_" "_$P(DATA(9,ALPBX,0),"^",3)
..S ALPBDRUG=$G(BOLDON)_ALPBDRUG_$G(BOLDOFF)
..S RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG
..K ALPBDRUG
..I +$O(DATA(9,ALPBX)) D
...S LINE=LINE+1
...S RESULTS(LINE)=" "
...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
.K ALPBX
; give ($P(DATA(4),"^",1)=DOSAGE $P(DATA(4),"^",2)=ROUTE $P(DATA(4),"^",3)=SCHEDULE)...
S LINE=LINE+1
S RESULTS(LINE)=" Give: "_$P($G(DATA(4)),"^")_" "_$P($G(DATA(4)),"^",2)_" "_$P($G(DATA(4)),"^",3)
;Set PRN Flag
S ALPBPRNG=0
S:$P($G(DATA(4)),"^",3)["PRN" ALPBPRNG=1
;
;S LINE=LINE+1,RESULTS(LINE)=""
;
; provider, pharmacist or entry person, and verifier...
S LINE=LINE+1
S RESULTS(LINE)=" Provider: "_$P($G(DATA(2)),"^")
S LINE=LINE+1
S RESULTS(LINE)="RPh/Entry by: "_$P($G(DATA(2)),"^",2)
I $P($G(DATA(2)),"^",3)'="" D
.S LINE=LINE+1
.S RESULTS(LINE)=" Verified by: "_$P(DATA(2),"^",3)
; order number and type...
S LINE=LINE+1
S RESULTS(LINE)=" Type: "_$$OTYP^ALPBUTL($P($G(DATA(3)),"^"))
; order status...
S LINE=LINE+1
S RESULTS(LINE)=" Status: "_$P($P(DATA(0),"^",3),"~",2)
;
; med log data...
S LINE=LINE+1
S RESULTS(LINE)="BCMA MEDICATION LOG HISTORY"
;I $G(MLDATE)'="" S RESULTS(LINE)=RESULTS(LINE)_" (since "_$$FMTE^XLFDT(MLDATE)_")"
I +$O(DATA(10,0))=0 D
.S LINE=LINE+1
.S RESULTS(LINE)=" No Medication Log entries are on file for this order."
I +$O(DATA(10,0)) D
.S LINE=LINE+1
.S RESULTS(LINE)=" Log Date"
.S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_"Message"
.S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_"Log Entry Person"
.I $O(DATA(10,"IMLOG",0))="" D
..S LINE=LINE+1
..S RESULTS(LINE)=" No entries since the above date are on file."
.;S ALPBMDT=MLDATE
.S ALPBMDT=0,ALPBMLC=1
.F S ALPBMDT=$O(DATA(10,"IMLOG",ALPBMDT)) Q:'ALPBMDT!(ALPBMLC>MLCNT) D
..S ALPBX=0
..F S ALPBX=$O(DATA(10,"IMLOG",ALPBMDT,ALPBX)) Q:'ALPBX!(ALPBMLC>MLCNT) D
...S LINE=LINE+1,ALPBMLC=ALPBMLC+1
...S RESULTS(LINE)=" "_$$FDATE^ALPBUTL($P(DATA(10,ALPBX,0),"^",1))
...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$P(DATA(10,ALPBX,0),"^",3)
...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_$S($P(DATA(10,ALPBX,0),"^",2)'="":$P(DATA(10,ALPBX,0),"^",2),1:"<not on file")
...;check if log count reached
...Q:ALPBMLC>MLCNT
...;check if REMOVED action, then retrieve associated GIVEN info *87
...D:$P(DATA(10,ALPBX,0),"^",3)["REMOVED"
....Q:'$P(DATA(10,ALPBX,0),"^",5) ;in case null
....S LINE=LINE+1,ALPBMLC=ALPBMLC+1
....S RESULTS(LINE)=" "_$$FDATE^ALPBUTL($P(DATA(10,ALPBX,0),"^",5))
....S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$P(DATA(10,ALPBX,0),"^",7)
....S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_$S($P(DATA(10,ALPBX,0),"^",6)'="":$P(DATA(10,ALPBX,0),"^",6),1:"<not on file")
..K ALPBX
.K ALPBMDT,ALPBMLC
;
; BCMA LAST ACTION
I +$G(ALPPAT)>0 D
.S ALPBX=0
.F S ALPBX=$O(DATA(7,ALPBX)) Q:'ALPBX D
..S ALPDRUG=$P(DATA(7,ALPBX,0),"^",1),ALPBDNM=$P(DATA(7,ALPBX,0),"^",2)
..Q:+ALPDRUG'>0
..S ALPLACT=$$LACT^ALPBUTL3(ALPPAT,ALPDRUG)
..I ALPLACT'="" D
...S LINE=LINE+1,RESULTS(LINE)=$$REPEAT^XLFSTR("-",75)
...S LINE=LINE+1
...S RESULTS(LINE)="Last action for "_ALPBDNM_" "_" was "_$P(ALPLACT,"^",3)_" on "_$$FDATE^ALPBUTL($P(ALPLACT,"^",1))
...S RESULTS(LINE)=RESULTS(LINE)_" By "_$S($P(ALPLACT,"^",2)'="":$P(ALPLACT,"^",2),1:"<not on file>")
K ALPLACT,ALPDRUG,ALPBX
;
I LINE<11 F I=1:1 Q:LINE=11 D
.S LINE=LINE+1
.S RESULTS(LINE)=""
;
; now add admin times and initial boxes to lines 4-10 as required
; by number of administration times...
S ALPBIBOX="______|"
S ALPBNBOX="******|"
I +$G(ALPBADM)=0 S ALPBADM=8
;S ALPBPRN=ALPBADM+4
S ALPBTSTART=$P($G(DATA(1)),"^",1)
S ALPBSTOP=$P($G(DATA(1)),"^",2)
S AD=1
ADMTIM F I=1:1:ALPBADM D ;build admin/remove times grid
.S ALPBPRN=I+3
.S ALPBADMT=$G(ALPBADM(I))
.I ALPBADMT="" S ALPBADMT=" "
.I '$D(RESULTS(I+3)) D
..S RESULTS(I+3)=" "
..S LINE=LINE+1
.I ALPBADMT["Remove" D
..S RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
..S AD=0
.E D
..S:AD RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
..S:'AD RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
.S RESULTS(I+3)=RESULTS(I+3)_$S($L(ALPBADMT)=2:ALPBADMT_"00",1:ALPBADMT)
.S RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),74)_"|"
.F J=1:1:DAYS D
..S ALPBNOAS=$S(+ALPBADMT:1,ALPBPRNG:0,$$OTYP^ALPBUTL($P($G(DATA(3)),"^"))="IV":0,1:1) ;P135 PRN or IV
..I ALPBADMT=" "&ALPBNOAS S ALPBTSTART=$P($P($G(DATA(1)),"^",1),".",1),ALPBSTOP=$P($P($G(DATA(1)),"^",2),".",1) ;P135
..S ALPBDAY=+(ALPBDAYS(J)_"."_ALPBADMT) ;125 - add + to trim insignificant trailing 0's
..S ALPBPBOX=ALPBIBOX
ASTER ..;prints asterisks in boxes if start date is in the future
..;and if the stop date has already expired
..I AD D ;on an admin line
...I ALPBDAY<ALPBTSTART&(ALPBNOAS) S ALPBPBOX=ALPBNBOX ;P135
...I ALPBDAY>ALPBSTOP!(ALPBDAY=ALPBSTOP) S ALPBPBOX=ALPBNBOX
..E D ;on a remove line calc orig admin for this remove time
...I ALPBDAY["Remove" S ALPBPBOX=ALPBNBOX Q ;Remove lbl line = *
...S REMTIM=$$FMADD^XLFDT(ALPBDAY,,,-ALPBDOA) ;Rem-Doa = orig admin
...I (REMTIM<ALPBTSTART)!(REMTIM>ALPBSTOP) S ALPBPBOX=ALPBNBOX
..S RESULTS(I+3)=RESULTS(I+3)_ALPBPBOX
.K ALPBADMT,ALPBPBOX,ALPBDAY
ENDGRID K ALPBIBOX,ALPBNBOX
; if PRN med, add line for documenting effectiveness...
I +ALPBPRNG D
.S ALPBFLG=0,ALPBPRN=ALPBPRN+1
.S:'$D(RESULTS(ALPBPRN)) RESULTS(ALPBPRN)=" ",ALPBFLG=1
.S RESULTS(ALPBPRN)=$$PAD^ALPBUTL(RESULTS(ALPBPRN),63)_" PRN Effectiveness:_______________________________________________" ;*87 longer
.S:ALPBFLG LINE=LINE+1
;
;*69 move SI text to here outside confines of grid
; provider comments, special instructions, and other print info...
I +$O(DATA(5,0)) D
.K ALPBTEXT M ALPBTEXT=DATA(5)
.S ALPBX=0
.F S ALPBX=$O(ALPBTEXT(ALPBX)) Q:'ALPBX D
..S ALPBLINE=ALPBTEXT(ALPBX,0)
..S LINE=LINE+1
..S RESULTS(LINE)=ALPBLINE
.K ALPBLINE,ALPBTEXT,ALPBX
;
S LINE=LINE+1
S RESULTS(LINE)=$$REPEAT^XLFSTR("-",132)
S RESULTS(0)=LINE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBFRM1 11630 printed Apr 09, 2024@20:44:50 Page 2
ALPBFRM1 ;DAL/SED -STANDARD PRINT FORMATTING UTIL ;Feb 6, 2021@15:27
+1 ;;3.0;BAR CODE MED ADMIN;**8,48,69,59,73,87,125,108,135**;Mar 2004;Build 5
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;*69 move code to print Long Wp special istructions lines near end of
+5 ; a grid boundary
+6 ;*73 - add code to print Clinc Name above meds in detail lines and
+7 ; Location in heading.
+8 ;*87 - add Remove timing string to print on grid from new Db RM fld.
+9 ;*108- add display of order items that are hazardous to handle and/or
+10 ; hazardous to dispose
+11 ;
F132(DATA,DAYS,MLCNT,RESULTS,ALPPAT) ; format data into a 132-column
+1 ; output array...
+2 ; DATA = an array containing a specific order node for a selected
+3 ; patient in file 53.7
+4 ; DAYS = a number that represents the number of initial boxes
+5 ; (1 box = 1 day) to add to lines 4-10 (max=7 -- note that
+6 ; this is usually a 3-day MAR, but a 7-day MAR could be
+7 ; returned from this format utility)
+8 ; MLCNT = Number of Med-log entries to print with orders
+9 ; RESULTS = an array passed by reference into which the formatted
+10 ; entry is set up returns a formatted array in RESULTS
+11 ; (note: total line count is returned at RESULTS(0))
+12 IF $DATA(DATA)=""
QUIT
+13 ;
+14 NEW ALPBADM,ALPBDAYS,ALPBDRUG,ALPBIBOX,ALPBNBOX,ALPBPBOX,ALPBSTOP,ALPBTEXT,ALPBTIME,ALPBX,DATE,LINE,BOLDON,BOLDOFF,X,ALPBPRNG,ALPBFLG,ALPBPRN,ALPBMLC,ALPBTSTART
+15 ;*87,*135
NEW AD,AINDX,ALPBRM,ALPBDOA,REMTIM,ALPBNOAS,I,J
+16 ; to use BOLD, comment out the next line and remove comments from
+17 ; the following five lines...
+18 SET BOLDON="<<"
SET BOLDOFF=">>"
+19 ;S X="IOINHI;IOINORM"
+20 ;D ENDR^%ZISS
+21 ;S BOLDON=$G(IOINHI)
+22 ;S BOLDOFF=$G(IOINORM)
+23 ;D KILL^%ZISS
+24 ;
+25 ;S MLCNT=$S(+$P($G(^ALPB(53.71,1,2)),U,4)>0:+$P(^ALPB(53.71,1,2),U,4),1:1)
+26 IF $GET(DAYS)=""
SET DAYS=3
+27 IF DAYS>7
SET DAYS=7
+28 SET DATE=$$DT^XLFDT()
+29 DO FDATES^ALPBUTL(DATE,DAYS,.ALPBDAYS)
+30 ; get administration timing (needed for formatting various lines)
+31 SET ALPBX=$PIECE($GET(DATA(4)),"^",4)
+32 IF ALPBX=""
SET ALPBADM=0
REMOV ;define remove string *87
SET ALPBRM=$PIECE($GET(DATA(4.5)),U)
+1 SET ALPBDOA=$PIECE($GET(DATA(4.5)),U,2)
+2 ;normal admin times specified
IF ALPBX'=""
Begin DoDot:1
+3 SET AINDX=$LENGTH(ALPBX,"-")+1
+4 SET ALPBADM=0
+5 FOR I=1:1
if $PIECE(ALPBX,"-",I)=""
QUIT
Begin DoDot:2
+6 SET ALPBADM(I)=$PIECE(ALPBX,"-",I)
+7 SET ALPBADM=ALPBADM+1
+8 ;add RM times to end of admin array, also insert RM label 1st *87
+9 IF ALPBRM]""
Begin DoDot:3
+10 if I=1
SET ALPBADM(AINDX)="Remove "
SET ALPBADM=ALPBADM+1
+11 ;I=remove tm for this admin I
SET ALPBADM(I+AINDX)=$PIECE(ALPBRM,"-",I)
+12 SET ALPBADM=ALPBADM+1
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;one time sched, no admin times specified
IF ALPBX=""
IF ALPBRM]""
Begin DoDot:1
+14 SET ALPBADM(1)="Remove "
SET ALPBADM(2)=$PIECE(ALPBRM,"-",1)
End DoDot:1
+15 ;
+16 ; line 1...
+17 SET RESULTS(1)=""
+18 ;*73
SET RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),2)_"Location"
+19 SET RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),66)_"Admin"
+20 ; line 2...
+21 SET RESULTS(2)="Start"
+22 SET RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),25)_"Stop"
+23 SET RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),66)_"Times"
+24 SET RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),74)_ALPBDAYS(0)
+25 IF DAYS=3
SET RESULTS(2)=RESULTS(2)_" Notes"
+26 ; line 3...
+27 SET RESULTS(3)=$$REPEAT^XLFSTR("-",132)
+28 ; line 4...Clinic Name or INPATIENT ;*73
+29 ;*73
SET RESULTS(4)=$SELECT($PIECE(DATA(0),U,5)="":" INPATIENT",1:" "_$PIECE(DATA(0),U,5))
+30 ; line 5... ;*73
+31 ; start and stop date/times...
+32 ;*73
SET RESULTS(5)=$SELECT($PIECE($GET(DATA(1)),"^")'="":$$FMTE^XLFDT($PIECE(DATA(1),"^")),1:"Not on file")
+33 ;73
SET RESULTS(5)=$$PAD^ALPBUTL(RESULTS(5),25)_$SELECT($PIECE($GET(DATA(1)),"^",2)'="":$$FMTE^XLFDT($PIECE(DATA(1),"^",2)),1:"Not on file")
+34 ;
+35 ; end of fixed line format, continue...
+36 ;*73
SET LINE=5
+37 ; get drug(s)...
+38 IF +$ORDER(DATA(7,0))
Begin DoDot:1
+39 SET LINE=LINE+1
+40 SET RESULTS(LINE)=""
+41 SET ALPBX=0
+42 FOR
SET ALPBX=$ORDER(DATA(7,ALPBX))
if 'ALPBX
QUIT
Begin DoDot:2
+43 SET ALPBDRUG=$GET(BOLDON)_$PIECE(DATA(7,ALPBX,0),"^",2)_$GET(BOLDOFF)
+44 ;S RESULTS(LINE)=$G(RESULTS(LINE))_$P(DATA(7,ALPBX,0),"^",2)
+45 ;*108
NEW HZ,TAB,SPC
SET HZ=""
+46 ;*108
SET $PIECE(HZ,"|",1)=$SELECT($GET(DATA("HAZTOHAND")):"<<HAZ Handle>>",1:$JUSTIFY("",12))
+47 ;*108
IF $GET(DATA("HAZTODISP"))
SET $PIECE(HZ,"|",2)="<<HAZ Dispose>>"
+48 SET RESULTS(LINE)=$GET(RESULTS(LINE))_ALPBDRUG
+49 ;*108
IF HZ]""
SET LINE=LINE+1
SET RESULTS(LINE)=$JUSTIFY("",5)_$TRANSLATE(HZ,"|"," ")
+50 SET LINE=LINE+1
SET RESULTS(LINE)=$JUSTIFY("",66)
+51 KILL ALPBDRUG
+52 IF +$ORDER(DATA(7,ALPBX))
SET LINE=LINE+1
End DoDot:2
End DoDot:1
+53 ; any additives...
+54 IF +$ORDER(DATA(8,0))
Begin DoDot:1
+55 SET LINE=LINE+1
+56 SET RESULTS(LINE)=" Additive(s): "
+57 SET ALPBX=0
+58 FOR
SET ALPBX=$ORDER(DATA(8,ALPBX))
if 'ALPBX
QUIT
Begin DoDot:2
+59 SET ALPBDRUG=$PIECE(DATA(8,ALPBX,0),"^",2)
+60 ; if UNITS is not already contained in ADDITIVE NAME, add it...
+61 IF $PIECE(DATA(8,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$PIECE(DATA(8,ALPBX,0),"^",3))
SET ALPBDRUG=ALPBDRUG_" "_$PIECE(DATA(8,ALPBX,0),"^",3)
+62 SET ALPBDRUG=$GET(BOLDON)_ALPBDRUG_$GET(BOLDOFF)
+63 SET RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG
+64 KILL ALPBDRUG
+65 IF +$ORDER(DATA(8,ALPBX))
Begin DoDot:3
+66 SET LINE=LINE+1
+67 SET RESULTS(LINE)=" "
+68 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
End DoDot:3
End DoDot:2
+69 KILL ALPBX
End DoDot:1
+70 ; any solutions...
+71 IF +$ORDER(DATA(9,0))
Begin DoDot:1
+72 SET LINE=LINE+1
+73 SET RESULTS(LINE)=" Solution(s): "
+74 SET ALPBX=0
+75 FOR
SET ALPBX=$ORDER(DATA(9,ALPBX))
if 'ALPBX
QUIT
Begin DoDot:2
+76 SET ALPBDRUG=$PIECE(DATA(9,ALPBX,0),"^",2)
+77 ; if UNITS is not already contained in SOLUTION NAME, add it...
+78 IF $PIECE(DATA(9,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$PIECE(DATA(9,ALPBX,0),"^",3))
SET ALPBDRUG=ALPBDRUG_" "_$PIECE(DATA(9,ALPBX,0),"^",3)
+79 SET ALPBDRUG=$GET(BOLDON)_ALPBDRUG_$GET(BOLDOFF)
+80 SET RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG
+81 KILL ALPBDRUG
+82 IF +$ORDER(DATA(9,ALPBX))
Begin DoDot:3
+83 SET LINE=LINE+1
+84 SET RESULTS(LINE)=" "
+85 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
End DoDot:3
End DoDot:2
+86 KILL ALPBX
End DoDot:1
+87 ; give ($P(DATA(4),"^",1)=DOSAGE $P(DATA(4),"^",2)=ROUTE $P(DATA(4),"^",3)=SCHEDULE)...
+88 SET LINE=LINE+1
+89 SET RESULTS(LINE)=" Give: "_$PIECE($GET(DATA(4)),"^")_" "_$PIECE($GET(DATA(4)),"^",2)_" "_$PIECE($GET(DATA(4)),"^",3)
+90 ;Set PRN Flag
+91 SET ALPBPRNG=0
+92 if $PIECE($GET(DATA(4)),"^",3)["PRN"
SET ALPBPRNG=1
+93 ;
+94 ;S LINE=LINE+1,RESULTS(LINE)=""
+95 ;
+96 ; provider, pharmacist or entry person, and verifier...
+97 SET LINE=LINE+1
+98 SET RESULTS(LINE)=" Provider: "_$PIECE($GET(DATA(2)),"^")
+99 SET LINE=LINE+1
+100 SET RESULTS(LINE)="RPh/Entry by: "_$PIECE($GET(DATA(2)),"^",2)
+101 IF $PIECE($GET(DATA(2)),"^",3)'=""
Begin DoDot:1
+102 SET LINE=LINE+1
+103 SET RESULTS(LINE)=" Verified by: "_$PIECE(DATA(2),"^",3)
End DoDot:1
+104 ; order number and type...
+105 SET LINE=LINE+1
+106 SET RESULTS(LINE)=" Type: "_$$OTYP^ALPBUTL($PIECE($GET(DATA(3)),"^"))
+107 ; order status...
+108 SET LINE=LINE+1
+109 SET RESULTS(LINE)=" Status: "_$PIECE($PIECE(DATA(0),"^",3),"~",2)
+110 ;
+111 ; med log data...
+112 SET LINE=LINE+1
+113 SET RESULTS(LINE)="BCMA MEDICATION LOG HISTORY"
+114 ;I $G(MLDATE)'="" S RESULTS(LINE)=RESULTS(LINE)_" (since "_$$FMTE^XLFDT(MLDATE)_")"
+115 IF +$ORDER(DATA(10,0))=0
Begin DoDot:1
+116 SET LINE=LINE+1
+117 SET RESULTS(LINE)=" No Medication Log entries are on file for this order."
End DoDot:1
+118 IF +$ORDER(DATA(10,0))
Begin DoDot:1
+119 SET LINE=LINE+1
+120 SET RESULTS(LINE)=" Log Date"
+121 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_"Message"
+122 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_"Log Entry Person"
+123 IF $ORDER(DATA(10,"IMLOG",0))=""
Begin DoDot:2
+124 SET LINE=LINE+1
+125 SET RESULTS(LINE)=" No entries since the above date are on file."
End DoDot:2
+126 ;S ALPBMDT=MLDATE
+127 SET ALPBMDT=0
SET ALPBMLC=1
+128 FOR
SET ALPBMDT=$ORDER(DATA(10,"IMLOG",ALPBMDT))
if 'ALPBMDT!(ALPBMLC>MLCNT)
QUIT
Begin DoDot:2
+129 SET ALPBX=0
+130 FOR
SET ALPBX=$ORDER(DATA(10,"IMLOG",ALPBMDT,ALPBX))
if 'ALPBX!(ALPBMLC>MLCNT)
QUIT
Begin DoDot:3
+131 SET LINE=LINE+1
SET ALPBMLC=ALPBMLC+1
+132 SET RESULTS(LINE)=" "_$$FDATE^ALPBUTL($PIECE(DATA(10,ALPBX,0),"^",1))
+133 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$PIECE(DATA(10,ALPBX,0),"^",3)
+134 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_$SELECT($PIECE(DATA(10,ALPBX,0),"^",2)'="":$PIECE(DATA(10,ALPBX,0),"^",2),1:"<not on file")
+135 ;check if log count reached
+136 if ALPBMLC>MLCNT
QUIT
+137 ;check if REMOVED action, then retrieve associated GIVEN info *87
+138 if $PIECE(DATA(10,ALPBX,0),"^",3)["REMOVED"
Begin DoDot:4
+139 ;in case null
if '$PIECE(DATA(10,ALPBX,0),"^",5)
QUIT
+140 SET LINE=LINE+1
SET ALPBMLC=ALPBMLC+1
+141 SET RESULTS(LINE)=" "_$$FDATE^ALPBUTL($PIECE(DATA(10,ALPBX,0),"^",5))
+142 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$PIECE(DATA(10,ALPBX,0),"^",7)
+143 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_$SELECT($PIECE(DATA(10,ALPBX,0),"^",6)'="":$PIECE(DATA(10,ALPBX,0),"^",6),1:"<not on file")
End DoDot:4
End DoDot:3
+144 KILL ALPBX
End DoDot:2
+145 KILL ALPBMDT,ALPBMLC
End DoDot:1
+146 ;
+147 ; BCMA LAST ACTION
+148 IF +$GET(ALPPAT)>0
Begin DoDot:1
+149 SET ALPBX=0
+150 FOR
SET ALPBX=$ORDER(DATA(7,ALPBX))
if 'ALPBX
QUIT
Begin DoDot:2
+151 SET ALPDRUG=$PIECE(DATA(7,ALPBX,0),"^",1)
SET ALPBDNM=$PIECE(DATA(7,ALPBX,0),"^",2)
+152 if +ALPDRUG'>0
QUIT
+153 SET ALPLACT=$$LACT^ALPBUTL3(ALPPAT,ALPDRUG)
+154 IF ALPLACT'=""
Begin DoDot:3
+155 SET LINE=LINE+1
SET RESULTS(LINE)=$$REPEAT^XLFSTR("-",75)
+156 SET LINE=LINE+1
+157 SET RESULTS(LINE)="Last action for "_ALPBDNM_" "_" was "_$PIECE(ALPLACT,"^",3)_" on "_$$FDATE^ALPBUTL($PIECE(ALPLACT,"^",1))
+158 SET RESULTS(LINE)=RESULTS(LINE)_" By "_$SELECT($PIECE(ALPLACT,"^",2)'="":$PIECE(ALPLACT,"^",2),1:"<not on file>")
End DoDot:3
End DoDot:2
End DoDot:1
+159 KILL ALPLACT,ALPDRUG,ALPBX
+160 ;
+161 IF LINE<11
FOR I=1:1
if LINE=11
QUIT
Begin DoDot:1
+162 SET LINE=LINE+1
+163 SET RESULTS(LINE)=""
End DoDot:1
+164 ;
+165 ; now add admin times and initial boxes to lines 4-10 as required
+166 ; by number of administration times...
+167 SET ALPBIBOX="______|"
+168 SET ALPBNBOX="******|"
+169 IF +$GET(ALPBADM)=0
SET ALPBADM=8
+170 ;S ALPBPRN=ALPBADM+4
+171 SET ALPBTSTART=$PIECE($GET(DATA(1)),"^",1)
+172 SET ALPBSTOP=$PIECE($GET(DATA(1)),"^",2)
+173 SET AD=1
ADMTIM ;build admin/remove times grid
FOR I=1:1:ALPBADM
Begin DoDot:1
+1 SET ALPBPRN=I+3
+2 SET ALPBADMT=$GET(ALPBADM(I))
+3 IF ALPBADMT=""
SET ALPBADMT=" "
+4 IF '$DATA(RESULTS(I+3))
Begin DoDot:2
+5 SET RESULTS(I+3)=" "
+6 SET LINE=LINE+1
End DoDot:2
+7 IF ALPBADMT["Remove"
Begin DoDot:2
+8 SET RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
+9 SET AD=0
End DoDot:2
+10 IF '$TEST
Begin DoDot:2
+11 if AD
SET RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
+12 if 'AD
SET RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
End DoDot:2
+13 SET RESULTS(I+3)=RESULTS(I+3)_$SELECT($LENGTH(ALPBADMT)=2:ALPBADMT_"00",1:ALPBADMT)
+14 SET RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),74)_"|"
+15 FOR J=1:1:DAYS
Begin DoDot:2
+16 ;P135 PRN or IV
SET ALPBNOAS=$SELECT(+ALPBADMT:1,ALPBPRNG:0,$$OTYP^ALPBUTL($PIECE($GET(DATA(3)),"^"))="IV":0,1:1)
+17 ;P135
IF ALPBADMT=" "&ALPBNOAS
SET ALPBTSTART=$PIECE($PIECE($GET(DATA(1)),"^",1),".",1)
SET ALPBSTOP=$PIECE($PIECE($GET(DATA(1)),"^",2),".",1)
+18 ;125 - add + to trim insignificant trailing 0's
SET ALPBDAY=+(ALPBDAYS(J)_"."_ALPBADMT)
+19 SET ALPBPBOX=ALPBIBOX
ASTER ;prints asterisks in boxes if start date is in the future
+1 ;and if the stop date has already expired
+2 ;on an admin line
IF AD
Begin DoDot:3
+3 ;P135
IF ALPBDAY<ALPBTSTART&(ALPBNOAS)
SET ALPBPBOX=ALPBNBOX
+4 IF ALPBDAY>ALPBSTOP!(ALPBDAY=ALPBSTOP)
SET ALPBPBOX=ALPBNBOX
End DoDot:3
+5 ;on a remove line calc orig admin for this remove time
IF '$TEST
Begin DoDot:3
+6 ;Remove lbl line = *
IF ALPBDAY["Remove"
SET ALPBPBOX=ALPBNBOX
QUIT
+7 ;Rem-Doa = orig admin
SET REMTIM=$$FMADD^XLFDT(ALPBDAY,,,-ALPBDOA)
+8 IF (REMTIM<ALPBTSTART)!(REMTIM>ALPBSTOP)
SET ALPBPBOX=ALPBNBOX
End DoDot:3
+9 SET RESULTS(I+3)=RESULTS(I+3)_ALPBPBOX
End DoDot:2
+10 KILL ALPBADMT,ALPBPBOX,ALPBDAY
End DoDot:1
ENDGRID KILL ALPBIBOX,ALPBNBOX
+1 ; if PRN med, add line for documenting effectiveness...
+2 IF +ALPBPRNG
Begin DoDot:1
+3 SET ALPBFLG=0
SET ALPBPRN=ALPBPRN+1
+4 if '$DATA(RESULTS(ALPBPRN))
SET RESULTS(ALPBPRN)=" "
SET ALPBFLG=1
+5 ;*87 longer
SET RESULTS(ALPBPRN)=$$PAD^ALPBUTL(RESULTS(ALPBPRN),63)_" PRN Effectiveness:_______________________________________________"
+6 if ALPBFLG
SET LINE=LINE+1
End DoDot:1
+7 ;
+8 ;*69 move SI text to here outside confines of grid
+9 ; provider comments, special instructions, and other print info...
+10 IF +$ORDER(DATA(5,0))
Begin DoDot:1
+11 KILL ALPBTEXT
MERGE ALPBTEXT=DATA(5)
+12 SET ALPBX=0
+13 FOR
SET ALPBX=$ORDER(ALPBTEXT(ALPBX))
if 'ALPBX
QUIT
Begin DoDot:2
+14 SET ALPBLINE=ALPBTEXT(ALPBX,0)
+15 SET LINE=LINE+1
+16 SET RESULTS(LINE)=ALPBLINE
End DoDot:2
+17 KILL ALPBLINE,ALPBTEXT,ALPBX
End DoDot:1
+18 ;
+19 SET LINE=LINE+1
+20 SET RESULTS(LINE)=$$REPEAT^XLFSTR("-",132)
+21 SET RESULTS(0)=LINE
+22 QUIT
