| 1 | PSBOIV1 ;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 | ;
|
|---|
| 5 | FORMDAT(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
|
|---|
| 10 | WRAPPER(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
|
|---|
| 26 | FMTDT(Y) ;
|
|---|
| 27 | N X S X=$E(Y,4,5) X ^DD("DD") S Y=$TR(Y," ,:","//") S $P(Y,"/")=X
|
|---|
| 28 | Q Y
|
|---|
| 29 | SUBHDR ;
|
|---|
| 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
|
|---|
