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 ;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
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. ;*69 move code to print Long Wp special istructions lines near end of
  1. ; a grid boundary
  1. ;*73 - add code to print Clinc Name above meds in detail lines and
  1. ; Location in heading.
  1. ;*87 - add Remove timing string to print on grid from new Db RM fld.
  1. ;*108- add display of order items that are hazardous to handle and/or
  1. ; hazardous to dispose
  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,ALPBTSTART
  1. N AD,AINDX,ALPBRM,ALPBDOA,REMTIM,ALPBNOAS,I,J ;*87,*135
  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. REMOV S ALPBRM=$P($G(DATA(4.5)),U) ;define remove string *87
  1. S ALPBDOA=$P($G(DATA(4.5)),U,2)
  1. I ALPBX'="" D ;normal admin times specified
  1. .S AINDX=$L(ALPBX,"-")+1
  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. ..;add RM times to end of admin array, also insert RM label 1st *87
  1. ..I ALPBRM]"" D
  1. ...S:I=1 ALPBADM(AINDX)="Remove ",ALPBADM=ALPBADM+1
  1. ...S ALPBADM(I+AINDX)=$P(ALPBRM,"-",I) ;I=remove tm for this admin I
  1. ...S ALPBADM=ALPBADM+1
  1. I ALPBX="",ALPBRM]"" D ;one time sched, no admin times specified
  1. .S ALPBADM(1)="Remove ",ALPBADM(2)=$P(ALPBRM,"-",1)
  1. ;
  1. ; line 1...
  1. S RESULTS(1)=""
  1. S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),2)_"Location" ;*73
  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...Clinic Name or INPATIENT ;*73
  1. S RESULTS(4)=$S($P(DATA(0),U,5)="":" INPATIENT",1:" "_$P(DATA(0),U,5)) ;*73
  1. ; line 5... ;*73
  1. ; start and stop date/times...
  1. S RESULTS(5)=$S($P($G(DATA(1)),"^")'="":$$FMTE^XLFDT($P(DATA(1),"^")),1:"Not on file") ;*73
  1. 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
  1. ;
  1. ; end of fixed line format, continue...
  1. S LINE=5 ;*73
  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. ..N HZ,TAB,SPC S HZ="" ;*108
  1. ..S $P(HZ,"|",1)=$S($G(DATA("HAZTOHAND")):"<<HAZ Handle>>",1:$J("",12)) ;*108
  1. ..I $G(DATA("HAZTODISP")) S $P(HZ,"|",2)="<<HAZ Dispose>>" ;*108
  1. ..S RESULTS(LINE)=$G(RESULTS(LINE))_ALPBDRUG
  1. ..I HZ]"" S LINE=LINE+1,RESULTS(LINE)=$J("",5)_$TR(HZ,"|"," ") ;*108
  1. ..S LINE=LINE+1,RESULTS(LINE)=$J("",66)
  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. ;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)=" 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. ...;check if log count reached
  1. ...Q:ALPBMLC>MLCNT
  1. ...;check if REMOVED action, then retrieve associated GIVEN info *87
  1. ...D:$P(DATA(10,ALPBX,0),"^",3)["REMOVED"
  1. ....Q:'$P(DATA(10,ALPBX,0),"^",5) ;in case null
  1. ....S LINE=LINE+1,ALPBMLC=ALPBMLC+1
  1. ....S RESULTS(LINE)=" "_$$FDATE^ALPBUTL($P(DATA(10,ALPBX,0),"^",5))
  1. ....S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$P(DATA(10,ALPBX,0),"^",7)
  1. ....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")
  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 ALPBTSTART=$P($G(DATA(1)),"^",1)
  1. S ALPBSTOP=$P($G(DATA(1)),"^",2)
  1. S AD=1
  1. ADMTIM F I=1:1:ALPBADM D ;build admin/remove times grid
  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. .I ALPBADMT["Remove" D
  1. ..S RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
  1. ..S AD=0
  1. .E D
  1. ..S:AD RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
  1. ..S:'AD 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 ALPBNOAS=$S(+ALPBADMT:1,ALPBPRNG:0,$$OTYP^ALPBUTL($P($G(DATA(3)),"^"))="IV":0,1:1) ;P135 PRN or IV
  1. ..I ALPBADMT=" "&ALPBNOAS S ALPBTSTART=$P($P($G(DATA(1)),"^",1),".",1),ALPBSTOP=$P($P($G(DATA(1)),"^",2),".",1) ;P135
  1. ..S ALPBDAY=+(ALPBDAYS(J)_"."_ALPBADMT) ;125 - add + to trim insignificant trailing 0's
  1. ..S ALPBPBOX=ALPBIBOX
  1. ASTER ..;prints asterisks in boxes if start date is in the future
  1. ..;and if the stop date has already expired
  1. ..I AD D ;on an admin line
  1. ...I ALPBDAY<ALPBTSTART&(ALPBNOAS) S ALPBPBOX=ALPBNBOX ;P135
  1. ...I ALPBDAY>ALPBSTOP!(ALPBDAY=ALPBSTOP) S ALPBPBOX=ALPBNBOX
  1. ..E D ;on a remove line calc orig admin for this remove time
  1. ...I ALPBDAY["Remove" S ALPBPBOX=ALPBNBOX Q ;Remove lbl line = *
  1. ...S REMTIM=$$FMADD^XLFDT(ALPBDAY,,,-ALPBDOA) ;Rem-Doa = orig admin
  1. ...I (REMTIM<ALPBTSTART)!(REMTIM>ALPBSTOP) S ALPBPBOX=ALPBNBOX
  1. ..S RESULTS(I+3)=RESULTS(I+3)_ALPBPBOX
  1. .K ALPBADMT,ALPBPBOX,ALPBDAY
  1. ENDGRID 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:_______________________________________________" ;*87 longer
  1. .S:ALPBFLG LINE=LINE+1
  1. ;
  1. ;*69 move SI text to here outside confines of grid
  1. ; provider comments, special instructions, and other print info...
  1. I +$O(DATA(5,0)) D
  1. .K ALPBTEXT M ALPBTEXT=DATA(5)
  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 ALPBLINE,ALPBTEXT,ALPBX
  1. ;
  1. S LINE=LINE+1
  1. S RESULTS(LINE)=$$REPEAT^XLFSTR("-",132)
  1. S RESULTS(0)=LINE
  1. Q