ALPBFRMU ;OIFO-DALLAS MW,SED,KC-PRINT FORMATTING UTILITIES;03/06/16 3:06pm
;;3.0;BAR CODE MED ADMIN;**8,87**;Mar 2004;Build 22
;
;*87 - Stop printing the FOOT or legend.
;
FTEXT(COL,TEXT,RESULTS) ; format TEXT array...
; COL = number of columns (line length)
; TEXT = array to be reformatted. the array should be in
; standard FM format: TEXT(1,0)=text
; TEXT(2,0)=text
; TEXT(n,0)=text
; RESULT = array passed by reference into which reformatted text
; will be returned: RESULTS(1,0)=formatted text to COL length
; RESULTS(2,0)=formatted text to COL length
I +$G(COL)=0!('$D(TEXT)) Q
N ALPBTEMP,I,J,L,M,FSTRING,XSTRING
S (I,J)=0
S XSTRING=""
F S I=$O(TEXT(I)) Q:'I D
.S DATA=$G(TEXT(I,0))
.I DATA="" D Q
..S J=J+1
..S ALPBTEMP(J,0)=""
.F L=1:1:$L(DATA) D
..S XSTRING=XSTRING_$E(DATA,L)
..I $L(XSTRING)=COL D
...S FSTRING=XSTRING
...F M=$L(XSTRING):-1:1 Q:$A($E(XSTRING,M))'>32
...S FSTRING=$E(XSTRING,1,M-1)
...S XSTRING=$E(XSTRING,M+1,$L(XSTRING))
...S J=J+1
...S ALPBTEMP(J,0)=FSTRING
...S FSTRING=""
...I $L(XSTRING)=COL S XSTRING=""
I $L(XSTRING)>0 D
.S J=J+1
.S ALPBTEMP(J,0)=XSTRING
M RESULTS=ALPBTEMP
Q
;
HDR(DATA,PG,RESULTS) ; print page header...
; DATA = an array passed by reference containing the nodes in
; a patient's record in ^ALPB(53.7,...)
; PG = page number to use
; RESULTS = an array passed by reference that will be used to return
; the formated data
; returns data in formated 132-column output
N ALPBALG,ALPBALGL,ALPBALGX,ALPBX,LINE
I $G(PG)="" S PG=0
S RESULTS(1)="MAR Ran: "_$$FMTE^XLFDT($$NOW^XLFDT())
S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),32)_"Inpatient Pharmacy Orders (Backup)"
S RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),122)_"Page: "_$J(PG,3)
S RESULTS(2)=$P($G(DATA(0)),"^")
S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),33)_"SSN: "_$P($G(DATA(0)),"^",2)
S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),50)_"DOB: "_$S($P($G(DATA(0)),"^",3)'="":$$FMTE^XLFDT($P(DATA(0),"^",3)),1:"not on file")
S RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),70)_"Sex: "_$P($G(DATA(0)),"^",4)
S RESULTS(3)="Ward: "_$P($G(DATA(0)),"^",5)
S RESULTS(3)=$$PAD^ALPBUTL(RESULTS(3),32)_"Room: "_$P($G(DATA(0)),"^",6)
S RESULTS(3)=$$PAD^ALPBUTL(RESULTS(3),50)_"Bed: "_$P($G(DATA(0)),"^",7)
S RESULTS(4)=""
S RESULTS(4)=$$PAD^ALPBUTL(RESULTS(4),12)_"This record last updated: "
S RESULTS(4)=RESULTS(4)_$S($P(DATA(0),"^",8)'="":$$FMTE^XLFDT($P(DATA(0),"^",8)),1:"<date not on file>")
S LINE=4
; report allergies...
I '$D(DATA(1,0)) D
.;no allergies reported
.S LINE=LINE+1,RESULTS(LINE)=""
.S RESULTS(LINE)="No allergies reported to the Contingency"
I +$O(DATA(1,0)) D
.S LINE=LINE+1
.S RESULTS(LINE)=""
.S ALPBALGX="Allergies: "
.S ALPBALGL=$L(ALPBALGX)-1
.S (ALPBCNT,ALPBX)=0
.F S ALPBX=$O(DATA(1,ALPBX)) Q:'ALPBX D
..S ALPBALG=$P($G(DATA(1,ALPBX,0)),"^",2)
..I ALPBALG="" K ALPBALG Q
..I $L(ALPBALGX_ALPBALG_"; ")>90 D
...S LINE=LINE+1
...S RESULTS(LINE)=""
...S ALPBALGX=""
...S ALPBALGX=$$PAD^ALPBUTL(ALPBALGX,ALPBALGL)
..S ALPBALGX=ALPBALGX_ALPBALG_$S(+$O(DATA(1,ALPBX)):"; ",1:"")
..S RESULTS(LINE)=ALPBALGX
S RESULTS(0)=LINE
Q
;
; code adapted from original routine ^ALPFOOT by FD@NJHCS, May 2002
W !,"|"
W ?13,"SIGNATURE/TITLE"
W ?40,"| INIT"
W ?48,"|"
W !,"|"
W $$REPEAT^XLFSTR("_",38)
W ?40,"|_______|"
W !,"|"
W $$REPEAT^XLFSTR("_",38)
W ?40,"|_______|"
W !,"|"
W $$REPEAT^XLFSTR("_",38)
W ?40,"|_______|"
W !,"|"
W $$REPEAT^XLFSTR("_",38)
W ?40,"|_______|"
Q ;*87 REMOVE INJECTION SITE INFORMATION ONLY LEAVE SIG LINES
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBFRMU 3806 printed Jan 18, 2025@02:40:33 Page 2
ALPBFRMU ;OIFO-DALLAS MW,SED,KC-PRINT FORMATTING UTILITIES;03/06/16 3:06pm
+1 ;;3.0;BAR CODE MED ADMIN;**8,87**;Mar 2004;Build 22
+2 ;
+3 ;*87 - Stop printing the FOOT or legend.
+4 ;
FTEXT(COL,TEXT,RESULTS) ; format TEXT array...
+1 ; COL = number of columns (line length)
+2 ; TEXT = array to be reformatted. the array should be in
+3 ; standard FM format: TEXT(1,0)=text
+4 ; TEXT(2,0)=text
+5 ; TEXT(n,0)=text
+6 ; RESULT = array passed by reference into which reformatted text
+7 ; will be returned: RESULTS(1,0)=formatted text to COL length
+8 ; RESULTS(2,0)=formatted text to COL length
+9 IF +$GET(COL)=0!('$DATA(TEXT))
QUIT
+10 NEW ALPBTEMP,I,J,L,M,FSTRING,XSTRING
+11 SET (I,J)=0
+12 SET XSTRING=""
+13 FOR
SET I=$ORDER(TEXT(I))
if 'I
QUIT
Begin DoDot:1
+14 SET DATA=$GET(TEXT(I,0))
+15 IF DATA=""
Begin DoDot:2
+16 SET J=J+1
+17 SET ALPBTEMP(J,0)=""
End DoDot:2
QUIT
+18 FOR L=1:1:$LENGTH(DATA)
Begin DoDot:2
+19 SET XSTRING=XSTRING_$EXTRACT(DATA,L)
+20 IF $LENGTH(XSTRING)=COL
Begin DoDot:3
+21 SET FSTRING=XSTRING
+22 FOR M=$LENGTH(XSTRING):-1:1
if $ASCII($EXTRACT(XSTRING,M))'>32
QUIT
+23 SET FSTRING=$EXTRACT(XSTRING,1,M-1)
+24 SET XSTRING=$EXTRACT(XSTRING,M+1,$LENGTH(XSTRING))
+25 SET J=J+1
+26 SET ALPBTEMP(J,0)=FSTRING
+27 SET FSTRING=""
+28 IF $LENGTH(XSTRING)=COL
SET XSTRING=""
End DoDot:3
End DoDot:2
End DoDot:1
+29 IF $LENGTH(XSTRING)>0
Begin DoDot:1
+30 SET J=J+1
+31 SET ALPBTEMP(J,0)=XSTRING
End DoDot:1
+32 MERGE RESULTS=ALPBTEMP
+33 QUIT
+34 ;
HDR(DATA,PG,RESULTS) ; print page header...
+1 ; DATA = an array passed by reference containing the nodes in
+2 ; a patient's record in ^ALPB(53.7,...)
+3 ; PG = page number to use
+4 ; RESULTS = an array passed by reference that will be used to return
+5 ; the formated data
+6 ; returns data in formated 132-column output
+7 NEW ALPBALG,ALPBALGL,ALPBALGX,ALPBX,LINE
+8 IF $GET(PG)=""
SET PG=0
+9 SET RESULTS(1)="MAR Ran: "_$$FMTE^XLFDT($$NOW^XLFDT())
+10 SET RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),32)_"Inpatient Pharmacy Orders (Backup)"
+11 SET RESULTS(1)=$$PAD^ALPBUTL(RESULTS(1),122)_"Page: "_$JUSTIFY(PG,3)
+12 SET RESULTS(2)=$PIECE($GET(DATA(0)),"^")
+13 SET RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),33)_"SSN: "_$PIECE($GET(DATA(0)),"^",2)
+14 SET RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),50)_"DOB: "_$SELECT($PIECE($GET(DATA(0)),"^",3)'="":$$FMTE^XLFDT($PIECE(DATA(0),"^",3)),1:"not on file")
+15 SET RESULTS(2)=$$PAD^ALPBUTL(RESULTS(2),70)_"Sex: "_$PIECE($GET(DATA(0)),"^",4)
+16 SET RESULTS(3)="Ward: "_$PIECE($GET(DATA(0)),"^",5)
+17 SET RESULTS(3)=$$PAD^ALPBUTL(RESULTS(3),32)_"Room: "_$PIECE($GET(DATA(0)),"^",6)
+18 SET RESULTS(3)=$$PAD^ALPBUTL(RESULTS(3),50)_"Bed: "_$PIECE($GET(DATA(0)),"^",7)
+19 SET RESULTS(4)=""
+20 SET RESULTS(4)=$$PAD^ALPBUTL(RESULTS(4),12)_"This record last updated: "
+21 SET RESULTS(4)=RESULTS(4)_$SELECT($PIECE(DATA(0),"^",8)'="":$$FMTE^XLFDT($PIECE(DATA(0),"^",8)),1:"<date not on file>")
+22 SET LINE=4
+23 ; report allergies...
+24 IF '$DATA(DATA(1,0))
Begin DoDot:1
+25 ;no allergies reported
+26 SET LINE=LINE+1
SET RESULTS(LINE)=""
+27 SET RESULTS(LINE)="No allergies reported to the Contingency"
End DoDot:1
+28 IF +$ORDER(DATA(1,0))
Begin DoDot:1
+29 SET LINE=LINE+1
+30 SET RESULTS(LINE)=""
+31 SET ALPBALGX="Allergies: "
+32 SET ALPBALGL=$LENGTH(ALPBALGX)-1
+33 SET (ALPBCNT,ALPBX)=0
+34 FOR
SET ALPBX=$ORDER(DATA(1,ALPBX))
if 'ALPBX
QUIT
Begin DoDot:2
+35 SET ALPBALG=$PIECE($GET(DATA(1,ALPBX,0)),"^",2)
+36 IF ALPBALG=""
KILL ALPBALG
QUIT
+37 IF $LENGTH(ALPBALGX_ALPBALG_"; ")>90
Begin DoDot:3
+38 SET LINE=LINE+1
+39 SET RESULTS(LINE)=""
+40 SET ALPBALGX=""
+41 SET ALPBALGX=$$PAD^ALPBUTL(ALPBALGX,ALPBALGL)
End DoDot:3
+42 SET ALPBALGX=ALPBALGX_ALPBALG_$SELECT(+$ORDER(DATA(1,ALPBX)):"; ",1:"")
+43 SET RESULTS(LINE)=ALPBALGX
End DoDot:2
End DoDot:1
+44 SET RESULTS(0)=LINE
+45 QUIT
+46 ;
+1 ; code adapted from original routine ^ALPFOOT by FD@NJHCS, May 2002
+2 WRITE !,"|"
+3 WRITE ?13,"SIGNATURE/TITLE"
+4 WRITE ?40,"| INIT"
+5 WRITE ?48,"|"
+6 WRITE !,"|"
+7 WRITE $$REPEAT^XLFSTR("_",38)
+8 WRITE ?40,"|_______|"
+9 WRITE !,"|"
+10 WRITE $$REPEAT^XLFSTR("_",38)
+11 WRITE ?40,"|_______|"
+12 WRITE !,"|"
+13 WRITE $$REPEAT^XLFSTR("_",38)
+14 WRITE ?40,"|_______|"
+15 WRITE !,"|"
+16 WRITE $$REPEAT^XLFSTR("_",38)
+17 WRITE ?40,"|_______|"
+18 ;*87 REMOVE INJECTION SITE INFORMATION ONLY LEAVE SIG LINES
QUIT
