| [613] | 1 | PSBOCP1 ;BIRMINGHAM/TEJ-COVERSHEET PRN OVERVIEW REPORT ;Mar 2004
 | 
|---|
 | 2 |  ;;3.0;BAR CODE MED ADMIN;**32**;Mar 2004;Build 32
 | 
|---|
 | 3 |  ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
 | 
|---|
 | 4 |  ;
 | 
|---|
 | 5 | WRTRPT ;  writ
 | 
|---|
 | 6 |  I $O(PSBOUTP(""),-1)<1 D  Q
 | 
|---|
 | 7 |  .X PSBOUTP($O(PSBOUTP(""),-1),14)
 | 
|---|
 | 8 |  .D FTR
 | 
|---|
 | 9 |  S PSBPGNUM=1
 | 
|---|
 | 10 |  S PSBZ="" F  S PSBZ=$O(PSBOUTP(PSBZ)) Q:PSBZ=""  D
 | 
|---|
 | 11 |  .I PSBPGNUM'=PSBZ D FTR S PSBPGNUM=PSBZ D HDR,SUBHDR^PSBOCE
 | 
|---|
 | 12 |  .S PSBX2X="" F  S PSBX2X=$O(PSBOUTP(PSBZ,PSBX2X)) Q:PSBX2X=""  D
 | 
|---|
 | 13 |  ..X PSBOUTP(PSBZ,PSBX2X)
 | 
|---|
 | 14 |  D FTR
 | 
|---|
 | 15 |  K ^XTMP("PSBO",$J,"PSBLIST"),PSBOUTP
 | 
|---|
 | 16 |  Q
 | 
|---|
 | 17 | CREATHDR ;
 | 
|---|
 | 18 |  K PSBHD1,PSBHD2
 | 
|---|
 | 19 |  I IOM'<132 S PSBHD1=$P($T(HD132A),"~",2),PSBHD2=$P($T(HD132B),";",2),PSBBLANK=$P($T(C132BLK),";",2)
 | 
|---|
 | 20 |  E  S PSBHD1="THIS REPORT SUPPORTS >131 CHAR./LINE PRINT FORMATS ONLY" Q
 | 
|---|
 | 21 |  ; reset tabs
 | 
|---|
 | 22 |  S PSBTAB0=1 F PSBI=0:1:($L(PSBHD1,"|")-1) S:PSBI>0 @("PSBTAB"_PSBI)=($F(PSBHD1,"|",@("PSBTAB"_(PSBI-1))+1))-1
 | 
|---|
 | 23 |  S PSBPGNUM=1
 | 
|---|
 | 24 |  D HDR
 | 
|---|
 | 25 |  Q
 | 
|---|
 | 26 | HD132A ;~ VDL |    Status   |Type|      Medication; Dosage, Route      |   Last Given  |      Since    |    Order Start   |    Order Stop   |
 | 
|---|
 | 27 |  Q
 | 
|---|
 | 28 | HD132B ; Tab |             |    |                                     |               |   Last Given  |    Date          |    Date         |
 | 
|---|
 | 29 |  Q
 | 
|---|
 | 30 | C132BLK ;;     |             |    |                                     |               |               |                  |                 |
 | 
|---|
 | 31 |  Q
 | 
|---|
 | 32 | HDR ;  Header
 | 
|---|
 | 33 |  W:$Y>1 @IOF
 | 
|---|
 | 34 |  W:$X>1 !
 | 
|---|
 | 35 |  S PSBRPNM="BCMA COVERSHEET PRN OVERVIEW REPORT"
 | 
|---|
 | 36 |  D:$P(PSBRPT(.1),U,1)="P"
 | 
|---|
 | 37 |  .S PSBHDR(0)=PSBRPNM
 | 
|---|
 | 38 |  .S PSBHDR(1)="Order Status(es): --"
 | 
|---|
 | 39 |  .F Y=4,5,7,8 I $P(PSBFUTR,U,Y) S $P(PSBHDR(1),": ",2)=$P(PSBHDR(1),": ",2)_$S(PSBHDR(1)["--":"",1:"/ ")_$P("^^^Future^Active^^Expired^DC'd^^^^^^^^^^",U,Y)_" " S PSBHDR(1)=$TR(PSBHDR(1),"-","")
 | 
|---|
 | 40 |  .I $P(PSBFUTR,U,11) S PSBHDR(2)="Include Action(s)"_$S(PSBCFLG:" & Comments/Reasons",1:"")
 | 
|---|
 | 41 |  .D PT^PSBOHDR(PSBXDFN,.PSBHDR)
 | 
|---|
 | 42 |  Q
 | 
|---|
 | 43 | FTR ;  Fter
 | 
|---|
 | 44 |  S PSBPG="Page: "_PSBPGNUM_" of "_$S($O(PSBOUTP(""),-1)=0:1,1:$O(PSBOUTP(""),-1))
 | 
|---|
 | 45 |  S PSBPGRM=PSBTAB8-($L(PSBPG))
 | 
|---|
 | 46 |  D PTFTR^PSBOHDR()
 | 
|---|
 | 47 |  W !,PSBRPNM,"     ",?(PSBPGRM-($L(PSBDTTM)+3)),PSBDTTM_"  "_PSBPG
 | 
|---|
 | 48 |  Q
 | 
|---|