ALPBFRM2 ;OIFO-DALLAS MW,SED,KC-SCREEN DISPLAY FORMATTING UTIL ;03/06/16 3:06pm
;;3.0;BAR CODE MED ADMIN;**8,87**;Mar 2004;Build 22
;
;*87 - add Remove Times string to report
;
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)
I $P($G(DATA(4.5)),U,1)]"" D ;include new node *87
.S LINE=LINE+1
.S RESULTS(LINE)="Removal Times: "_$P($G(DATA(4.5)),"^",1)
; 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."
.;
.;begin *87 mods *87
.;bld admin and remove sorted array by time
.N LN,DAT
.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 DAT=DATA(10,ALPBX,0)
...S LN(ALPBMDT)=$P(DAT,U,3)_U_$P(DAT,U,2)
...S:$P(DAT,U,5) LN($P(DAT,U,5))=$P(DAT,U,7)_U_$P(DAT,U,6)
..K ALPBX
.;
.;bld log detail lines from sorted array and add to Results print arr
.F ALPBMDT=0:0 S ALPBMDT=$O(LN(ALPBMDT)) Q:'ALPBMDT D
..S LINE=LINE+1
..S RESULTS(LINE)=" "_$$FDATE^ALPBUTL(ALPBMDT)
..S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$P(LN(ALPBMDT),U,1)
..S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_$S($P(LN(ALPBMDT),U,2)'="":$P(LN(ALPBMDT),U,2),1:"<not on file>")
.K ALPBMDT
.;end mods *87
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBFRM2 6519 printed Oct 16, 2024@17:40:10 Page 2
ALPBFRM2 ;OIFO-DALLAS MW,SED,KC-SCREEN DISPLAY FORMATTING UTIL ;03/06/16 3:06pm
+1 ;;3.0;BAR CODE MED ADMIN;**8,87**;Mar 2004;Build 22
+2 ;
+3 ;*87 - add Remove Times string to report
+4 ;
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 ;include new node *87
IF $PIECE($GET(DATA(4.5)),U,1)]""
Begin DoDot:1
+71 SET LINE=LINE+1
+72 SET RESULTS(LINE)="Removal Times: "_$PIECE($GET(DATA(4.5)),"^",1)
End DoDot:1
+73 ; provider comments, special instructions or other print info...
+74 IF +$ORDER(DATA(5,0))
Begin DoDot:1
+75 MERGE ALPBCMNT=DATA(5)
+76 DO FTEXT^ALPBFRMU(78,.ALPBCMNT,.ALPBTEXT)
+77 KILL ALPBCMNT
+78 SET ALPBX=0
+79 FOR
SET ALPBX=$ORDER(ALPBTEXT(ALPBX))
if 'ALPBX
QUIT
Begin DoDot:2
+80 SET LINE=LINE+1
+81 SET RESULTS(LINE)=ALPBTEXT(ALPBX,0)
End DoDot:2
+82 KILL ALPBTEXT,ALPBX
End DoDot:1
+83 ; med log data...
+84 IF +$ORDER(DATA(10,0))
Begin DoDot:1
+85 SET LINE=LINE+1
+86 SET RESULTS(LINE)="BCMA Medication Log History since "_$$FMTE^XLFDT(MLDATE)
+87 SET LINE=LINE+1
+88 SET RESULTS(LINE)=" Log Date"
+89 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_"Message"
+90 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_"Log Entry Person"
+91 IF $ORDER(DATA(10,"B",MLDATE))=""
Begin DoDot:2
+92 SET LINE=LINE+1
+93 SET RESULTS(LINE)="No entries to report."
End DoDot:2
+94 ;
+95 ;begin *87 mods *87
+96 ;bld admin and remove sorted array by time
+97 NEW LN,DAT
+98 SET ALPBMDT=MLDATE
+99 FOR
SET ALPBMDT=$ORDER(DATA(10,"B",ALPBMDT))
if 'ALPBMDT
QUIT
Begin DoDot:2
+100 SET ALPBX=0
+101 FOR
SET ALPBX=$ORDER(DATA(10,"B",ALPBMDT,ALPBX))
if 'ALPBX
QUIT
Begin DoDot:3
+102 SET DAT=DATA(10,ALPBX,0)
+103 SET LN(ALPBMDT)=$PIECE(DAT,U,3)_U_$PIECE(DAT,U,2)
+104 if $PIECE(DAT,U,5)
SET LN($PIECE(DAT,U,5))=$PIECE(DAT,U,7)_U_$PIECE(DAT,U,6)
End DoDot:3
+105 KILL ALPBX
End DoDot:2
+106 ;
+107 ;bld log detail lines from sorted array and add to Results print arr
+108 FOR ALPBMDT=0:0
SET ALPBMDT=$ORDER(LN(ALPBMDT))
if 'ALPBMDT
QUIT
Begin DoDot:2
+109 SET LINE=LINE+1
+110 SET RESULTS(LINE)=" "_$$FDATE^ALPBUTL(ALPBMDT)
+111 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$PIECE(LN(ALPBMDT),U,1)
+112 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_$SELECT($PIECE(LN(ALPBMDT),U,2)'="":$PIECE(LN(ALPBMDT),U,2),1:"<not on file>")
End DoDot:2
+113 KILL ALPBMDT
+114 ;end mods *87
End DoDot:1
+115 ;
+116 SET LINE=LINE+1
+117 SET RESULTS(LINE)=$$REPEAT^XLFSTR("-",80)
+118 SET RESULTS(0)=LINE
+119 QUIT
+120 ;
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
