source: WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBOCI1.m@ 949

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1PSBOCI1 ;BIRMINGHAM/TEJ-COVERSHEET IV 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 ;
6BUILDLN ; Constr recs
7 K J S J(0)="" F PSBFLD=1:1:7 S J=1 D FORMDAT^PSBOCE1(PSBFLD) S J($O(PSBRPLN(""),-1))=""
8 ; Write administration info...
9 Q:'PSBXFLG
10 ; Get Actions
11 K PSBXDTL S (PSBXDTL,N,Y)="",J=($O(J(""),-1)+1)
12 D BAGDTL^PSBRPC2(.PSBXDTL,XI,PSBX2X)
13 I $D(PSBXDTL(1)) I +$P(PSBXDTL(1),U)=-1 S PSBRPLN(J)=PSBBLANK,J(J)="",J=J+1 Q
14 S J=($O(J(""),-1)+1),PSBRPLN(J)=PSBBLANK,J(J)="",J=J+1
15 F Y=1:1:PSBXDTL(0) S N=PSBXDTL(Y) D
16 .Q:('PSBCFLG)&($P(N,U,3)']"")
17 .S $E(PSBDATA(2,0),25)="BY: "_$P(N,U,2)_" "_$$FMTDT^PSBOCE1($E($P(N,U),1,12))
18 .S $E(PSBDATA(2,0),49)="ACTION: "_$P(N,U,3)
19 .I $G(PSBDATA(2,0))]" " D WRAPPER^PSBOCE1(1,132-1,PSBDATA(2,0)) K PSBDATA(2) S J=J+1
20 .M PSBLGD("INITIALS")=PSBLGD(PSBX2X,"INITIALS")
21 .Q:('PSBCFLG)!($P(N,U,4)']"")
22 .S PSBDATA(2,0)=$G(PSBDATA(2,0),"")_" COMMENT: "_$P(N,U,4)
23 .I $G(PSBDATA(2,0))]" " D WRAPPER^PSBOCE1(49,132-49,PSBDATA(2,0)) K PSBDATA(2) S J=J+1
24 S PSBRPLN(J)=PSBBLANK,J(J)="",J=J+1
25 Q
26PTFTR ;Patient Page footer
27 I (IOSL<100) F Q:$Y>(IOSL-7) W !
28 W !,$TR($J("",IOM)," ","=")
29 S X="Ward: "_PSBHDR("WARD")_" Room-Bed: "_PSBHDR("ROOM")
30 W !,PSBHDR("NAME"),?(IOM-11\2),PSBHDR("SSN"),?(IOM-$L(X)),X
31 S PSBPG="Page: "_PSBPGNUM_" of "_$S($O(PSBOUTP(""),-1)=0:1,1:$O(PSBOUTP(""),-1))
32 S PSBPGRM=PSBTAB7-($L(PSBPG))
33 W !,PSBRPNM," ",?(PSBPGRM-($L(PSBDTTM)+3)),PSBDTTM_" "_PSBPG
34 Q
Note: See TracBrowser for help on using the repository browser.