Routine: ALPBFRMU

ALPBFRMU ;OIFO-DALLAS MW,SED,KC-PRINT FORMATTING UTILITIES;01/01/03

 ;;3.0;BAR CODE MED ADMIN;**8,1018**;Mar 2004;Build 27

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

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)_"HRN: "_$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

FOOT ; print page footer (note: output is 5 lines)...

 ; code adapted from original routine ^ALPFOOT by FD@NJHCS, May 2002

 W !,"|"

 W ?13,"SIGNATURE/TITLE"

 W ?40,"| INIT"

 W ?48,"|"

 W ?50,"INJECTION SITES (Right or Left)"

 W ?88,"VA FORM  10-2970"

 W !,"|"

 W $$REPEAT^XLFSTR("_",38)

 W ?40,"|_______| 1. DELTOID"

 W ?71,"4. MED (ANTERIOR) THIGH"

 W ?96,"7. ABDOMEN"

 W !,"|"

 W $$REPEAT^XLFSTR("_",38)

 W ?40,"|_______| 2. VENTRAL GLUTEAL"

 W ?71,"5. VASTUS LATERALIS"

 W ?96,"8. THIGH"

 W !,"|"

 W $$REPEAT^XLFSTR("_",38)

 W ?40,"|_______| 3. GLUTEUS MEDIUS"

 W ?71,"6. UPPER ARM"

 W ?96,"9. BUTTOCK"

 W !,"|"

 W $$REPEAT^XLFSTR("_",38)

 W ?40,"|_______|10. UPPER BACK      PRN: E=Effective  N=Not Effective"

ALPBFRMU  ;OIFO-DALLAS MW,SED,KC-PRINT FORMATTING UTILITIES;01/01/03

 +1       ;;3.0;BAR CODE MED ADMIN;**8,1018**;Mar 2004;Build 27

 +2       ;

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)_"HRN: "_$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      ;

FOOT      ; print page footer (note: output is 5 lines)...

 +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 ?50,"INJECTION SITES (Right or Left)"

 +7        WRITE ?88,"VA FORM  10-2970"

 +8        WRITE !,"|"

 +9        WRITE $$REPEAT^XLFSTR("_",38)

 +10       WRITE ?40,"|_______| 1. DELTOID"

 +11       WRITE ?71,"4. MED (ANTERIOR) THIGH"

 +12       WRITE ?96,"7. ABDOMEN"

 +13       WRITE !,"|"

 +14       WRITE $$REPEAT^XLFSTR("_",38)

 +15       WRITE ?40,"|_______| 2. VENTRAL GLUTEAL"

 +16       WRITE ?71,"5. VASTUS LATERALIS"

 +17       WRITE ?96,"8. THIGH"

 +18       WRITE !,"|"

 +19       WRITE $$REPEAT^XLFSTR("_",38)

 +20       WRITE ?40,"|_______| 3. GLUTEUS MEDIUS"

 +21       WRITE ?71,"6. UPPER ARM"

 +22       WRITE ?96,"9. BUTTOCK"

 +23       WRITE !,"|"

 +24       WRITE $$REPEAT^XLFSTR("_",38)

 +25       WRITE ?40,"|_______|10. UPPER BACK      PRN: E=Effective  N=Not Effective"

 +26       QUIT

ALPBFRMU.m