source: WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBOIV1.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.4 KB
Line 
1PSBOIV1 ;BIRMINGHAM/TEJ-IV BAG STATUS 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 ;
5FORMDAT(FLD) ;
6 K PSBVAL
7 S PSBVAL=PSBDATA(FLD)
8 D WRAPPER(@("PSBTAB"_(FLD-1))+1,((@("PSBTAB"_(FLD))-(@("PSBTAB"_(FLD-1))+1))),PSBVAL)
9 Q
10WRAPPER(X,Y,Z) ; Text WRAP
11 N PSB
12 I ($L(Z)>0),$F(Z,"""")>1 F Q:$F(Z,"""")'>1 S Z=$TR(Z,"""","^")
13 F Q:'$L(Z) D
14 .I $L(Z)<Y S $E(PSBRPLN(J),X)=Z S Z="" D Q
15 ..I $L(PSBRPLN(J),"^")>1 F INX=1:1:$L(PSBRPLN(J),"^")-1 S $P(PSBRPLN(J),"^",INX)=$P(PSBRPLN(J),"^",INX)_""""
16 ..S PSBRPLN(J)=$TR(PSBRPLN(J),"^","""")
17 ..S J(J)="",J=J+1
18 .F PSB=Y:-1:0 Q:$E(Z,PSB)=" "
19 .S:PSB<1 PSB=Y
20 .S $E(PSBRPLN(J),X)=$E(Z,1,PSB)
21 .S Z=$E(Z,PSB+1,250)
22 .I $L(PSBRPLN(J),"^")>1 F INX=1:1:$L(PSBRPLN(J),"^")-1 S $P(PSBRPLN(J),"^",INX)=$P(PSBRPLN(J),"^",INX)_""""
23 .S PSBRPLN(J)=$TR(PSBRPLN(J),"^","""")
24 .S J(J)="",J=J+1
25 Q 0
26FMTDT(Y) ;
27 N X S X=$E(Y,4,5) X ^DD("DD") S Y=$TR(Y," ,:","//") S $P(Y,"/")=X
28 Q Y
29SUBHDR ;
30 N PSBAL S PSBAL=$O(PSBHDR("ALERGY",""),-1) S PSBAL=$S((PSBAL/12)>(PSBAL\12):(PSBAL\12)+1,1:(PSBAL\12))
31 N PSBRE S PSBRE=$O(PSBHDR("REAC",""),-1) S PSBRE=$S((PSBRE/12)>(PSBRE\12):(PSBRE\12)+1,1:(PSBRE\12))
32 S PSBLNTOT=$O(PSBHDR(""),-1)+9+PSBAL+PSBRE+1
33 W !,$G(PSBHD1,"") S PSBLNTOT=PSBLNTOT+1
34 W !,$G(PSBHD2,"") S PSBLNTOT=PSBLNTOT+1
35 W !,$TR($J("",PSBTAB8)," ","="),! S PSBLNTOT=PSBLNTOT+2
36 Q
Note: See TracBrowser for help on using the repository browser.