| 1 | PSBOCI1 ;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 | ; | 
|---|
| 6 | BUILDLN ; 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 | 
|---|
| 26 | PTFTR ;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 | 
|---|