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

ALPBPPAT.m

Go to the documentation of this file. 
  1. ALPBPPAT ;OIFO-DALLAS MW,SED,KC-PRINT 3-DAY MAR BCBU BACKUP REPORT FOR A SELECTED PATIENT ;01/01/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.  .; get all or just current orders?...
  1.  .S DIR(0)="SA^A:ALL;C:CURRENT"
  1.  .S DIR("A")="Report [A]LL or [C]URRENT orders? "
  1.  .S DIR("B")="CURRENT"
  1.  .S DIR("?")="[A]LL=all orders in the file, [C]URRENT=orders not yet expired."
  1.  .W ! D ^DIR K DIR
  1.  .I $D(DIRUT) K DIRUT,DTOUT,X,Y Q
  1.  .S ALPBOTYP=Y
  1.  .;
  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.  .; BCMA Med Log info for how many ?...
  1.  .S DIR(0)="NA^1:99"
  1.  .S DIR("B")=$$DEFML^ALPBUTL3()
  1.  .S DIR("A")="Select how many BCMA Medication Log history: "
  1.  .S DIR("A",1)=" "
  1.  .S DIR("?",1)="Select a number of BCMA Medication log entries"
  1.  .S DIR("?",2)="for each of the patient's orders"
  1.  .S DIR("?")="They are listed by the most current entry first"
  1.  .D ^DIR K DIR
  1.  .I $D(DIRUT) K ALPBOTYP,ALPBWARD,DIRUT,DTOUT,X,Y Q
  1.  .S ALPBMLOG=Y
  1.  .;
  1.  .S %ZIS="Q"
  1.  .S %ZIS("B")=$$DEFPRT^ALPBUTL()
  1.  .I %ZIS("B")="" K %ZIS("B")
  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^ALPBPPAT"
  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=$$NOW^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.  ;
  1.  ; loop through orders and sort by order status...
  1.  S ALPBOIEN=0
  1.  F  S ALPBOIEN=$O(^ALPB(53.7,ALPBIEN,2,ALPBOIEN)) Q:'ALPBOIEN  D
  1.  .M ALPBDATA=^ALPB(53.7,ALPBIEN,2,ALPBOIEN)
  1.  .; if report type is "C"urrent and stop date is less than
  1.  .; report date, quit...
  1.  .I ALPBOTYP="C" D  Q:'$D(ALPBDATA)
  1.  ..I $G(ALPBDATA(1))="" K ALPBDATA Q
  1.  ..I $P(ALPBDATA(1),U,2)<ALPBRDAT K ALPBDATA
  1.  .S ALPBORDN=$P(ALPBDATA(0),U)
  1.  .S ALPBOCT=$P($G(ALPBDATA(3)),U,1)
  1.  .S:$P($G(ALPBDATA(4)),U,3)["PRN" ALPBOCT=ALPBOCT_"P"
  1.  .S ALPBOST=$$STAT2^ALPBUTL1($P($G(ALPBDATA(1),"XX"),U,3))
  1.  .S ^TMP($J,ALPBOCT,ALPBOST,ALPBORDN)=ALPBOIEN
  1.  .K ALPBDATA,ALPBOST,ALPBOCT
  1.  ;
  1.  ; loop through the sorted orders...
  1.  S ALPBOCT=""
  1.  F  S ALPBOCT=$O(^TMP($J,ALPBOCT)) Q:ALPBOCT=""  D
  1.  .S ALPBOST=""
  1.  .F  S ALPBOST=$O(^TMP($J,ALPBOCT,ALPBOST)) Q:ALPBOST=""  D
  1.  ..S ALPBORDN=""
  1.  ..F  S ALPBORDN=$O(^TMP($J,ALPBOCT,ALPBOST,ALPBORDN)) Q:ALPBORDN=""  D
  1.  ...S ALPBOIEN=^TMP($J,ALPBOCT,ALPBOST,ALPBORDN)
  1.  ...M ALPBDATA=^ALPB(53.7,ALPBIEN,2,ALPBOIEN)
  1.  ...W !
  1.  ...D F132^ALPBFRM1(.ALPBDATA,ALPBDAYS,ALPBMLOG,.ALPBFORM,ALPBIEN)
  1.  ...; paginate?...
  1.  ...I $Y+ALPBFORM(0)=IOSL!($Y+ALPBFORM(0)>IOSL) D
  1.  ....W @IOF
  1.  ....S ALPBPG=ALPBPG+1
  1.  ....D HDR^ALPBFRMU(.ALPBPT,ALPBPG,.ALPBHDR)
  1.  ....F I=1:1:ALPBHDR(0) W !,ALPBHDR(I)
  1.  ....W !
  1.  ....K ALPBHDR
  1.  ...F I=1:1:ALPBFORM(0) W !,ALPBFORM(I)
  1.  ...K ALPBDATA,ALPBFORM
  1.  ..K ALPBORDN
  1.  .K ALPBOST
  1.  K ALPBOCT
  1.  ;
  1.  ; print footer at end of this patient's record...
  1.  D FOOT^ALPBFRMU
  1.  ;
  1.  K ALPBDAYS,ALPBMLOG,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