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

ALPBFRM2.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ;*87 - add Remove Times string to report
  1.  ;
  1. 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
  1.  ; MLDATE = a date from which med log data is retrieved
  1.  ; returns RESULTS array with formatted output (note:  total lines returned in RESULTS(0))
  1.  N ALPBCMNT,ALPBMDT,ALPBTEXT,ALPBX,LINE
  1.  S RESULTS(0)=0
  1.  S RESULTS(1)=" Order Number: "_$S($P($G(DATA(0)),"^")'="":$P(DATA(0),"^"),1:"??")
  1.  S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),50)_"Start: "
  1.  S RESULTS(1)=RESULTS(1)_$S($P($G(DATA(1)),"^")'="":$$FMTE^XLFDT($P(DATA(1),"^")),1:"<not on file>")
  1.  S RESULTS(2)="         Type: "_$$OTYP^ALPBUTL($P(DATA(3),"^"))
  1.  S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),51)_"Stop: "
  1.  S RESULTS(2)=RESULTS(2)_$S($P($G(DATA(1)),"^",2)'="":$$FMTE^XLFDT($P(DATA(1),"^",2)),1:"<not on file>")
  1.  S RESULTS(3)="       Status: "_$P($P(DATA(0),"^",3),"~",2)
  1.  S LINE=3
  1.  ; drug(s)...
  1.  I +$O(DATA(7,0)) D
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)="         Drug: "
  1.  .S ALPBX=0
  1.  .F  S ALPBX=$O(DATA(7,ALPBX)) Q:'ALPBX  D
  1.  ..S RESULTS(LINE)=$G(RESULTS(LINE))_$P(DATA(7,ALPBX,0),"^",2)
  1.  ..I +$O(DATA(7,ALPBX)) D
  1.  ...S LINE=LINE+1
  1.  ...S RESULTS(LINE)=" "
  1.  ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
  1.  .K ALPBX
  1.  ;
  1.  ; any additives...
  1.  I +$O(DATA(8,0)) D
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)="Additive Info: "
  1.  .S ALPBX=0
  1.  .F  S ALPBX=$O(DATA(8,ALPBX)) Q:'ALPBX  D
  1.  ..S RESULTS(LINE)=RESULTS(LINE)_$P(DATA(8,ALPBX,0),"^",2)
  1.  ..; if UNITS isn't already contained in ADDITIVE NAME, add it...
  1.  ..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)
  1.  ..I +$O(DATA(8,ALPBX)) D
  1.  ...S LINE=LINE+1
  1.  ...S RESULTS(LINE)=" "
  1.  ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
  1.  .K ALPBX
  1.  ;
  1.  ; any solutions...
  1.  I +$O(DATA(9,0)) D
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)="Solution Info: "
  1.  .S ALPBX=0
  1.  .F  S ALPBX=$O(DATA(9,ALPBX)) Q:'ALPBX  D
  1.  ..S RESULTS(LINE)=RESULTS(LINE)_$P(DATA(9,ALPBX,0),"^",2)
  1.  ..; if UNITS isn't already contained in SOLUTION NAME, add it...
  1.  ..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)
  1.  ..I +$O(DATA(9,ALPBX)) D
  1.  ...S LINE=LINE+1
  1.  ...S RESULTS(LINE)=" "
  1.  ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
  1.  .K ALPBX
  1.  ;
  1.  ; give ($P(DATA(4),"^",1)=DOSAGE  $P(DATA(4),"^",2)=ROUTE  $P(DATA(4),"^",3)=SCHEDULE)...
  1.  S LINE=LINE+1
  1.  S RESULTS(LINE)="         Give: "_$P($G(DATA(4)),"^")_" "_$P($G(DATA(4)),"^",2)_" "_$P($G(DATA(4)),"^",3)
  1.  ; provider, pharmacist or entry person, and verifier...
  1.  S LINE=LINE+1
  1.  S RESULTS(LINE)="     Provider: "_$P($G(DATA(2)),"^")
  1.  S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),43)_"RPh/Entry by: "_$P($G(DATA(2)),"^",2)
  1.  I $P($G(DATA(2)),"^",3)'="" D
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)="  Verified by: "_$P(DATA(2),"^",3)
  1.  ; administration times...
  1.  S LINE=LINE+1
  1.  S RESULTS(LINE)=" Admin. Times: "_$P($G(DATA(4)),"^",4)
  1.  I $P($G(DATA(4.5)),U,1)]"" D                    ;include new node *87
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)="Removal Times: "_$P($G(DATA(4.5)),"^",1)
  1.  ; provider comments, special instructions or other print info...
  1.  I +$O(DATA(5,0)) D
  1.  .M ALPBCMNT=DATA(5)
  1.  .D FTEXT^ALPBFRMU(78,.ALPBCMNT,.ALPBTEXT)
  1.  .K ALPBCMNT
  1.  .S ALPBX=0
  1.  .F  S ALPBX=$O(ALPBTEXT(ALPBX)) Q:'ALPBX  D
  1.  ..S LINE=LINE+1
  1.  ..S RESULTS(LINE)=ALPBTEXT(ALPBX,0)
  1.  .K ALPBTEXT,ALPBX
  1.  ; med log data...
  1.  I +$O(DATA(10,0)) D
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)="BCMA Medication Log History since "_$$FMTE^XLFDT(MLDATE)
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)=" Log Date"
  1.  .S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_"Message"
  1.  .S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_"Log Entry Person"
  1.  .I $O(DATA(10,"B",MLDATE))="" D
  1.  ..S LINE=LINE+1
  1.  ..S RESULTS(LINE)="No entries to report."
  1.  .;
  1.  .;begin *87 mods                                                  *87
  1.  .;bld admin and remove sorted array by time
  1.  .N LN,DAT
  1.  .S ALPBMDT=MLDATE
  1.  .F  S ALPBMDT=$O(DATA(10,"B",ALPBMDT)) Q:'ALPBMDT  D
  1.  ..S ALPBX=0
  1.  ..F  S ALPBX=$O(DATA(10,"B",ALPBMDT,ALPBX)) Q:'ALPBX  D
  1.  ...S DAT=DATA(10,ALPBX,0)
  1.  ...S LN(ALPBMDT)=$P(DAT,U,3)_U_$P(DAT,U,2)
  1.  ...S:$P(DAT,U,5) LN($P(DAT,U,5))=$P(DAT,U,7)_U_$P(DAT,U,6)
  1.  ..K ALPBX
  1.  .;
  1.  .;bld log detail lines from sorted array and add to Results print arr
  1.  .F ALPBMDT=0:0 S ALPBMDT=$O(LN(ALPBMDT)) Q:'ALPBMDT  D
  1.  ..S LINE=LINE+1
  1.  ..S RESULTS(LINE)=" "_$$FDATE^ALPBUTL(ALPBMDT)
  1.  ..S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$P(LN(ALPBMDT),U,1)
  1.  ..S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_$S($P(LN(ALPBMDT),U,2)'="":$P(LN(ALPBMDT),U,2),1:"<not on file>")
  1.  .K ALPBMDT
  1.  .;end mods                                                        *87
  1.  ;
  1.  S LINE=LINE+1
  1.  S RESULTS(LINE)=$$REPEAT^XLFSTR("-",80)
  1.  S RESULTS(0)=LINE
  1.  Q
  1.  ;
  1. HDR(DATA,TYPE,PG,RESULTS) ; screen display header...
  1.  ; DATA = array passed by reference containing the data record to be formatted
  1.  ; TYPE = either 'A' for ALL orders or 'C' for CURRENT orders.  if null, not used in construction
  1.  ;        of first line of returned array
  1.  ; PG   = page number
  1.  ; RESULTS = an array passed by reference into which the formatted output will be saved
  1.  ; returns RESULTS array with formatted output (note:  total lines returned in RESULTS(0))
  1.  N ALPBX,LINE
  1.  I $G(TYPE)="" S TYPE="X"
  1.  I $G(PG)="" S PG=0
  1.  S RESULTS(0)=0
  1.  S RESULTS(1)=$S(TYPE="A":"ALL ",TYPE="C":"CURRENT ",1:"")_"ORDERS"
  1.  S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),70)_"Page: "_$J(PG,3)
  1.  S RESULTS(2)=$P($G(DATA(0)),"^")
  1.  S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),32)_"SSN: "_$P($G(DATA(0)),"^",2)
  1.  S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),48)_"Ward: "_$P($G(DATA(0)),"^",5)
  1.  S RESULTS(3)="This record last updated: "_$S($P(DATA(0),"^",8)'="":$$FMTE^XLFDT($P(DATA(0),"^",8)),1:"<date not on file>")
  1.  S RESULTS(3)=$$PAD^ALPBUTL(RESULTS(3),48)_"Room: "_$P(DATA(0),"^",6)_" Bed: "_$P(DATA(0),"^",7)
  1.  S LINE=3
  1.  I +$O(DATA(1,0)) D
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)="Allergies: "
  1.  .S ALPBX=0
  1.  .F  S ALPBX=$O(DATA(1,ALPBX)) Q:'ALPBX  D
  1.  ..S RESULTS(LINE)=RESULTS(LINE)_$P(DATA(1,ALPBX,0),"^",2)
  1.  ..I +$O(DATA(1,ALPBX)) S RESULTS(LINE)=RESULTS(LINE)_"; "
  1.  S LINE=LINE+1
  1.  S RESULTS(LINE)=$$REPEAT^XLFSTR("-",80)
  1.  S RESULTS(0)=LINE
  1.  Q