ALPBBK ;OIFO-DALLAS MW,SED,KC,KCF PRINT BLANK MAR BCMA FOR SELECTED PATIENT ;04/25/03
;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
;
; NOTE: this routine is designed for hard-copy output.
; Output is formatted for 132-column printing.
;
F D Q:$D(DIRUT)
.W !!,"Inpatient Pharmacy Orders for a selected patient"
.S DIR(0)="PAO^53.7:QEMZ"
.S DIR("A")="Select PATIENT NAME: "
.D ^DIR K DIR
.I $D(DIRUT) K X,Y Q
.S ALPBIEN=+Y
.S ALPBPTN=Y(0,0)
.S %ZIS="Q"
.S %ZIS("B")=$$DEFPRT^ALPBUTL()
.I %ZIS("B")="" K %ZIS("B")
.; print how many days MAR?...
.S DIR(0)="NA^3:7"
.S DIR("A")="Print how many days MAR? "
.S DIR("B")=$$DEFDAYS^ALPBUTL()
.S DIR("?")="The default is shown; you may select 3 or 7."
.W ! D ^DIR K DIR
.I $D(DIRUT) K ALPBOTYP,DIRUT,DTOUT,X,Y Q
.S ALPBDAYS=+Y
.;
.W ! D ^%ZIS K %ZIS
.I POP D Q
..K ALPBIEN,ALPBPTN,POP
.;
.; output not queued...
.I '$D(IO("Q")) D
..U IO
..D DQ
..I IO'=IO(0) D ^%ZISC
.;
.; set up the Task...
.I $D(IO("Q")) D
..S ZTRTN="DQ^ALPBBK"
..S ZTIO=ION
..S ZTDESC="PSB INPT PHARM ORDERS FOR "_ALPBPTN
..S ZTSAVE("ALPBDAYS")=""
..S ZTSAVE("ALPBIEN")=""
..S ZTSAVE("ALPBMLOG")=""
..S ZTSAVE("ALPBOTYP")=""
..D ^%ZTLOAD
..D HOME^%ZIS
..W !!,$S(+$G(ZTSK):"Task "_ZTSK_" queued.",1:"ERROR: NOT QUEUED!")
..K IO("Q"),ZTSK
.;
.K ALPBDAYS,ALPBIEN,ALPBMLOG,ALPBOTYP,ALPBPTN,X,Y
K DIRUT,DTOUT,X,Y
Q
;
DQ ; output entry point...
K ^TMP($J)
;
; set report date...
S ALPBRDAT=$$DT^XLFDT()
S ALPBPT(0)=$G(^ALPB(53.7,ALPBIEN,0))
M ALPBPT(1)=^ALPB(53.7,ALPBIEN,1)
S ALPBPG=1
D HDR^ALPBFRMU(.ALPBPT,ALPBPG,.ALPBHDR)
F I=1:1:ALPBHDR(0) W !,ALPBHDR(I)
K ALPBHDR
S FOOT=0
S DAY=ALPBDAYS
S FOOT=FOOT+1 S MST=$S(DAY=3:83,DAY=7:105,DAY=14:140)
S NST=$S(DAY=3:95,DAY=7:120,DAY=14:135)
W !?61,"Admin" D MON^ALPBUTL3(DAY) W ?74,MON D ARRAY^ALPBUTL3(DAY)
W !,?2,"Order",?13,"Start",?35,"Stop",?61,"Times" D START^ALPBUTL3(DAY) W ?NST,"Notes"
W ! F J=1:1:142 W "-"
S ADM(7)=""
F JY=1:0:4 DO Q:JY=5
.W !,"____________|______________________|___________________",?59," |",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
.W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
.W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
.W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
.W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
.W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
.W !!!,?5,"RPH Verify:___________ Nurse Verify:____________"
.W ! F J=1:1:142 W "-"
.S JY=JY+1
D STOP
Q
STOP D FOOT
K PTNAME,WARD,SSN,BED,ST,ROOM,Y,DOB,J,IENM,DFN,NST,ANS,FOOT,SEX,ADMIN(7),PCOUNT,CURRENT,MST
Q
W !,"|",?13,"SIGNATURE/TITLE",?40,"| INIT",?48,"|",?60,"INJECTION SITES",?87,"|",?92,"MED/DOSE OMITTED",?115,"|",?120,"REASON",?132,"|",?135,"INIT",?140,"|"
W !,"|" F J=2:1:39 W "-"
W ?40,"|" F J=41:1:47 W "-"
W ?48,"|" F J=49:1:84 W "-"
W ?87,"|" F J=88:1:114 W "-"
W ?115,"|" F J=116:1:131 W "-"
W ?132,"|" F J=133:1:139 W "-"
W ?140,"|"
W !,"|" F J=2:1:39 W "-"
W ?40,"|" F J=41:1:47 W "-"
W ?48,"|"
W ?52,"Indicate RIGHT (R) or LEFT (L)"
W ?87,"|" F J=88:1:114 W "-"
W ?115,"|" F J=116:1:131 W "-"
W ?132,"|" F J=133:1:139 W "-"
W ?140,"|"
W !,"|" F J=2:1:39 W "-"
W ?40,"|" F J=41:1:47 W "-"
W ?48,"|"
W ?87,"|" F J=88:1:112 W "-"
W ?115,"|" F J=116:1:129 W "-"
W ?132,"|" F J=133:1:137 W "-"
W ?140,"|"
W !,"|" F J=2:1:39 W "-"
W ?40,"|" F J=41:1:47 W "-"
W ?48,"|"
W ?53,"(IM)",?75,"(SUB Q)"
W ?87,"|" F J=88:1:114 W "-"
W ?115,"|" F J=116:1:131 W "-"
W ?132,"|" F J=133:1:139 W "-"
W ?140,"|"
W !,"|" F J=2:1:39 W "-"
W ?40,"|" F J=41:1:47 W "-"
W ?48,"|"
W ?49,"1. DELTOID",?73,"6. UPPER ARM"
W ?87,"|" F J=88:1:114 W "-"
W ?115,"|" F J=116:1:131 W "-"
W ?132,"|" F J=133:1:139 W "-"
W ?140,"|"
W !,"|" F J=2:1:39 W "-"
W ?40,"|" F J=41:1:47 W "-"
W ?48,"|"
W ?49,"2. VENTRAL GLUTEAL",?73,"7. ABDOMEN"
W ?87,"|" F J=88:1:114 W "-"
W ?115,"|" F J=116:1:131 W "-"
W ?132,"|" F J=133:1:139 W "-"
W ?140,"|"
W !,"|" F J=2:1:39 W "-"
W ?40,"|" F J=41:1:47 W "-"
W ?48,"|"
W ?49,"3. GLUTEUS MEDIUS",?73,"8. THIGH"
W ?87,"|" F J=88:1:114 W "-"
W ?115,"|" F J=116:1:131 W "-"
W ?132,"|" F J=133:1:139 W "-"
W ?140,"|"
W !,"|" F J=2:1:39 W "-"
W ?40,"|" F J=41:1:47 W "-"
W ?48,"|"
W ?49,"4. MED (ANTERIOR) THIGH",?73,"9. BUTTOCK"
W ?87,"|" F J=88:1:114 W "-"
W ?115,"|" F J=116:1:131 W "-"
W ?132,"|" F J=133:1:139 W "-"
W ?140,"|"
W !,"|" F J=2:1:39 W "-"
W ?40,"|" F J=41:1:47 W "-"
W ?48,"|"
W ?49,"5. VASTUS LATERALIS",?73,"10. UPPER BACK"
W ?87,"|" F J=88:1:114 W "-"
W ?115,"|" F J=116:1:131 W "-"
W ?132,"|" F J=133:1:139 W "-"
W ?140,"|"
W !,"|" F J=2:1:39 W "-"
W ?40,"|" F J=41:1:47 W "-"
W ?48,"|"
W ?50," PRN: E=Effective N=Not Effective"
W ?87,"|" F J=88:1:114 W "-"
W ?115,"|" F J=116:1:131 W "-"
W ?132,"|" F J=133:1:139 W "-"
W ?140,"|"
W ! F J=1:1:140 W "-"
W ?140,"|"
K ALPBDAYS,DAY,ALPBOIEN,ALPBORDN,ALPBOST,ALPBOTYP,ALPBPG,ALPBPT,ALPBRDAT,^TMP($J)
I $D(ZTQUEUED) S ZTREQ="@"
;
; write form feed at end if output device is a printer...
I $E(IOST)="P" W @IOF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HALPBBK 5255 printed Dec 13, 2024@01:39:14 Page 2
ALPBBK ;OIFO-DALLAS MW,SED,KC,KCF PRINT BLANK MAR BCMA FOR SELECTED PATIENT ;04/25/03
+1 ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
+2 ;
+3 ; NOTE: this routine is designed for hard-copy output.
+4 ; Output is formatted for 132-column printing.
+5 ;
+6 FOR
Begin DoDot:1
+7 WRITE !!,"Inpatient Pharmacy Orders for a selected patient"
+8 SET DIR(0)="PAO^53.7:QEMZ"
+9 SET DIR("A")="Select PATIENT NAME: "
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
KILL X,Y
QUIT
+12 SET ALPBIEN=+Y
+13 SET ALPBPTN=Y(0,0)
+14 SET %ZIS="Q"
+15 SET %ZIS("B")=$$DEFPRT^ALPBUTL()
+16 IF %ZIS("B")=""
KILL %ZIS("B")
+17 ; print how many days MAR?...
+18 SET DIR(0)="NA^3:7"
+19 SET DIR("A")="Print how many days MAR? "
+20 SET DIR("B")=$$DEFDAYS^ALPBUTL()
+21 SET DIR("?")="The default is shown; you may select 3 or 7."
+22 WRITE !
DO ^DIR
KILL DIR
+23 IF $DATA(DIRUT)
KILL ALPBOTYP,DIRUT,DTOUT,X,Y
QUIT
+24 SET ALPBDAYS=+Y
+25 ;
+26 WRITE !
DO ^%ZIS
KILL %ZIS
+27 IF POP
Begin DoDot:2
+28 KILL ALPBIEN,ALPBPTN,POP
End DoDot:2
QUIT
+29 ;
+30 ; output not queued...
+31 IF '$DATA(IO("Q"))
Begin DoDot:2
+32 USE IO
+33 DO DQ
+34 IF IO'=IO(0)
DO ^%ZISC
End DoDot:2
+35 ;
+36 ; set up the Task...
+37 IF $DATA(IO("Q"))
Begin DoDot:2
+38 SET ZTRTN="DQ^ALPBBK"
+39 SET ZTIO=ION
+40 SET ZTDESC="PSB INPT PHARM ORDERS FOR "_ALPBPTN
+41 SET ZTSAVE("ALPBDAYS")=""
+42 SET ZTSAVE("ALPBIEN")=""
+43 SET ZTSAVE("ALPBMLOG")=""
+44 SET ZTSAVE("ALPBOTYP")=""
+45 DO ^%ZTLOAD
+46 DO HOME^%ZIS
+47 WRITE !!,$SELECT(+$GET(ZTSK):"Task "_ZTSK_" queued.",1:"ERROR: NOT QUEUED!")
+48 KILL IO("Q"),ZTSK
End DoDot:2
+49 ;
+50 KILL ALPBDAYS,ALPBIEN,ALPBMLOG,ALPBOTYP,ALPBPTN,X,Y
End DoDot:1
if $DATA(DIRUT)
QUIT
+51 KILL DIRUT,DTOUT,X,Y
+52 QUIT
+53 ;
DQ ; output entry point...
+1 KILL ^TMP($JOB)
+2 ;
+3 ; set report date...
+4 SET ALPBRDAT=$$DT^XLFDT()
+5 SET ALPBPT(0)=$GET(^ALPB(53.7,ALPBIEN,0))
+6 MERGE ALPBPT(1)=^ALPB(53.7,ALPBIEN,1)
+7 SET ALPBPG=1
+8 DO HDR^ALPBFRMU(.ALPBPT,ALPBPG,.ALPBHDR)
+9 FOR I=1:1:ALPBHDR(0)
WRITE !,ALPBHDR(I)
+10 KILL ALPBHDR
+11 SET FOOT=0
+12 SET DAY=ALPBDAYS
+13 SET FOOT=FOOT+1
SET MST=$SELECT(DAY=3:83,DAY=7:105,DAY=14:140)
+14 SET NST=$SELECT(DAY=3:95,DAY=7:120,DAY=14:135)
+15 WRITE !?61,"Admin"
DO MON^ALPBUTL3(DAY)
WRITE ?74,MON
DO ARRAY^ALPBUTL3(DAY)
+16 WRITE !,?2,"Order",?13,"Start",?35,"Stop",?61,"Times"
DO START^ALPBUTL3(DAY)
WRITE ?NST,"Notes"
+17 WRITE !
FOR J=1:1:142
WRITE "-"
+18 SET ADM(7)=""
+19 FOR JY=1:0:4
Begin DoDot:1
+20 WRITE !,"____________|______________________|___________________",?59," |",ADM(7),?72,"|"
FOR J=72:5:MST
WRITE ?J,"_____|"
+21 WRITE !?60,"|",ADM(7),?72,"|"
FOR J=72:5:MST
WRITE ?J,"_____|"
+22 WRITE !?60,"|",ADM(7),?72,"|"
FOR J=72:5:MST
WRITE ?J,"_____|"
+23 WRITE !?60,"|",ADM(7),?72,"|"
FOR J=72:5:MST
WRITE ?J,"_____|"
+24 WRITE !?60,"|",ADM(7),?72,"|"
FOR J=72:5:MST
WRITE ?J,"_____|"
+25 WRITE !?60,"|",ADM(7),?72,"|"
FOR J=72:5:MST
WRITE ?J,"_____|"
+26 WRITE !!!,?5,"RPH Verify:___________ Nurse Verify:____________"
+27 WRITE !
FOR J=1:1:142
WRITE "-"
+28 SET JY=JY+1
End DoDot:1
if JY=5
QUIT
+29 DO STOP
+30 QUIT
STOP DO FOOT
+1 KILL PTNAME,WARD,SSN,BED,ST,ROOM,Y,DOB,J,IENM,DFN,NST,ANS,FOOT,SEX,ADMIN(7),PCOUNT,CURRENT,MST
+2 QUIT
+1 WRITE !,"|",?13,"SIGNATURE/TITLE",?40,"| INIT",?48,"|",?60,"INJECTION SITES",?87,"|",?92,"MED/DOSE OMITTED",?115,"|",?120,"REASON",?132,"|",?135,"INIT",?140,"|"
+2 WRITE !,"|"
FOR J=2:1:39
WRITE "-"
+3 WRITE ?40,"|"
FOR J=41:1:47
WRITE "-"
+4 WRITE ?48,"|"
FOR J=49:1:84
WRITE "-"
+5 WRITE ?87,"|"
FOR J=88:1:114
WRITE "-"
+6 WRITE ?115,"|"
FOR J=116:1:131
WRITE "-"
+7 WRITE ?132,"|"
FOR J=133:1:139
WRITE "-"
+8 WRITE ?140,"|"
+9 WRITE !,"|"
FOR J=2:1:39
WRITE "-"
+10 WRITE ?40,"|"
FOR J=41:1:47
WRITE "-"
+11 WRITE ?48,"|"
+12 WRITE ?52,"Indicate RIGHT (R) or LEFT (L)"
+13 WRITE ?87,"|"
FOR J=88:1:114
WRITE "-"
+14 WRITE ?115,"|"
FOR J=116:1:131
WRITE "-"
+15 WRITE ?132,"|"
FOR J=133:1:139
WRITE "-"
+16 WRITE ?140,"|"
+17 WRITE !,"|"
FOR J=2:1:39
WRITE "-"
+18 WRITE ?40,"|"
FOR J=41:1:47
WRITE "-"
+19 WRITE ?48,"|"
+20 WRITE ?87,"|"
FOR J=88:1:112
WRITE "-"
+21 WRITE ?115,"|"
FOR J=116:1:129
WRITE "-"
+22 WRITE ?132,"|"
FOR J=133:1:137
WRITE "-"
+23 WRITE ?140,"|"
+24 WRITE !,"|"
FOR J=2:1:39
WRITE "-"
+25 WRITE ?40,"|"
FOR J=41:1:47
WRITE "-"
+26 WRITE ?48,"|"
+27 WRITE ?53,"(IM)",?75,"(SUB Q)"
+28 WRITE ?87,"|"
FOR J=88:1:114
WRITE "-"
+29 WRITE ?115,"|"
FOR J=116:1:131
WRITE "-"
+30 WRITE ?132,"|"
FOR J=133:1:139
WRITE "-"
+31 WRITE ?140,"|"
+32 WRITE !,"|"
FOR J=2:1:39
WRITE "-"
+33 WRITE ?40,"|"
FOR J=41:1:47
WRITE "-"
+34 WRITE ?48,"|"
+35 WRITE ?49,"1. DELTOID",?73,"6. UPPER ARM"
+36 WRITE ?87,"|"
FOR J=88:1:114
WRITE "-"
+37 WRITE ?115,"|"
FOR J=116:1:131
WRITE "-"
+38 WRITE ?132,"|"
FOR J=133:1:139
WRITE "-"
+39 WRITE ?140,"|"
+40 WRITE !,"|"
FOR J=2:1:39
WRITE "-"
+41 WRITE ?40,"|"
FOR J=41:1:47
WRITE "-"
+42 WRITE ?48,"|"
+43 WRITE ?49,"2. VENTRAL GLUTEAL",?73,"7. ABDOMEN"
+44 WRITE ?87,"|"
FOR J=88:1:114
WRITE "-"
+45 WRITE ?115,"|"
FOR J=116:1:131
WRITE "-"
+46 WRITE ?132,"|"
FOR J=133:1:139
WRITE "-"
+47 WRITE ?140,"|"
+48 WRITE !,"|"
FOR J=2:1:39
WRITE "-"
+49 WRITE ?40,"|"
FOR J=41:1:47
WRITE "-"
+50 WRITE ?48,"|"
+51 WRITE ?49,"3. GLUTEUS MEDIUS",?73,"8. THIGH"
+52 WRITE ?87,"|"
FOR J=88:1:114
WRITE "-"
+53 WRITE ?115,"|"
FOR J=116:1:131
WRITE "-"
+54 WRITE ?132,"|"
FOR J=133:1:139
WRITE "-"
+55 WRITE ?140,"|"
+56 WRITE !,"|"
FOR J=2:1:39
WRITE "-"
+57 WRITE ?40,"|"
FOR J=41:1:47
WRITE "-"
+58 WRITE ?48,"|"
+59 WRITE ?49,"4. MED (ANTERIOR) THIGH",?73,"9. BUTTOCK"
+60 WRITE ?87,"|"
FOR J=88:1:114
WRITE "-"
+61 WRITE ?115,"|"
FOR J=116:1:131
WRITE "-"
+62 WRITE ?132,"|"
FOR J=133:1:139
WRITE "-"
+63 WRITE ?140,"|"
+64 WRITE !,"|"
FOR J=2:1:39
WRITE "-"
+65 WRITE ?40,"|"
FOR J=41:1:47
WRITE "-"
+66 WRITE ?48,"|"
+67 WRITE ?49,"5. VASTUS LATERALIS",?73,"10. UPPER BACK"
+68 WRITE ?87,"|"
FOR J=88:1:114
WRITE "-"
+69 WRITE ?115,"|"
FOR J=116:1:131
WRITE "-"
+70 WRITE ?132,"|"
FOR J=133:1:139
WRITE "-"
+71 WRITE ?140,"|"
+72 WRITE !,"|"
FOR J=2:1:39
WRITE "-"
+73 WRITE ?40,"|"
FOR J=41:1:47
WRITE "-"
+74 WRITE ?48,"|"
+75 WRITE ?50," PRN: E=Effective N=Not Effective"
+76 WRITE ?87,"|"
FOR J=88:1:114
WRITE "-"
+77 WRITE ?115,"|"
FOR J=116:1:131
WRITE "-"
+78 WRITE ?132,"|"
FOR J=133:1:139
WRITE "-"
+79 WRITE ?140,"|"
+80 WRITE !
FOR J=1:1:140
WRITE "-"
+81 WRITE ?140,"|"
+82 KILL ALPBDAYS,DAY,ALPBOIEN,ALPBORDN,ALPBOST,ALPBOTYP,ALPBPG,ALPBPT,ALPBRDAT,^TMP($JOB)
+83 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+84 ;
+85 ; write form feed at end if output device is a printer...
+86 IF $EXTRACT(IOST)="P"
WRITE @IOF
+87 QUIT
