[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
|
---|