Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ALPBBK

ALPBBK.m

Go to the documentation of this file. 
  1. 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
  1.  ; 
  1.  ; NOTE: this routine is designed for hard-copy output.
  1.  ;       Output is formatted for 132-column printing.
  1.  ;
  1.  F  D  Q:$D(DIRUT)
  1.  .W !!,"Inpatient Pharmacy Orders for a selected patient"
  1.  .S DIR(0)="PAO^53.7:QEMZ"
  1.  .S DIR("A")="Select PATIENT NAME: "
  1.  .D ^DIR K DIR
  1.  .I $D(DIRUT) K X,Y Q
  1.  .S ALPBIEN=+Y
  1.  .S ALPBPTN=Y(0,0)
  1.  .S %ZIS="Q"
  1.  .S %ZIS("B")=$$DEFPRT^ALPBUTL()
  1.  .I %ZIS("B")="" K %ZIS("B")
  1.  .; print how many days MAR?...
  1.  .S DIR(0)="NA^3:7"
  1.  .S DIR("A")="Print how many days MAR? "
  1.  .S DIR("B")=$$DEFDAYS^ALPBUTL()
  1.  .S DIR("?")="The default is shown; you may select 3 or 7."
  1.  .W ! D ^DIR K DIR
  1.  .I $D(DIRUT) K ALPBOTYP,DIRUT,DTOUT,X,Y Q
  1.  .S ALPBDAYS=+Y
  1.  .;
  1.  .W ! D ^%ZIS K %ZIS
  1.  .I POP D  Q
  1.  ..K ALPBIEN,ALPBPTN,POP
  1.  .;
  1.  .; output not queued...
  1.  .I '$D(IO("Q")) D
  1.  ..U IO
  1.  ..D DQ
  1.  ..I IO'=IO(0) D ^%ZISC
  1.  .;
  1.  .; set up the Task...
  1.  .I $D(IO("Q")) D
  1.  ..S ZTRTN="DQ^ALPBBK"
  1.  ..S ZTIO=ION
  1.  ..S ZTDESC="PSB INPT PHARM ORDERS FOR "_ALPBPTN
  1.  ..S ZTSAVE("ALPBDAYS")=""
  1.  ..S ZTSAVE("ALPBIEN")=""
  1.  ..S ZTSAVE("ALPBMLOG")=""
  1.  ..S ZTSAVE("ALPBOTYP")=""
  1.  ..D ^%ZTLOAD
  1.  ..D HOME^%ZIS
  1.  ..W !!,$S(+$G(ZTSK):"Task "_ZTSK_" queued.",1:"ERROR: NOT QUEUED!")
  1.  ..K IO("Q"),ZTSK
  1.  .;
  1.  .K ALPBDAYS,ALPBIEN,ALPBMLOG,ALPBOTYP,ALPBPTN,X,Y
  1.  K DIRUT,DTOUT,X,Y
  1.  Q
  1.  ;
  1. DQ ; output entry point...
  1.  K ^TMP($J)
  1.  ;
  1.  ; set report date...
  1.  S ALPBRDAT=$$DT^XLFDT()
  1.  S ALPBPT(0)=$G(^ALPB(53.7,ALPBIEN,0))
  1.  M ALPBPT(1)=^ALPB(53.7,ALPBIEN,1)
  1.  S ALPBPG=1
  1.  D HDR^ALPBFRMU(.ALPBPT,ALPBPG,.ALPBHDR)
  1.  F I=1:1:ALPBHDR(0) W !,ALPBHDR(I)
  1.  K ALPBHDR
  1.  S FOOT=0
  1.  S DAY=ALPBDAYS
  1.  S FOOT=FOOT+1 S MST=$S(DAY=3:83,DAY=7:105,DAY=14:140)
  1.  S NST=$S(DAY=3:95,DAY=7:120,DAY=14:135)
  1.  W !?61,"Admin" D MON^ALPBUTL3(DAY) W ?74,MON D ARRAY^ALPBUTL3(DAY)
  1.  W !,?2,"Order",?13,"Start",?35,"Stop",?61,"Times" D START^ALPBUTL3(DAY) W ?NST,"Notes"
  1.  W ! F J=1:1:142 W "-"
  1.  S ADM(7)=""
  1.  F JY=1:0:4 DO  Q:JY=5
  1.  .W !,"____________|______________________|___________________",?59," |",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
  1.  .W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
  1.  .W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
  1.  .W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
  1.  .W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
  1.  .W !?60,"|",ADM(7),?72,"|" F J=72:5:MST W ?J,"_____|"
  1.  .W !!!,?5,"RPH Verify:___________    Nurse Verify:____________"
  1.  .W ! F J=1:1:142 W "-"
  1.  .S JY=JY+1
  1.  D STOP
  1.  Q
  1. STOP D FOOT
  1.  K PTNAME,WARD,SSN,BED,ST,ROOM,Y,DOB,J,IENM,DFN,NST,ANS,FOOT,SEX,ADMIN(7),PCOUNT,CURRENT,MST
  1.  Q
  1.  W !,"|",?13,"SIGNATURE/TITLE",?40,"| INIT",?48,"|",?60,"INJECTION SITES",?87,"|",?92,"MED/DOSE OMITTED",?115,"|",?120,"REASON",?132,"|",?135,"INIT",?140,"|"
  1.  W !,"|" F J=2:1:39 W "-"
  1.  W ?40,"|" F J=41:1:47 W "-"
  1.  W ?48,"|" F J=49:1:84 W "-"
  1.  W ?87,"|" F J=88:1:114 W "-"
  1.  W ?115,"|" F J=116:1:131 W "-"
  1.  W ?132,"|" F J=133:1:139 W "-"
  1.  W ?140,"|"
  1.  W !,"|" F J=2:1:39 W "-"
  1.  W ?40,"|" F J=41:1:47 W "-"
  1.  W ?48,"|"
  1.  W ?52,"Indicate RIGHT (R) or LEFT (L)"
  1.  W ?87,"|" F J=88:1:114 W "-"
  1.  W ?115,"|" F J=116:1:131 W "-"
  1.  W ?132,"|" F J=133:1:139 W "-"
  1.  W ?140,"|"
  1.  W !,"|" F J=2:1:39 W "-"
  1.  W ?40,"|" F J=41:1:47 W "-"
  1.  W ?48,"|"
  1.  W ?87,"|" F J=88:1:112 W "-"
  1.  W ?115,"|" F J=116:1:129 W "-"
  1.  W ?132,"|" F J=133:1:137 W "-"
  1.  W ?140,"|"
  1.  W !,"|" F J=2:1:39 W "-"
  1.  W ?40,"|" F J=41:1:47 W "-"
  1.  W ?48,"|"
  1.  W ?53,"(IM)",?75,"(SUB Q)"
  1.  W ?87,"|" F J=88:1:114 W "-"
  1.  W ?115,"|" F J=116:1:131 W "-"
  1.  W ?132,"|" F J=133:1:139 W "-"
  1.  W ?140,"|"
  1.  W !,"|" F J=2:1:39 W "-"
  1.  W ?40,"|" F J=41:1:47 W "-"
  1.  W ?48,"|"
  1.  W ?49,"1. DELTOID",?73,"6. UPPER ARM"
  1.  W ?87,"|" F J=88:1:114 W "-"
  1.  W ?115,"|" F J=116:1:131 W "-"
  1.  W ?132,"|" F J=133:1:139 W "-"
  1.  W ?140,"|"
  1.  W !,"|" F J=2:1:39 W "-"
  1.  W ?40,"|" F J=41:1:47 W "-"
  1.  W ?48,"|"
  1.  W ?49,"2. VENTRAL GLUTEAL",?73,"7. ABDOMEN"
  1.  W ?87,"|" F J=88:1:114 W "-"
  1.  W ?115,"|" F J=116:1:131 W "-"
  1.  W ?132,"|" F J=133:1:139 W "-"
  1.  W ?140,"|"
  1.  W !,"|" F J=2:1:39 W "-"
  1.  W ?40,"|" F J=41:1:47 W "-"
  1.  W ?48,"|"
  1.  W ?49,"3. GLUTEUS MEDIUS",?73,"8. THIGH"
  1.  W ?87,"|" F J=88:1:114 W "-"
  1.  W ?115,"|" F J=116:1:131 W "-"
  1.  W ?132,"|" F J=133:1:139 W "-"
  1.  W ?140,"|"
  1.  W !,"|" F J=2:1:39 W "-"
  1.  W ?40,"|" F J=41:1:47 W "-"
  1.  W ?48,"|"
  1.  W ?49,"4. MED (ANTERIOR) THIGH",?73,"9. BUTTOCK"
  1.  W ?87,"|" F J=88:1:114 W "-"
  1.  W ?115,"|" F J=116:1:131 W "-"
  1.  W ?132,"|" F J=133:1:139 W "-"
  1.  W ?140,"|"
  1.  W !,"|" F J=2:1:39 W "-"
  1.  W ?40,"|" F J=41:1:47 W "-"
  1.  W ?48,"|"
  1.  W ?49,"5. VASTUS LATERALIS",?73,"10. UPPER BACK"
  1.  W ?87,"|" F J=88:1:114 W "-"
  1.  W ?115,"|" F J=116:1:131 W "-"
  1.  W ?132,"|" F J=133:1:139 W "-"
  1.  W ?140,"|"
  1.  W !,"|" F J=2:1:39 W "-"
  1.  W ?40,"|" F J=41:1:47 W "-"
  1.  W ?48,"|"
  1.  W ?50," PRN: E=Effective  N=Not Effective"
  1.  W ?87,"|" F J=88:1:114 W "-"
  1.  W ?115,"|" F J=116:1:131 W "-"
  1.  W ?132,"|" F J=133:1:139 W "-"
  1.  W ?140,"|"
  1.  W ! F J=1:1:140 W "-"
  1.  W ?140,"|"
  1.  K ALPBDAYS,DAY,ALPBOIEN,ALPBORDN,ALPBOST,ALPBOTYP,ALPBPG,ALPBPT,ALPBRDAT,^TMP($J)
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1.  ;
  1.  ; write form feed at end if output device is a printer...
  1.  I $E(IOST)="P" W @IOF
  1.  Q