source: FOIAVistA/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBOCP1.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.0 KB
Line 
1PSBOCP1 ;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 ;
5WRTRPT ; 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
17CREATHDR ;
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
26HD132A ;~ VDL | Status |Type| Medication; Dosage, Route | Last Given | Since | Order Start | Order Stop |
27 Q
28HD132B ; Tab | | | | | Last Given | Date | Date |
29 Q
30C132BLK ;; | | | | | | | |
31 Q
32HDR ; 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
43FTR ; 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
Note: See TracBrowser for help on using the repository browser.