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

ALPBFRM1.m

Go to the documentation of this file. 
  1. ALPBFRM1 ;OIFO-DALLAS MW,SED,KC -STANDARD PRINT FORMATTING UTIL;01/01/03
  1.  ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
  1.  ;
  1. F132(DATA,DAYS,MLCNT,RESULTS,ALPPAT) ; format data into a 132-column
  1.  ; output array...
  1.  ; DATA = an array containing a specific order node for a selected
  1.  ;        patient in file 53.7
  1.  ; DAYS = a number that represents the number of initial boxes
  1.  ;        (1 box = 1 day) to add to lines 4-10 (max=7 -- note that
  1.  ;        this is usually a 3-day MAR, but a 7-day MAR could be
  1.  ;        returned from this format utility)
  1.  ; MLCNT = Number of Med-log entries to print with orders
  1.  ; RESULTS = an array passed by reference into which the formatted
  1.  ;           entry is set up returns a formatted array in RESULTS
  1.  ;           (note: total line count is returned at RESULTS(0))
  1.  I $D(DATA)="" Q
  1.  ;
  1.  N ALPBADM,ALPBDAYS,ALPBDRUG,ALPBIBOX,ALPBNBOX,ALPBPBOX,ALPBSTOP,ALPBTEXT,ALPBTIME,ALPBX,DATE,LINE,BOLDON,BOLDOFF,X,ALPBPRNG,ALPBFLG,ALPBPRN,ALPBMLC
  1.  ; to use BOLD, comment out the next line and remove comments from
  1.  ; the following five lines...
  1.  S BOLDON="<<",BOLDOFF=">>"
  1.  ;S X="IOINHI;IOINORM"
  1.  ;D ENDR^%ZISS
  1.  ;S BOLDON=$G(IOINHI)
  1.  ;S BOLDOFF=$G(IOINORM)
  1.  ;D KILL^%ZISS
  1.  ;
  1.  ;S MLCNT=$S(+$P($G(^ALPB(53.71,1,2)),U,4)>0:+$P(^ALPB(53.71,1,2),U,4),1:1)
  1.  I $G(DAYS)="" S DAYS=3
  1.  I DAYS>7 S DAYS=7
  1.  S DATE=$$DT^XLFDT()
  1.  D FDATES^ALPBUTL(DATE,DAYS,.ALPBDAYS)
  1.  ; get administration timing (needed for formatting various lines)
  1.  S ALPBX=$P($G(DATA(4)),"^",4)
  1.  I ALPBX="" S ALPBADM=0
  1.  I ALPBX'="" D
  1.  .S ALPBADM=0
  1.  .F I=1:1 Q:$P(ALPBX,"-",I)=""  D
  1.  ..S ALPBADM(I)=$P(ALPBX,"-",I)
  1.  ..S ALPBADM=ALPBADM+1
  1.  ; line 1...
  1.  S RESULTS(1)=""
  1.  S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),66)_"Admin"
  1.  ; line 2...
  1.  S RESULTS(2)="Start"
  1.  S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),25)_"Stop"
  1.  S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),66)_"Times"
  1.  S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),74)_ALPBDAYS(0)
  1.  I DAYS=3 S RESULTS(2)=RESULTS(2)_"   Notes"
  1.  ; line 3...
  1.  S RESULTS(3)=$$REPEAT^XLFSTR("-",132)
  1.  ; line 4...
  1.  ; start and stop date/times...
  1.  S RESULTS(4)=$S($P($G(DATA(1)),"^")'="":$$FMTE^XLFDT($P(DATA(1),"^")),1:"Not on file")
  1.  S RESULTS(4)=$$PAD^ALPBUTL(RESULTS(4),25)_$S($P($G(DATA(1)),"^",2)'="":$$FMTE^XLFDT($P(DATA(1),"^",2)),1:"Not on file")
  1.  ;
  1.  ; end of fixed line format, continue...
  1.  S LINE=4
  1.  ; get drug(s)...
  1.  I +$O(DATA(7,0)) D
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)=""
  1.  .S ALPBX=0
  1.  .F  S ALPBX=$O(DATA(7,ALPBX)) Q:'ALPBX  D
  1.  ..S ALPBDRUG=$G(BOLDON)_$P(DATA(7,ALPBX,0),"^",2)_$G(BOLDOFF)
  1.  ..;S RESULTS(LINE)=$G(RESULTS(LINE))_$P(DATA(7,ALPBX,0),"^",2)
  1.  ..S RESULTS(LINE)=$G(RESULTS(LINE))_ALPBDRUG
  1.  ..K ALPBDRUG
  1.  ..I +$O(DATA(7,ALPBX)) S LINE=LINE+1
  1.  ; any additives...
  1.  I +$O(DATA(8,0)) D
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)=" Additive(s): "
  1.  .S ALPBX=0
  1.  .F  S ALPBX=$O(DATA(8,ALPBX)) Q:'ALPBX  D
  1.  ..S ALPBDRUG=$P(DATA(8,ALPBX,0),"^",2)
  1.  ..; if UNITS is not already contained in ADDITIVE NAME, add it...
  1.  ..I $P(DATA(8,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$P(DATA(8,ALPBX,0),"^",3)) S ALPBDRUG=ALPBDRUG_" "_$P(DATA(8,ALPBX,0),"^",3)
  1.  ..S ALPBDRUG=$G(BOLDON)_ALPBDRUG_$G(BOLDOFF)
  1.  ..S RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG
  1.  ..K ALPBDRUG
  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.  ; any solutions...
  1.  I +$O(DATA(9,0)) D
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)=" Solution(s): "
  1.  .S ALPBX=0
  1.  .F  S ALPBX=$O(DATA(9,ALPBX)) Q:'ALPBX  D
  1.  ..S ALPBDRUG=$P(DATA(9,ALPBX,0),"^",2)
  1.  ..; if UNITS is not already contained in SOLUTION NAME, add it...
  1.  ..I $P(DATA(9,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$P(DATA(9,ALPBX,0),"^",3)) S ALPBDRUG=ALPBDRUG_" "_$P(DATA(9,ALPBX,0),"^",3)
  1.  ..S ALPBDRUG=$G(BOLDON)_ALPBDRUG_$G(BOLDOFF)
  1.  ..S RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG
  1.  ..K ALPBDRUG
  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.  ; 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.  ;Set PRN Flag
  1.  S ALPBPRNG=0
  1.  S:$P($G(DATA(4)),"^",3)["PRN" ALPBPRNG=1
  1.  ;
  1.  ; provider comments, special instructions, and other print info...
  1.  I +$O(DATA(5,0)) D
  1.  .K ALPBCMNT
  1.  .M ALPBCMNT=DATA(5)
  1.  .S ALPBCOL=60
  1.  .D FTEXT^ALPBFRMU(ALPBCOL,.ALPBCMNT,.ALPBTEXT)
  1.  .K ALPBCMNT
  1.  .S ALPBX=0
  1.  .F  S ALPBX=$O(ALPBTEXT(ALPBX)) Q:'ALPBX  D
  1.  ..S ALPBLINE=ALPBTEXT(ALPBX,0)
  1.  ..S LINE=LINE+1
  1.  ..S RESULTS(LINE)=ALPBLINE
  1.  .K ALPBCOL,ALPBLINE,ALPBTEXT,ALPBX
  1.  ;S LINE=LINE+1,RESULTS(LINE)=""
  1.  ;
  1.  ; provider, pharmacist or entry person, and verifier...
  1.  S LINE=LINE+1
  1.  S RESULTS(LINE)="    Provider: "_$P($G(DATA(2)),"^")
  1.  S LINE=LINE+1
  1.  S RESULTS(LINE)="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.  ; order number and type...
  1.  S LINE=LINE+1
  1.  S RESULTS(LINE)="     Order #: "_$P(DATA(0),"^")
  1.  S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),25)_"Type: "_$$OTYP^ALPBUTL($P($G(DATA(3)),"^"))
  1.  ; order status...
  1.  S LINE=LINE+1
  1.  S RESULTS(LINE)="      Status: "_$P($P(DATA(0),"^",3),"~",2)
  1.  ;
  1.  ; med log data...
  1.  S LINE=LINE+1
  1.  S RESULTS(LINE)="BCMA MEDICATION LOG HISTORY"
  1.  ;I $G(MLDATE)'="" S RESULTS(LINE)=RESULTS(LINE)_" (since "_$$FMTE^XLFDT(MLDATE)_")"
  1.  I +$O(DATA(10,0))=0 D
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)=" No Medication Log entries are on file for this order."
  1.  I +$O(DATA(10,0)) D
  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,"IMLOG",0))="" D
  1.  ..S LINE=LINE+1
  1.  ..S RESULTS(LINE)=" No entries since the above date are on file."
  1.  .;S ALPBMDT=MLDATE
  1.  .S ALPBMDT=0,ALPBMLC=1
  1.  .F  S ALPBMDT=$O(DATA(10,"IMLOG",ALPBMDT)) Q:'ALPBMDT!(ALPBMLC>MLCNT)  D
  1.  ..S ALPBX=0
  1.  ..F  S ALPBX=$O(DATA(10,"IMLOG",ALPBMDT,ALPBX)) Q:'ALPBX!(ALPBMLC>MLCNT)  D
  1.  ...S LINE=LINE+1,ALPBMLC=ALPBMLC+1
  1.  ...S RESULTS(LINE)=" "_$$FDATE^ALPBUTL($P(DATA(10,ALPBX,0),"^",1))
  1.  ...S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$P(DATA(10,ALPBX,0),"^",3)
  1.  ...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")
  1.  ..K ALPBX
  1.  .K ALPBMDT,ALPBMLC
  1.  ;
  1.  ; BCMA LAST ACTION
  1.  I +$G(ALPPAT)>0 D
  1.  .S ALPBX=0
  1.  .F  S ALPBX=$O(DATA(7,ALPBX)) Q:'ALPBX  D
  1.  ..S ALPDRUG=$P(DATA(7,ALPBX,0),"^",1),ALPBDNM=$P(DATA(7,ALPBX,0),"^",2)
  1.  ..Q:+ALPDRUG'>0
  1.  ..S ALPLACT=$$LACT^ALPBUTL3(ALPPAT,ALPDRUG)
  1.  ..I ALPLACT'="" D
  1.  ...S LINE=LINE+1,RESULTS(LINE)=$$REPEAT^XLFSTR("-",75)
  1.  ...S LINE=LINE+1
  1.  ...S RESULTS(LINE)="Last action for "_ALPBDNM_"  "_" was "_$P(ALPLACT,"^",3)_" on "_$$FDATE^ALPBUTL($P(ALPLACT,"^",1))
  1.  ...S RESULTS(LINE)=RESULTS(LINE)_" By "_$S($P(ALPLACT,"^",2)'="":$P(ALPLACT,"^",2),1:"<not on file>")
  1.  K ALPLACT,ALPDRUG,ALPBX
  1.  ;
  1.  I LINE<11 F I=1:1 Q:LINE=11  D
  1.  .S LINE=LINE+1
  1.  .S RESULTS(LINE)=""
  1.  ;
  1.  ; now add admin times and initial boxes to lines 4-10 as required
  1.  ; by number of administration times...
  1.  S ALPBIBOX="______|"
  1.  S ALPBNBOX="******|"
  1.  I +$G(ALPBADM)=0 S ALPBADM=8
  1.  ;S ALPBPRN=ALPBADM+4
  1.  S ALPBSTOP=$P($G(DATA(1)),"^",2)
  1.  F I=1:1:ALPBADM D
  1.  .S ALPBPRN=I+3
  1.  .S ALPBADMT=$G(ALPBADM(I))
  1.  .I ALPBADMT="" S ALPBADMT="    "
  1.  .I '$D(RESULTS(I+3)) D
  1.  ..S RESULTS(I+3)=" "
  1.  ..S LINE=LINE+1
  1.  .S RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
  1.  .S RESULTS(I+3)=RESULTS(I+3)_$S($L(ALPBADMT)=2:ALPBADMT_"00",1:ALPBADMT)
  1.  .S RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),74)_"|"
  1.  .F J=1:1:DAYS D
  1.  ..S ALPBDAY=ALPBDAYS(J)_"."_ALPBADMT
  1.  ..S ALPBPBOX=ALPBIBOX
  1.  ..I ALPBDAY=ALPBSTOP!(ALPBDAY>ALPBSTOP) S ALPBPBOX=ALPBNBOX
  1.  ..S RESULTS(I+3)=RESULTS(I+3)_ALPBPBOX
  1.  .K ALPBADMT,ALPBPBOX,ALPBDAY
  1.  K ALPBIBOX,ALPBNBOX
  1.  ; if PRN med, add line for documenting effectiveness...
  1.  I +ALPBPRNG D
  1.  .S ALPBFLG=0,ALPBPRN=ALPBPRN+1
  1.  .S:'$D(RESULTS(ALPBPRN)) RESULTS(ALPBPRN)=" ",ALPBFLG=1
  1.  .S RESULTS(ALPBPRN)=$$PAD^ALPBUTL(RESULTS(ALPBPRN),63)_"  PRN Effectiveness:_____________"
  1.  .S:ALPBFLG LINE=LINE+1
  1.  S LINE=LINE+1
  1.  S RESULTS(LINE)=$$REPEAT^XLFSTR("-",132)
  1.  S RESULTS(0)=LINE
  1.  Q