- ALPBFRM1 ;DAL/SED -STANDARD PRINT FORMATTING UTIL ;Feb 6, 2021@15:27
- ;;3.0;BAR CODE MED ADMIN;**8,48,69,59,73,87,125,108,135**;Mar 2004;Build 5
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ;*69 move code to print Long Wp special istructions lines near end of
- ; a grid boundary
- ;*73 - add code to print Clinc Name above meds in detail lines and
- ; Location in heading.
- ;*87 - add Remove timing string to print on grid from new Db RM fld.
- ;*108- add display of order items that are hazardous to handle and/or
- ; hazardous to dispose
- ;
- F132(DATA,DAYS,MLCNT,RESULTS,ALPPAT) ; format data into a 132-column
- ; output array...
- ; DATA = an array containing a specific order node for a selected
- ; patient in file 53.7
- ; DAYS = a number that represents the number of initial boxes
- ; (1 box = 1 day) to add to lines 4-10 (max=7 -- note that
- ; this is usually a 3-day MAR, but a 7-day MAR could be
- ; returned from this format utility)
- ; MLCNT = Number of Med-log entries to print with orders
- ; RESULTS = an array passed by reference into which the formatted
- ; entry is set up returns a formatted array in RESULTS
- ; (note: total line count is returned at RESULTS(0))
- I $D(DATA)="" Q
- ;
- N ALPBADM,ALPBDAYS,ALPBDRUG,ALPBIBOX,ALPBNBOX,ALPBPBOX,ALPBSTOP,ALPBTEXT,ALPBTIME,ALPBX,DATE,LINE,BOLDON,BOLDOFF,X,ALPBPRNG,ALPBFLG,ALPBPRN,ALPBMLC,ALPBTSTART
- N AD,AINDX,ALPBRM,ALPBDOA,REMTIM,ALPBNOAS,I,J ;*87,*135
- ; to use BOLD, comment out the next line and remove comments from
- ; the following five lines...
- S BOLDON="<<",BOLDOFF=">>"
- ;S X="IOINHI;IOINORM"
- ;D ENDR^%ZISS
- ;S BOLDON=$G(IOINHI)
- ;S BOLDOFF=$G(IOINORM)
- ;D KILL^%ZISS
- ;
- ;S MLCNT=$S(+$P($G(^ALPB(53.71,1,2)),U,4)>0:+$P(^ALPB(53.71,1,2),U,4),1:1)
- I $G(DAYS)="" S DAYS=3
- I DAYS>7 S DAYS=7
- S DATE=$$DT^XLFDT()
- D FDATES^ALPBUTL(DATE,DAYS,.ALPBDAYS)
- ; get administration timing (needed for formatting various lines)
- S ALPBX=$P($G(DATA(4)),"^",4)
- I ALPBX="" S ALPBADM=0
- REMOV S ALPBRM=$P($G(DATA(4.5)),U) ;define remove string *87
- S ALPBDOA=$P($G(DATA(4.5)),U,2)
- I ALPBX'="" D ;normal admin times specified
- .S AINDX=$L(ALPBX,"-")+1
- .S ALPBADM=0
- .F I=1:1 Q:$P(ALPBX,"-",I)="" D
- ..S ALPBADM(I)=$P(ALPBX,"-",I)
- ..S ALPBADM=ALPBADM+1
- ..;add RM times to end of admin array, also insert RM label 1st *87
- ..I ALPBRM]"" D
- ...S:I=1 ALPBADM(AINDX)="Remove ",ALPBADM=ALPBADM+1
- ...S ALPBADM(I+AINDX)=$P(ALPBRM,"-",I) ;I=remove tm for this admin I
- ...S ALPBADM=ALPBADM+1
- I ALPBX="",ALPBRM]"" D ;one time sched, no admin times specified
- .S ALPBADM(1)="Remove ",ALPBADM(2)=$P(ALPBRM,"-",1)
- ;
- ; line 1...
- S RESULTS(1)=""
- S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),2)_"Location" ;*73
- S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),66)_"Admin"
- ; line 2...
- S RESULTS(2)="Start"
- S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),25)_"Stop"
- S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),66)_"Times"
- S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),74)_ALPBDAYS(0)
- I DAYS=3 S RESULTS(2)=RESULTS(2)_" Notes"
- ; line 3...
- S RESULTS(3)=$$REPEAT^XLFSTR("-",132)
- ; line 4...Clinic Name or INPATIENT ;*73
- S RESULTS(4)=$S($P(DATA(0),U,5)="":" INPATIENT",1:" "_$P(DATA(0),U,5)) ;*73
- ; line 5... ;*73
- ; start and stop date/times...
- S RESULTS(5)=$S($P($G(DATA(1)),"^")'="":$$FMTE^XLFDT($P(DATA(1),"^")),1:"Not on file") ;*73
- 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
- ;
- ; end of fixed line format, continue...
- S LINE=5 ;*73
- ; get drug(s)...
- I +$O(DATA(7,0)) D
- .S LINE=LINE+1
- .S RESULTS(LINE)=""
- .S ALPBX=0
- .F S ALPBX=$O(DATA(7,ALPBX)) Q:'ALPBX D
- ..S ALPBDRUG=$G(BOLDON)_$P(DATA(7,ALPBX,0),"^",2)_$G(BOLDOFF)
- ..;S RESULTS(LINE)=$G(RESULTS(LINE))_$P(DATA(7,ALPBX,0),"^",2)
- ..N HZ,TAB,SPC S HZ="" ;*108
- ..S $P(HZ,"|",1)=$S($G(DATA("HAZTOHAND")):"<<HAZ Handle>>",1:$J("",12)) ;*108
- ..I $G(DATA("HAZTODISP")) S $P(HZ,"|",2)="<<HAZ Dispose>>" ;*108
- ..S RESULTS(LINE)=$G(RESULTS(LINE))_ALPBDRUG
- ..I HZ]"" S LINE=LINE+1,RESULTS(LINE)=$J("",5)_$TR(HZ,"|"," ") ;*108
- ..S LINE=LINE+1,RESULTS(LINE)=$J("",66)
- ..K ALPBDRUG
- ..I +$O(DATA(7,ALPBX)) S LINE=LINE+1
- ; any additives...
- I +$O(DATA(8,0)) D
- .S LINE=LINE+1
- .S RESULTS(LINE)=" Additive(s): "
- .S ALPBX=0
- .F S ALPBX=$O(DATA(8,ALPBX)) Q:'ALPBX D
- ..S ALPBDRUG=$P(DATA(8,ALPBX,0),"^",2)
- ..; if UNITS is not already contained in ADDITIVE NAME, add it...
- ..I $P(DATA(8,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$P(DATA(8,ALPBX,0),"^",3)) S ALPBDRUG=ALPBDRUG_" "_$P(DATA(8,ALPBX,0),"^",3)
- ..S ALPBDRUG=$G(BOLDON)_ALPBDRUG_$G(BOLDOFF)
- ..S RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG
- ..K ALPBDRUG
- ..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(s): "
- .S ALPBX=0
- .F S ALPBX=$O(DATA(9,ALPBX)) Q:'ALPBX D
- ..S ALPBDRUG=$P(DATA(9,ALPBX,0),"^",2)
- ..; if UNITS is not already contained in SOLUTION NAME, add it...
- ..I $P(DATA(9,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$P(DATA(9,ALPBX,0),"^",3)) S ALPBDRUG=ALPBDRUG_" "_$P(DATA(9,ALPBX,0),"^",3)
- ..S ALPBDRUG=$G(BOLDON)_ALPBDRUG_$G(BOLDOFF)
- ..S RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG
- ..K ALPBDRUG
- ..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)
- ;Set PRN Flag
- S ALPBPRNG=0
- S:$P($G(DATA(4)),"^",3)["PRN" ALPBPRNG=1
- ;
- ;S LINE=LINE+1,RESULTS(LINE)=""
- ;
- ; provider, pharmacist or entry person, and verifier...
- S LINE=LINE+1
- S RESULTS(LINE)=" Provider: "_$P($G(DATA(2)),"^")
- S LINE=LINE+1
- S RESULTS(LINE)="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)
- ; order number and type...
- S LINE=LINE+1
- S RESULTS(LINE)=" Type: "_$$OTYP^ALPBUTL($P($G(DATA(3)),"^"))
- ; order status...
- S LINE=LINE+1
- S RESULTS(LINE)=" Status: "_$P($P(DATA(0),"^",3),"~",2)
- ;
- ; med log data...
- S LINE=LINE+1
- S RESULTS(LINE)="BCMA MEDICATION LOG HISTORY"
- ;I $G(MLDATE)'="" S RESULTS(LINE)=RESULTS(LINE)_" (since "_$$FMTE^XLFDT(MLDATE)_")"
- I +$O(DATA(10,0))=0 D
- .S LINE=LINE+1
- .S RESULTS(LINE)=" No Medication Log entries are on file for this order."
- I +$O(DATA(10,0)) D
- .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,"IMLOG",0))="" D
- ..S LINE=LINE+1
- ..S RESULTS(LINE)=" No entries since the above date are on file."
- .;S ALPBMDT=MLDATE
- .S ALPBMDT=0,ALPBMLC=1
- .F S ALPBMDT=$O(DATA(10,"IMLOG",ALPBMDT)) Q:'ALPBMDT!(ALPBMLC>MLCNT) D
- ..S ALPBX=0
- ..F S ALPBX=$O(DATA(10,"IMLOG",ALPBMDT,ALPBX)) Q:'ALPBX!(ALPBMLC>MLCNT) D
- ...S LINE=LINE+1,ALPBMLC=ALPBMLC+1
- ...S RESULTS(LINE)=" "_$$FDATE^ALPBUTL($P(DATA(10,ALPBX,0),"^",1))
- ...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")
- ...;check if log count reached
- ...Q:ALPBMLC>MLCNT
- ...;check if REMOVED action, then retrieve associated GIVEN info *87
- ...D:$P(DATA(10,ALPBX,0),"^",3)["REMOVED"
- ....Q:'$P(DATA(10,ALPBX,0),"^",5) ;in case null
- ....S LINE=LINE+1,ALPBMLC=ALPBMLC+1
- ....S RESULTS(LINE)=" "_$$FDATE^ALPBUTL($P(DATA(10,ALPBX,0),"^",5))
- ....S RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$P(DATA(10,ALPBX,0),"^",7)
- ....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")
- ..K ALPBX
- .K ALPBMDT,ALPBMLC
- ;
- ; BCMA LAST ACTION
- I +$G(ALPPAT)>0 D
- .S ALPBX=0
- .F S ALPBX=$O(DATA(7,ALPBX)) Q:'ALPBX D
- ..S ALPDRUG=$P(DATA(7,ALPBX,0),"^",1),ALPBDNM=$P(DATA(7,ALPBX,0),"^",2)
- ..Q:+ALPDRUG'>0
- ..S ALPLACT=$$LACT^ALPBUTL3(ALPPAT,ALPDRUG)
- ..I ALPLACT'="" D
- ...S LINE=LINE+1,RESULTS(LINE)=$$REPEAT^XLFSTR("-",75)
- ...S LINE=LINE+1
- ...S RESULTS(LINE)="Last action for "_ALPBDNM_" "_" was "_$P(ALPLACT,"^",3)_" on "_$$FDATE^ALPBUTL($P(ALPLACT,"^",1))
- ...S RESULTS(LINE)=RESULTS(LINE)_" By "_$S($P(ALPLACT,"^",2)'="":$P(ALPLACT,"^",2),1:"<not on file>")
- K ALPLACT,ALPDRUG,ALPBX
- ;
- I LINE<11 F I=1:1 Q:LINE=11 D
- .S LINE=LINE+1
- .S RESULTS(LINE)=""
- ;
- ; now add admin times and initial boxes to lines 4-10 as required
- ; by number of administration times...
- S ALPBIBOX="______|"
- S ALPBNBOX="******|"
- I +$G(ALPBADM)=0 S ALPBADM=8
- ;S ALPBPRN=ALPBADM+4
- S ALPBTSTART=$P($G(DATA(1)),"^",1)
- S ALPBSTOP=$P($G(DATA(1)),"^",2)
- S AD=1
- ADMTIM F I=1:1:ALPBADM D ;build admin/remove times grid
- .S ALPBPRN=I+3
- .S ALPBADMT=$G(ALPBADM(I))
- .I ALPBADMT="" S ALPBADMT=" "
- .I '$D(RESULTS(I+3)) D
- ..S RESULTS(I+3)=" "
- ..S LINE=LINE+1
- .I ALPBADMT["Remove" D
- ..S RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
- ..S AD=0
- .E D
- ..S:AD RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
- ..S:'AD RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
- .S RESULTS(I+3)=RESULTS(I+3)_$S($L(ALPBADMT)=2:ALPBADMT_"00",1:ALPBADMT)
- .S RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),74)_"|"
- .F J=1:1:DAYS D
- ..S ALPBNOAS=$S(+ALPBADMT:1,ALPBPRNG:0,$$OTYP^ALPBUTL($P($G(DATA(3)),"^"))="IV":0,1:1) ;P135 PRN or IV
- ..I ALPBADMT=" "&ALPBNOAS S ALPBTSTART=$P($P($G(DATA(1)),"^",1),".",1),ALPBSTOP=$P($P($G(DATA(1)),"^",2),".",1) ;P135
- ..S ALPBDAY=+(ALPBDAYS(J)_"."_ALPBADMT) ;125 - add + to trim insignificant trailing 0's
- ..S ALPBPBOX=ALPBIBOX
- ASTER ..;prints asterisks in boxes if start date is in the future
- ..;and if the stop date has already expired
- ..I AD D ;on an admin line
- ...I ALPBDAY<ALPBTSTART&(ALPBNOAS) S ALPBPBOX=ALPBNBOX ;P135
- ...I ALPBDAY>ALPBSTOP!(ALPBDAY=ALPBSTOP) S ALPBPBOX=ALPBNBOX
- ..E D ;on a remove line calc orig admin for this remove time
- ...I ALPBDAY["Remove" S ALPBPBOX=ALPBNBOX Q ;Remove lbl line = *
- ...S REMTIM=$$FMADD^XLFDT(ALPBDAY,,,-ALPBDOA) ;Rem-Doa = orig admin
- ...I (REMTIM<ALPBTSTART)!(REMTIM>ALPBSTOP) S ALPBPBOX=ALPBNBOX
- ..S RESULTS(I+3)=RESULTS(I+3)_ALPBPBOX
- .K ALPBADMT,ALPBPBOX,ALPBDAY
- ENDGRID K ALPBIBOX,ALPBNBOX
- ; if PRN med, add line for documenting effectiveness...
- I +ALPBPRNG D
- .S ALPBFLG=0,ALPBPRN=ALPBPRN+1
- .S:'$D(RESULTS(ALPBPRN)) RESULTS(ALPBPRN)=" ",ALPBFLG=1
- .S RESULTS(ALPBPRN)=$$PAD^ALPBUTL(RESULTS(ALPBPRN),63)_" PRN Effectiveness:_______________________________________________" ;*87 longer
- .S:ALPBFLG LINE=LINE+1
- ;
- ;*69 move SI text to here outside confines of grid
- ; provider comments, special instructions, and other print info...
- I +$O(DATA(5,0)) D
- .K ALPBTEXT M ALPBTEXT=DATA(5)
- .S ALPBX=0
- .F S ALPBX=$O(ALPBTEXT(ALPBX)) Q:'ALPBX D
- ..S ALPBLINE=ALPBTEXT(ALPBX,0)
- ..S LINE=LINE+1
- ..S RESULTS(LINE)=ALPBLINE
- .K ALPBLINE,ALPBTEXT,ALPBX
- ;
- S LINE=LINE+1
- S RESULTS(LINE)=$$REPEAT^XLFSTR("-",132)
- S RESULTS(0)=LINE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBFRM1 11630 printed Feb 18, 2025@23:05:41 Page 2
- 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
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ;*69 move code to print Long Wp special istructions lines near end of
- +5 ; a grid boundary
- +6 ;*73 - add code to print Clinc Name above meds in detail lines and
- +7 ; Location in heading.
- +8 ;*87 - add Remove timing string to print on grid from new Db RM fld.
- +9 ;*108- add display of order items that are hazardous to handle and/or
- +10 ; hazardous to dispose
- +11 ;
- F132(DATA,DAYS,MLCNT,RESULTS,ALPPAT) ; format data into a 132-column
- +1 ; output array...
- +2 ; DATA = an array containing a specific order node for a selected
- +3 ; patient in file 53.7
- +4 ; DAYS = a number that represents the number of initial boxes
- +5 ; (1 box = 1 day) to add to lines 4-10 (max=7 -- note that
- +6 ; this is usually a 3-day MAR, but a 7-day MAR could be
- +7 ; returned from this format utility)
- +8 ; MLCNT = Number of Med-log entries to print with orders
- +9 ; RESULTS = an array passed by reference into which the formatted
- +10 ; entry is set up returns a formatted array in RESULTS
- +11 ; (note: total line count is returned at RESULTS(0))
- +12 IF $DATA(DATA)=""
- QUIT
- +13 ;
- +14 NEW ALPBADM,ALPBDAYS,ALPBDRUG,ALPBIBOX,ALPBNBOX,ALPBPBOX,ALPBSTOP,ALPBTEXT,ALPBTIME,ALPBX,DATE,LINE,BOLDON,BOLDOFF,X,ALPBPRNG,ALPBFLG,ALPBPRN,ALPBMLC,ALPBTSTART
- +15 ;*87,*135
- NEW AD,AINDX,ALPBRM,ALPBDOA,REMTIM,ALPBNOAS,I,J
- +16 ; to use BOLD, comment out the next line and remove comments from
- +17 ; the following five lines...
- +18 SET BOLDON="<<"
- SET BOLDOFF=">>"
- +19 ;S X="IOINHI;IOINORM"
- +20 ;D ENDR^%ZISS
- +21 ;S BOLDON=$G(IOINHI)
- +22 ;S BOLDOFF=$G(IOINORM)
- +23 ;D KILL^%ZISS
- +24 ;
- +25 ;S MLCNT=$S(+$P($G(^ALPB(53.71,1,2)),U,4)>0:+$P(^ALPB(53.71,1,2),U,4),1:1)
- +26 IF $GET(DAYS)=""
- SET DAYS=3
- +27 IF DAYS>7
- SET DAYS=7
- +28 SET DATE=$$DT^XLFDT()
- +29 DO FDATES^ALPBUTL(DATE,DAYS,.ALPBDAYS)
- +30 ; get administration timing (needed for formatting various lines)
- +31 SET ALPBX=$PIECE($GET(DATA(4)),"^",4)
- +32 IF ALPBX=""
- SET ALPBADM=0
- REMOV ;define remove string *87
- SET ALPBRM=$PIECE($GET(DATA(4.5)),U)
- +1 SET ALPBDOA=$PIECE($GET(DATA(4.5)),U,2)
- +2 ;normal admin times specified
- IF ALPBX'=""
- Begin DoDot:1
- +3 SET AINDX=$LENGTH(ALPBX,"-")+1
- +4 SET ALPBADM=0
- +5 FOR I=1:1
- if $PIECE(ALPBX,"-",I)=""
- QUIT
- Begin DoDot:2
- +6 SET ALPBADM(I)=$PIECE(ALPBX,"-",I)
- +7 SET ALPBADM=ALPBADM+1
- +8 ;add RM times to end of admin array, also insert RM label 1st *87
- +9 IF ALPBRM]""
- Begin DoDot:3
- +10 if I=1
- SET ALPBADM(AINDX)="Remove "
- SET ALPBADM=ALPBADM+1
- +11 ;I=remove tm for this admin I
- SET ALPBADM(I+AINDX)=$PIECE(ALPBRM,"-",I)
- +12 SET ALPBADM=ALPBADM+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +13 ;one time sched, no admin times specified
- IF ALPBX=""
- IF ALPBRM]""
- Begin DoDot:1
- +14 SET ALPBADM(1)="Remove "
- SET ALPBADM(2)=$PIECE(ALPBRM,"-",1)
- End DoDot:1
- +15 ;
- +16 ; line 1...
- +17 SET RESULTS(1)=""
- +18 ;*73
- SET RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),2)_"Location"
- +19 SET RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),66)_"Admin"
- +20 ; line 2...
- +21 SET RESULTS(2)="Start"
- +22 SET RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),25)_"Stop"
- +23 SET RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),66)_"Times"
- +24 SET RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),74)_ALPBDAYS(0)
- +25 IF DAYS=3
- SET RESULTS(2)=RESULTS(2)_" Notes"
- +26 ; line 3...
- +27 SET RESULTS(3)=$$REPEAT^XLFSTR("-",132)
- +28 ; line 4...Clinic Name or INPATIENT ;*73
- +29 ;*73
- SET RESULTS(4)=$SELECT($PIECE(DATA(0),U,5)="":" INPATIENT",1:" "_$PIECE(DATA(0),U,5))
- +30 ; line 5... ;*73
- +31 ; start and stop date/times...
- +32 ;*73
- SET RESULTS(5)=$SELECT($PIECE($GET(DATA(1)),"^")'="":$$FMTE^XLFDT($PIECE(DATA(1),"^")),1:"Not on file")
- +33 ;73
- SET RESULTS(5)=$$PAD^ALPBUTL(RESULTS(5),25)_$SELECT($PIECE($GET(DATA(1)),"^",2)'="":$$FMTE^XLFDT($PIECE(DATA(1),"^",2)),1:"Not on file")
- +34 ;
- +35 ; end of fixed line format, continue...
- +36 ;*73
- SET LINE=5
- +37 ; get drug(s)...
- +38 IF +$ORDER(DATA(7,0))
- Begin DoDot:1
- +39 SET LINE=LINE+1
- +40 SET RESULTS(LINE)=""
- +41 SET ALPBX=0
- +42 FOR
- SET ALPBX=$ORDER(DATA(7,ALPBX))
- if 'ALPBX
- QUIT
- Begin DoDot:2
- +43 SET ALPBDRUG=$GET(BOLDON)_$PIECE(DATA(7,ALPBX,0),"^",2)_$GET(BOLDOFF)
- +44 ;S RESULTS(LINE)=$G(RESULTS(LINE))_$P(DATA(7,ALPBX,0),"^",2)
- +45 ;*108
- NEW HZ,TAB,SPC
- SET HZ=""
- +46 ;*108
- SET $PIECE(HZ,"|",1)=$SELECT($GET(DATA("HAZTOHAND")):"<<HAZ Handle>>",1:$JUSTIFY("",12))
- +47 ;*108
- IF $GET(DATA("HAZTODISP"))
- SET $PIECE(HZ,"|",2)="<<HAZ Dispose>>"
- +48 SET RESULTS(LINE)=$GET(RESULTS(LINE))_ALPBDRUG
- +49 ;*108
- IF HZ]""
- SET LINE=LINE+1
- SET RESULTS(LINE)=$JUSTIFY("",5)_$TRANSLATE(HZ,"|"," ")
- +50 SET LINE=LINE+1
- SET RESULTS(LINE)=$JUSTIFY("",66)
- +51 KILL ALPBDRUG
- +52 IF +$ORDER(DATA(7,ALPBX))
- SET LINE=LINE+1
- End DoDot:2
- End DoDot:1
- +53 ; any additives...
- +54 IF +$ORDER(DATA(8,0))
- Begin DoDot:1
- +55 SET LINE=LINE+1
- +56 SET RESULTS(LINE)=" Additive(s): "
- +57 SET ALPBX=0
- +58 FOR
- SET ALPBX=$ORDER(DATA(8,ALPBX))
- if 'ALPBX
- QUIT
- Begin DoDot:2
- +59 SET ALPBDRUG=$PIECE(DATA(8,ALPBX,0),"^",2)
- +60 ; if UNITS is not already contained in ADDITIVE NAME, add it...
- +61 IF $PIECE(DATA(8,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$PIECE(DATA(8,ALPBX,0),"^",3))
- SET ALPBDRUG=ALPBDRUG_" "_$PIECE(DATA(8,ALPBX,0),"^",3)
- +62 SET ALPBDRUG=$GET(BOLDON)_ALPBDRUG_$GET(BOLDOFF)
- +63 SET RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG
- +64 KILL ALPBDRUG
- +65 IF +$ORDER(DATA(8,ALPBX))
- Begin DoDot:3
- +66 SET LINE=LINE+1
- +67 SET RESULTS(LINE)=" "
- +68 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
- End DoDot:3
- End DoDot:2
- +69 KILL ALPBX
- End DoDot:1
- +70 ; any solutions...
- +71 IF +$ORDER(DATA(9,0))
- Begin DoDot:1
- +72 SET LINE=LINE+1
- +73 SET RESULTS(LINE)=" Solution(s): "
- +74 SET ALPBX=0
- +75 FOR
- SET ALPBX=$ORDER(DATA(9,ALPBX))
- if 'ALPBX
- QUIT
- Begin DoDot:2
- +76 SET ALPBDRUG=$PIECE(DATA(9,ALPBX,0),"^",2)
- +77 ; if UNITS is not already contained in SOLUTION NAME, add it...
- +78 IF $PIECE(DATA(9,ALPBX,0),"^",3)'=""&(ALPBDRUG'[$PIECE(DATA(9,ALPBX,0),"^",3))
- SET ALPBDRUG=ALPBDRUG_" "_$PIECE(DATA(9,ALPBX,0),"^",3)
- +79 SET ALPBDRUG=$GET(BOLDON)_ALPBDRUG_$GET(BOLDOFF)
- +80 SET RESULTS(LINE)=RESULTS(LINE)_ALPBDRUG
- +81 KILL ALPBDRUG
- +82 IF +$ORDER(DATA(9,ALPBX))
- Begin DoDot:3
- +83 SET LINE=LINE+1
- +84 SET RESULTS(LINE)=" "
- +85 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),14)
- End DoDot:3
- End DoDot:2
- +86 KILL ALPBX
- End DoDot:1
- +87 ; give ($P(DATA(4),"^",1)=DOSAGE $P(DATA(4),"^",2)=ROUTE $P(DATA(4),"^",3)=SCHEDULE)...
- +88 SET LINE=LINE+1
- +89 SET RESULTS(LINE)=" Give: "_$PIECE($GET(DATA(4)),"^")_" "_$PIECE($GET(DATA(4)),"^",2)_" "_$PIECE($GET(DATA(4)),"^",3)
- +90 ;Set PRN Flag
- +91 SET ALPBPRNG=0
- +92 if $PIECE($GET(DATA(4)),"^",3)["PRN"
- SET ALPBPRNG=1
- +93 ;
- +94 ;S LINE=LINE+1,RESULTS(LINE)=""
- +95 ;
- +96 ; provider, pharmacist or entry person, and verifier...
- +97 SET LINE=LINE+1
- +98 SET RESULTS(LINE)=" Provider: "_$PIECE($GET(DATA(2)),"^")
- +99 SET LINE=LINE+1
- +100 SET RESULTS(LINE)="RPh/Entry by: "_$PIECE($GET(DATA(2)),"^",2)
- +101 IF $PIECE($GET(DATA(2)),"^",3)'=""
- Begin DoDot:1
- +102 SET LINE=LINE+1
- +103 SET RESULTS(LINE)=" Verified by: "_$PIECE(DATA(2),"^",3)
- End DoDot:1
- +104 ; order number and type...
- +105 SET LINE=LINE+1
- +106 SET RESULTS(LINE)=" Type: "_$$OTYP^ALPBUTL($PIECE($GET(DATA(3)),"^"))
- +107 ; order status...
- +108 SET LINE=LINE+1
- +109 SET RESULTS(LINE)=" Status: "_$PIECE($PIECE(DATA(0),"^",3),"~",2)
- +110 ;
- +111 ; med log data...
- +112 SET LINE=LINE+1
- +113 SET RESULTS(LINE)="BCMA MEDICATION LOG HISTORY"
- +114 ;I $G(MLDATE)'="" S RESULTS(LINE)=RESULTS(LINE)_" (since "_$$FMTE^XLFDT(MLDATE)_")"
- +115 IF +$ORDER(DATA(10,0))=0
- Begin DoDot:1
- +116 SET LINE=LINE+1
- +117 SET RESULTS(LINE)=" No Medication Log entries are on file for this order."
- End DoDot:1
- +118 IF +$ORDER(DATA(10,0))
- Begin DoDot:1
- +119 SET LINE=LINE+1
- +120 SET RESULTS(LINE)=" Log Date"
- +121 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_"Message"
- +122 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_"Log Entry Person"
- +123 IF $ORDER(DATA(10,"IMLOG",0))=""
- Begin DoDot:2
- +124 SET LINE=LINE+1
- +125 SET RESULTS(LINE)=" No entries since the above date are on file."
- End DoDot:2
- +126 ;S ALPBMDT=MLDATE
- +127 SET ALPBMDT=0
- SET ALPBMLC=1
- +128 FOR
- SET ALPBMDT=$ORDER(DATA(10,"IMLOG",ALPBMDT))
- if 'ALPBMDT!(ALPBMLC>MLCNT)
- QUIT
- Begin DoDot:2
- +129 SET ALPBX=0
- +130 FOR
- SET ALPBX=$ORDER(DATA(10,"IMLOG",ALPBMDT,ALPBX))
- if 'ALPBX!(ALPBMLC>MLCNT)
- QUIT
- Begin DoDot:3
- +131 SET LINE=LINE+1
- SET ALPBMLC=ALPBMLC+1
- +132 SET RESULTS(LINE)=" "_$$FDATE^ALPBUTL($PIECE(DATA(10,ALPBX,0),"^",1))
- +133 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$PIECE(DATA(10,ALPBX,0),"^",3)
- +134 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")
- +135 ;check if log count reached
- +136 if ALPBMLC>MLCNT
- QUIT
- +137 ;check if REMOVED action, then retrieve associated GIVEN info *87
- +138 if $PIECE(DATA(10,ALPBX,0),"^",3)["REMOVED"
- Begin DoDot:4
- +139 ;in case null
- if '$PIECE(DATA(10,ALPBX,0),"^",5)
- QUIT
- +140 SET LINE=LINE+1
- SET ALPBMLC=ALPBMLC+1
- +141 SET RESULTS(LINE)=" "_$$FDATE^ALPBUTL($PIECE(DATA(10,ALPBX,0),"^",5))
- +142 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),16)_$PIECE(DATA(10,ALPBX,0),"^",7)
- +143 SET RESULTS(LINE)=$$PAD^ALPBUTL(RESULTS(LINE),31)_$SELECT($PIECE(DATA(10,ALPBX,0),"^",6)'="":$PIECE(DATA(10,ALPBX,0),"^",6),1:"<not on file")
- End DoDot:4
- End DoDot:3
- +144 KILL ALPBX
- End DoDot:2
- +145 KILL ALPBMDT,ALPBMLC
- End DoDot:1
- +146 ;
- +147 ; BCMA LAST ACTION
- +148 IF +$GET(ALPPAT)>0
- Begin DoDot:1
- +149 SET ALPBX=0
- +150 FOR
- SET ALPBX=$ORDER(DATA(7,ALPBX))
- if 'ALPBX
- QUIT
- Begin DoDot:2
- +151 SET ALPDRUG=$PIECE(DATA(7,ALPBX,0),"^",1)
- SET ALPBDNM=$PIECE(DATA(7,ALPBX,0),"^",2)
- +152 if +ALPDRUG'>0
- QUIT
- +153 SET ALPLACT=$$LACT^ALPBUTL3(ALPPAT,ALPDRUG)
- +154 IF ALPLACT'=""
- Begin DoDot:3
- +155 SET LINE=LINE+1
- SET RESULTS(LINE)=$$REPEAT^XLFSTR("-",75)
- +156 SET LINE=LINE+1
- +157 SET RESULTS(LINE)="Last action for "_ALPBDNM_" "_" was "_$PIECE(ALPLACT,"^",3)_" on "_$$FDATE^ALPBUTL($PIECE(ALPLACT,"^",1))
- +158 SET RESULTS(LINE)=RESULTS(LINE)_" By "_$SELECT($PIECE(ALPLACT,"^",2)'="":$PIECE(ALPLACT,"^",2),1:"<not on file>")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +159 KILL ALPLACT,ALPDRUG,ALPBX
- +160 ;
- +161 IF LINE<11
- FOR I=1:1
- if LINE=11
- QUIT
- Begin DoDot:1
- +162 SET LINE=LINE+1
- +163 SET RESULTS(LINE)=""
- End DoDot:1
- +164 ;
- +165 ; now add admin times and initial boxes to lines 4-10 as required
- +166 ; by number of administration times...
- +167 SET ALPBIBOX="______|"
- +168 SET ALPBNBOX="******|"
- +169 IF +$GET(ALPBADM)=0
- SET ALPBADM=8
- +170 ;S ALPBPRN=ALPBADM+4
- +171 SET ALPBTSTART=$PIECE($GET(DATA(1)),"^",1)
- +172 SET ALPBSTOP=$PIECE($GET(DATA(1)),"^",2)
- +173 SET AD=1
- ADMTIM ;build admin/remove times grid
- FOR I=1:1:ALPBADM
- Begin DoDot:1
- +1 SET ALPBPRN=I+3
- +2 SET ALPBADMT=$GET(ALPBADM(I))
- +3 IF ALPBADMT=""
- SET ALPBADMT=" "
- +4 IF '$DATA(RESULTS(I+3))
- Begin DoDot:2
- +5 SET RESULTS(I+3)=" "
- +6 SET LINE=LINE+1
- End DoDot:2
- +7 IF ALPBADMT["Remove"
- Begin DoDot:2
- +8 SET RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
- +9 SET AD=0
- End DoDot:2
- +10 IF '$TEST
- Begin DoDot:2
- +11 if AD
- SET RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
- +12 if 'AD
- SET RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),65)_"| "
- End DoDot:2
- +13 SET RESULTS(I+3)=RESULTS(I+3)_$SELECT($LENGTH(ALPBADMT)=2:ALPBADMT_"00",1:ALPBADMT)
- +14 SET RESULTS(I+3)=$$PAD^ALPBUTL(RESULTS(I+3),74)_"|"
- +15 FOR J=1:1:DAYS
- Begin DoDot:2
- +16 ;P135 PRN or IV
- SET ALPBNOAS=$SELECT(+ALPBADMT:1,ALPBPRNG:0,$$OTYP^ALPBUTL($PIECE($GET(DATA(3)),"^"))="IV":0,1:1)
- +17 ;P135
- IF ALPBADMT=" "&ALPBNOAS
- SET ALPBTSTART=$PIECE($PIECE($GET(DATA(1)),"^",1),".",1)
- SET ALPBSTOP=$PIECE($PIECE($GET(DATA(1)),"^",2),".",1)
- +18 ;125 - add + to trim insignificant trailing 0's
- SET ALPBDAY=+(ALPBDAYS(J)_"."_ALPBADMT)
- +19 SET ALPBPBOX=ALPBIBOX
- ASTER ;prints asterisks in boxes if start date is in the future
- +1 ;and if the stop date has already expired
- +2 ;on an admin line
- IF AD
- Begin DoDot:3
- +3 ;P135
- IF ALPBDAY<ALPBTSTART&(ALPBNOAS)
- SET ALPBPBOX=ALPBNBOX
- +4 IF ALPBDAY>ALPBSTOP!(ALPBDAY=ALPBSTOP)
- SET ALPBPBOX=ALPBNBOX
- End DoDot:3
- +5 ;on a remove line calc orig admin for this remove time
- IF '$TEST
- Begin DoDot:3
- +6 ;Remove lbl line = *
- IF ALPBDAY["Remove"
- SET ALPBPBOX=ALPBNBOX
- QUIT
- +7 ;Rem-Doa = orig admin
- SET REMTIM=$$FMADD^XLFDT(ALPBDAY,,,-ALPBDOA)
- +8 IF (REMTIM<ALPBTSTART)!(REMTIM>ALPBSTOP)
- SET ALPBPBOX=ALPBNBOX
- End DoDot:3
- +9 SET RESULTS(I+3)=RESULTS(I+3)_ALPBPBOX
- End DoDot:2
- +10 KILL ALPBADMT,ALPBPBOX,ALPBDAY
- End DoDot:1
- ENDGRID KILL ALPBIBOX,ALPBNBOX
- +1 ; if PRN med, add line for documenting effectiveness...
- +2 IF +ALPBPRNG
- Begin DoDot:1
- +3 SET ALPBFLG=0
- SET ALPBPRN=ALPBPRN+1
- +4 if '$DATA(RESULTS(ALPBPRN))
- SET RESULTS(ALPBPRN)=" "
- SET ALPBFLG=1
- +5 ;*87 longer
- SET RESULTS(ALPBPRN)=$$PAD^ALPBUTL(RESULTS(ALPBPRN),63)_" PRN Effectiveness:_______________________________________________"
- +6 if ALPBFLG
- SET LINE=LINE+1
- End DoDot:1
- +7 ;
- +8 ;*69 move SI text to here outside confines of grid
- +9 ; provider comments, special instructions, and other print info...
- +10 IF +$ORDER(DATA(5,0))
- Begin DoDot:1
- +11 KILL ALPBTEXT
- MERGE ALPBTEXT=DATA(5)
- +12 SET ALPBX=0
- +13 FOR
- SET ALPBX=$ORDER(ALPBTEXT(ALPBX))
- if 'ALPBX
- QUIT
- Begin DoDot:2
- +14 SET ALPBLINE=ALPBTEXT(ALPBX,0)
- +15 SET LINE=LINE+1
- +16 SET RESULTS(LINE)=ALPBLINE
- End DoDot:2
- +17 KILL ALPBLINE,ALPBTEXT,ALPBX
- End DoDot:1
- +18 ;
- +19 SET LINE=LINE+1
- +20 SET RESULTS(LINE)=$$REPEAT^XLFSTR("-",132)
- +21 SET RESULTS(0)=LINE
- +22 QUIT