ALPBFRM2 ;OIFO-DALLAS MW,SED,KC-SCREEN DISPLAY FORMATTING UTIL ;01/01/03
;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
;
F80(DATA,MLDATE,RESULTS) ; format basic output for screen (80-column) display...
; DATA = array passed by reference containing the data record to be formatted
; MLDATE = a date from which med log data is retrieved
; returns RESULTS array with formatted output (note: total lines returned in RESULTS(0))
N ALPBCMNT,ALPBMDT,ALPBTEXT,ALPBX,LINE
S RESULTS(0)=0
S RESULTS(1)=" Order Number: "_$S($P($G(DATA(0)),"^")'="":$P(DATA(0),"^"),1:"??")
S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),50)_"Start: "
S RESULTS(1)=RESULTS(1)_$S($P($G(DATA(1)),"^")'="":$$FMTE^XLFDT($P(DATA(1),"^")),1:"<not on file>")
S RESULTS(2)=" Type: "_$$OTYP^ALPBUTL($P(DATA(3),"^"))
S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),51)_"Stop: "
S RESULTS(2)=RESULTS(2)_$S($P($G(DATA(1)),"^",2)'="":$$FMTE^XLFDT($P(DATA(1),"^",2)),1:"<not on file>")
S RESULTS(3)=" Status: "_$P($P(DATA(0),"^",3),"~",2)
S LINE=3
; drug(s)...
I +$O(DATA(7,0)) D
.S LINE=LINE+1
.S RESULTS(LINE)=" Drug: "
.S ALPBX=0
.F S ALPBX=$O(DATA(7,ALPBX)) Q:'ALPBX D
..S RESULTS(LINE)=$G(RESULTS(LINE))_$P(DATA(7,ALPBX,0),"^",2)
..I +$O(DATA(7,ALPBX)) D
...S LINE=LINE+1
...S RESULTS(LINE)=" "
...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
.K ALPBX
;
; any additives...
I +$O(DATA(8,0)) D
.S LINE=LINE+1
.S RESULTS(LINE)="Additive Info: "
.S ALPBX=0
.F S ALPBX=$O(DATA(8,ALPBX)) Q:'ALPBX D
..S RESULTS(LINE)=RESULTS(LINE)_$P(DATA(8,ALPBX,0),"^",2)
..; if UNITS isn't already contained in ADDITIVE NAME, add it...
..I $P(DATA(8,ALPBX,0),"^",3)'=""&($P(DATA(8,ALPBX,0),"^",2)'[$P(DATA(8,ALPBX,0),"^",3)) S RESULTS(LINE)=RESULTS(LINE)_" "_$P(DATA(8,ALPBX,0),"^",3)
..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 Info: "
.S ALPBX=0
.F S ALPBX=$O(DATA(9,ALPBX)) Q:'ALPBX D
..S RESULTS(LINE)=RESULTS(LINE)_$P(DATA(9,ALPBX,0),"^",2)
..; if UNITS isn't already contained in SOLUTION NAME, add it...
..I $P(DATA(9,ALPBX,0),"^",3)'=""&($P(DATA(9,ALPBX,0),"^",2)'[$P(DATA(9,ALPBX,0),"^",3)) S RESULTS(LINE)=RESULTS(LINE)_" "_$P(DATA(9,ALPBX,0),"^",3)
..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)
; provider, pharmacist or entry person, and verifier...
S LINE=LINE+1
S RESULTS(LINE)=" Provider: "_$P($G(DATA(2)),"^")
S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),43)_"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)
; administration times...
S LINE=LINE+1
S RESULTS(LINE)=" Admin. Times: "_$P($G(DATA(4)),"^",4)
; provider comments, special instructions or other print info...
I +$O(DATA(5,0)) D
.M ALPBCMNT=DATA(5)
.D FTEXT^ALPBFRMU(78,.ALPBCMNT,.ALPBTEXT)
.K ALPBCMNT
.S ALPBX=0
.F S ALPBX=$O(ALPBTEXT(ALPBX)) Q:'ALPBX D
..S LINE=LINE+1
..S RESULTS(LINE)=ALPBTEXT(ALPBX,0)
.K ALPBTEXT,ALPBX
; med log data...
I +$O(DATA(10,0)) D
.S LINE=LINE+1
.S RESULTS(LINE)="BCMA Medication Log History since "_$$FMTE^XLFDT(MLDATE)
.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,"B",MLDATE))="" D
..S LINE=LINE+1
..S RESULTS(LINE)="No entries to report."
.S ALPBMDT=MLDATE
.F S ALPBMDT=$O(DATA(10,"B",ALPBMDT)) Q:'ALPBMDT D
..S ALPBX=0
..F S ALPBX=$O(DATA(10,"B",ALPBMDT,ALPBX)) Q:'ALPBX D
...S LINE=LINE+1
...S RESULTS(LINE)=" "_$$FDATE^ALPBUTL(ALPBMDT)
...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>")
..K ALPBX
.K ALPBMDT
S LINE=LINE+1
S RESULTS(LINE)=$$REPEAT^XLFSTR("-",80)
S RESULTS(0)=LINE
Q
;
HDR(DATA,TYPE,PG,RESULTS) ; screen display header...
; DATA = array passed by reference containing the data record to be formatted
; TYPE = either 'A' for ALL orders or 'C' for CURRENT orders. if null, not used in construction
; of first line of returned array
; PG = page number
; RESULTS = an array passed by reference into which the formatted output will be saved
; returns RESULTS array with formatted output (note: total lines returned in RESULTS(0))
N ALPBX,LINE
I $G(TYPE)="" S TYPE="X"
I $G(PG)="" S PG=0
S RESULTS(0)=0
S RESULTS(1)=$S(TYPE="A":"ALL ",TYPE="C":"CURRENT ",1:"")_"ORDERS"
S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),70)_"Page: "_$J(PG,3)
S RESULTS(2)=$P($G(DATA(0)),"^")
S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),32)_"SSN: "_$P($G(DATA(0)),"^",2)
S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),48)_"Ward: "_$P($G(DATA(0)),"^",5)
S RESULTS(3)="This record last updated: "_$S($P(DATA(0),"^",8)'="":$$FMTE^XLFDT($P(DATA(0),"^",8)),1:"<date not on file>")
S RESULTS(3)=$$PAD^ALPBUTL(RESULTS(3),48)_"Room: "_$P(DATA(0),"^",6)_" Bed: "_$P(DATA(0),"^",7)
S LINE=3
I +$O(DATA(1,0)) D
.S LINE=LINE+1
.S RESULTS(LINE)="Allergies: "
.S ALPBX=0
.F S ALPBX=$O(DATA(1,ALPBX)) Q:'ALPBX D
..S RESULTS(LINE)=RESULTS(LINE)_$P(DATA(1,ALPBX,0),"^",2)
..I +$O(DATA(1,ALPBX)) S RESULTS(LINE)=RESULTS(LINE)_"; "
S LINE=LINE+1
S RESULTS(LINE)=$$REPEAT^XLFSTR("-",80)
S RESULTS(0)=LINE
Q
ALPBFRM2 ;OIFO-DALLAS MW,SED,KC-SCREEN DISPLAY FORMATTING UTIL ;01/01/03
+1 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
+2 ;
F80(DATA,MLDATE,RESULTS) ; format basic output for screen (80-column) display...
+1 ; DATA = array passed by reference containing the data record to be formatted
+2 ; MLDATE = a date from which med log data is retrieved
+3 ; returns RESULTS array with formatted output (note: total lines returned in RESULTS(0))
+4 NEW ALPBCMNT,ALPBMDT,ALPBTEXT,ALPBX,LINE
+5 SET RESULTS(0)=0
+6 SET RESULTS(1)=" Order Number: "_$SELECT($PIECE($GET(DATA(0)),"^")'="":$PIECE(DATA(0),"^"),1:"??")
+7 SET RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),50)_"Start: "
+8 SET RESULTS(1)=RESULTS(1)_$SELECT($PIECE($GET(DATA(1)),"^")'="":$$FMTE^XLFDT($PIECE(DATA(1),"^")),1:"<not on file>")
+9 SET RESULTS(2)=" Type: "_$$OTYP^ALPBUTL($PIECE(DATA(3),"^"))
+10 SET RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),51)_"Stop: "
+11 SET RESULTS(2)=RESULTS(2)_$SELECT($PIECE($GET(DATA(1)),"^",2)'="":$$FMTE^XLFDT($PIECE(DATA(1),"^",2)),1:"<not on file>")
+12 SET RESULTS(3)=" Status: "_$PIECE($PIECE(DATA(0),"^",3),"~",2)
+13 SET LINE=3
+14 ; drug(s)...
+15 IF +$ORDER(DATA(7,0))
Begin DoDot:1
+16 SET LINE=LINE+1
+17 SET RESULTS(LINE)=" Drug: "
+18 SET ALPBX=0
+19 FOR
SET ALPBX=$ORDER(DATA(7,ALPBX))
IF 'ALPBX
QUIT
Begin DoDot:2
+20 SET RESULTS(LINE)=$GET(RESULTS(LINE))_$PIECE(DATA(7,ALPBX,0),"^",2)
+21 IF +$ORDER(DATA(7,ALPBX))
Begin DoDot:3
+22 SET LINE=LINE+1
+23 SET RESULTS(LINE)=" "
+24 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
End DoDot:3
End DoDot:2
+25 KILL ALPBX
End DoDot:1
+26 ;
+27 ; any additives...
+28 IF +$ORDER(DATA(8,0))
Begin DoDot:1
+29 SET LINE=LINE+1
+30 SET RESULTS(LINE)="Additive Info: "
+31 SET ALPBX=0
+32 FOR
SET ALPBX=$ORDER(DATA(8,ALPBX))
IF 'ALPBX
QUIT
Begin DoDot:2
+33 SET RESULTS(LINE)=RESULTS(LINE)_$PIECE(DATA(8,ALPBX,0),"^",2)
+34 ; if UNITS isn't already contained in ADDITIVE NAME, add it...
+35 IF $PIECE(DATA(8,ALPBX,0),"^",3)'=""&($PIECE(DATA(8,ALPBX,0),"^",2)'[$PIECE(DATA(8,ALPBX,0),"^",3))
SET RESULTS(LINE)=RESULTS(LINE)_" "_$PIECE(DATA(8,ALPBX,0),"^",3)
+36 IF +$ORDER(DATA(8,ALPBX))
Begin DoDot:3
+37 SET LINE=LINE+1
+38 SET RESULTS(LINE)=" "
+39 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
End DoDot:3
End DoDot:2
+40 KILL ALPBX
End DoDot:1
+41 ;
+42 ; any solutions...
+43 IF +$ORDER(DATA(9,0))
Begin DoDot:1
+44 SET LINE=LINE+1
+45 SET RESULTS(LINE)="Solution Info: "
+46 SET ALPBX=0
+47 FOR
SET ALPBX=$ORDER(DATA(9,ALPBX))
IF 'ALPBX
QUIT
Begin DoDot:2
+48 SET RESULTS(LINE)=RESULTS(LINE)_$PIECE(DATA(9,ALPBX,0),"^",2)
+49 ; if UNITS isn't already contained in SOLUTION NAME, add it...
+50 IF $PIECE(DATA(9,ALPBX,0),"^",3)'=""&($PIECE(DATA(9,ALPBX,0),"^",2)'[$PIECE(DATA(9,ALPBX,0),"^",3))
SET RESULTS(LINE)=RESULTS(LINE)_" "_$PIECE(DATA(9,ALPBX,0),"^",3)
+51 IF +$ORDER(DATA(9,ALPBX))
Begin DoDot:3
+52 SET LINE=LINE+1
+53 SET RESULTS(LINE)=" "
+54 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
End DoDot:3
End DoDot:2
+55 KILL ALPBX
End DoDot:1
+56 ;
+57 ; give ($P(DATA(4),"^",1)=DOSAGE $P(DATA(4),"^",2)=ROUTE $P(DATA(4),"^",3)=SCHEDULE)...
+58 SET LINE=LINE+1
+59 SET RESULTS(LINE)=" Give: "_$PIECE($GET(DATA(4)),"^")_" "_$PIECE($GET(DATA(4)),"^",2)_" "_$PIECE($GET(DATA(4)),"^",3)
+60 ; provider, pharmacist or entry person, and verifier...
+61 SET LINE=LINE+1
+62 SET RESULTS(LINE)=" Provider: "_$PIECE($GET(DATA(2)),"^")
+63 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),43)_"RPh/Entry by: "_$PIECE($GET(DATA(2)),"^",2)
+64 IF $PIECE($GET(DATA(2)),"^",3)'=""
Begin DoDot:1
+65 SET LINE=LINE+1
+66 SET RESULTS(LINE)=" Verified by: "_$PIECE(DATA(2),"^",3)
End DoDot:1
+67 ; administration times...
+68 SET LINE=LINE+1
+69 SET RESULTS(LINE)=" Admin. Times: "_$PIECE($GET(DATA(4)),"^",4)
+70 ; provider comments, special instructions or other print info...
+71 IF +$ORDER(DATA(5,0))
Begin DoDot:1
+72 MERGE ALPBCMNT=DATA(5)
+73 DO FTEXT^ALPBFRMU(78,.ALPBCMNT,.ALPBTEXT)
+74 KILL ALPBCMNT
+75 SET ALPBX=0
+76 FOR
SET ALPBX=$ORDER(ALPBTEXT(ALPBX))
IF 'ALPBX
QUIT
Begin DoDot:2
+77 SET LINE=LINE+1
+78 SET RESULTS(LINE)=ALPBTEXT(ALPBX,0)
End DoDot:2
+79 KILL ALPBTEXT,ALPBX
End DoDot:1
+80 ; med log data...
+81 IF +$ORDER(DATA(10,0))
Begin DoDot:1
+82 SET LINE=LINE+1
+83 SET RESULTS(LINE)="BCMA Medication Log History since "_$$FMTE^XLFDT(MLDATE)
+84 SET LINE=LINE+1
+85 SET RESULTS(LINE)=" Log Date"
+86 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_"Message"
+87 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_"Log Entry Person"
+88 IF $ORDER(DATA(10,"B",MLDATE))=""
Begin DoDot:2
+89 SET LINE=LINE+1
+90 SET RESULTS(LINE)="No entries to report."
End DoDot:2
+91 SET ALPBMDT=MLDATE
+92 FOR
SET ALPBMDT=$ORDER(DATA(10,"B",ALPBMDT))
IF 'ALPBMDT
QUIT
Begin DoDot:2
+93 SET ALPBX=0
+94 FOR
SET ALPBX=$ORDER(DATA(10,"B",ALPBMDT,ALPBX))
IF 'ALPBX
QUIT
Begin DoDot:3
+95 SET LINE=LINE+1
+96 SET RESULTS(LINE)=" "_$$FDATE^ALPBUTL(ALPBMDT)
+97 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$PIECE(DATA(10,ALPBX,0),"^",3)
+98 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>")
End DoDot:3
+99 KILL ALPBX
End DoDot:2
+100 KILL ALPBMDT
End DoDot:1
+101 SET LINE=LINE+1
+102 SET RESULTS(LINE)=$$REPEAT^XLFSTR("-",80)
+103 SET RESULTS(0)=LINE
+104 QUIT
+105 ;
HDR(DATA,TYPE,PG,RESULTS) ; screen display header...
+1 ; DATA = array passed by reference containing the data record to be formatted
+2 ; TYPE = either 'A' for ALL orders or 'C' for CURRENT orders. if null, not used in construction
+3 ; of first line of returned array
+4 ; PG = page number
+5 ; RESULTS = an array passed by reference into which the formatted output will be saved
+6 ; returns RESULTS array with formatted output (note: total lines returned in RESULTS(0))
+7 NEW ALPBX,LINE
+8 IF $GET(TYPE)=""
SET TYPE="X"
+9 IF $GET(PG)=""
SET PG=0
+10 SET RESULTS(0)=0
+11 SET RESULTS(1)=$SELECT(TYPE="A":"ALL ",TYPE="C":"CURRENT ",1:"")_"ORDERS"
+12 SET RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),70)_"Page: "_$JUSTIFY(PG,3)
+13 SET RESULTS(2)=$PIECE($GET(DATA(0)),"^")
+14 SET RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),32)_"SSN: "_$PIECE($GET(DATA(0)),"^",2)
+15 SET RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),48)_"Ward: "_$PIECE($GET(DATA(0)),"^",5)
+16 SET RESULTS(3)="This record last updated: "_$SELECT($PIECE(DATA(0),"^",8)'="":$$FMTE^XLFDT($PIECE(DATA(0),"^",8)),1:"<date not on file>")
+17 SET RESULTS(3)=$$PAD^ALPBUTL(RESULTS(3),48)_"Room: "_$PIECE(DATA(0),"^",6)_" Bed: "_$PIECE(DATA(0),"^",7)
+18 SET LINE=3
+19 IF +$ORDER(DATA(1,0))
Begin DoDot:1
+20 SET LINE=LINE+1
+21 SET RESULTS(LINE)="Allergies: "
+22 SET ALPBX=0
+23 FOR
SET ALPBX=$ORDER(DATA(1,ALPBX))
IF 'ALPBX
QUIT
Begin DoDot:2
+24 SET RESULTS(LINE)=RESULTS(LINE)_$PIECE(DATA(1,ALPBX,0),"^",2)
+25 IF +$ORDER(DATA(1,ALPBX))
SET RESULTS(LINE)=RESULTS(LINE)_"; "
End DoDot:2
End DoDot:1
+26 SET LINE=LINE+1
+27 SET RESULTS(LINE)=$$REPEAT^XLFSTR("-",80)
+28 SET RESULTS(0)=LINE
+29 QUIT
