| 1 | PSSUTLAZ ;BIR/RTR-PSS report utility routine ;08/21/00
|
|---|
| 2 | ;;1.0;PHARMACY DATA MANAGEMENT;**40,49**;9/30/97
|
|---|
| 3 | ;
|
|---|
| 4 | EN3(PSSBINTR,PSSBLGTH) ;
|
|---|
| 5 | ;Pass in to EN3 the internal number from 50.7, and the length of the
|
|---|
| 6 | ;array you want. Returns expanded Instructions is PSSBSIG array
|
|---|
| 7 | K PSSBSIG N X,BVAR,BVAR1,III,CNT,NNN,BLIM,Y,PISIG,Z0,Z1,CNTZ,FFF
|
|---|
| 8 | Q:'$G(PSSBINTR)!('$G(PSSBLGTH))
|
|---|
| 9 | S X=$P($G(^PS(50.7,PSSBINTR,"INS")),"^") Q:X=""
|
|---|
| 10 | S PISIG(1)="",CNTZ=1 Q:$L(X)<1 F Z0=1:1:$L(X," ") G:Z0="" START S Z1=$P(X," ",Z0) D G:'$D(X) START
|
|---|
| 11 | .D:$D(X)&($G(Z1)]"") D ADD
|
|---|
| 12 | ..S Y=$O(^PS(51,"B",Z1,0)) Q:'Y!($P($G(^PS(51,+Y,0)),"^",4)>1) S Z1=$P($G(^PS(51,Y,0)),"^",2) Q:'$D(^(9)) S Y=$P(X," ",Z0-1),Y=$E(Y,$L(Y)) S:Y>1 Z1=^(9)
|
|---|
| 13 | START ;
|
|---|
| 14 | S (BVAR,BVAR1)="",III=1
|
|---|
| 15 | F FFF=0:0 S FFF=$O(PISIG(FFF)) Q:'FFF S CNT=0 F NNN=1:1:$L(PISIG(FFF)) I $E(PISIG(FFF),NNN)=" "!($L(PISIG(FFF))=NNN) S CNT=CNT+1 D I $L(BVAR)>PSSBLGTH S PSSBSIG(III)=BLIM_" ",III=III+1,BVAR=BVAR1
|
|---|
| 16 | .S BVAR1=$P(PISIG(FFF)," ",(CNT))
|
|---|
| 17 | .S BLIM=BVAR
|
|---|
| 18 | .S BVAR=$S(BVAR="":BVAR1,1:BVAR_" "_BVAR1)
|
|---|
| 19 | I $G(BVAR)'="" S PSSBSIG(III)=BVAR
|
|---|
| 20 | I $G(PSSBSIG(1))=""!($G(PSSBSIG(1))=" ") S PSSBSIG(1)=$G(PSSBSIG(2)) K PSSBSIG(2)
|
|---|
| 21 | F CNTZ=0:0 S CNTZ=$O(PSSBSIG(CNTZ)) Q:'CNTZ S PSSX("PI",CNTZ)=$G(PSSBSIG(CNTZ))
|
|---|
| 22 | K PSSBSIG
|
|---|
| 23 | Q
|
|---|
| 24 | ADD ;
|
|---|
| 25 | I $L(PISIG(CNTZ))+$L(Z1)+1<246 S PISIG(CNTZ)=PISIG(CNTZ)_" "_Z1 Q
|
|---|
| 26 | S CNTZ=CNTZ+1 S PISIG(CNTZ)=Z1
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | DEA(PSSDIENM) ;Return DEA Special Handling for CPRS Dose Call
|
|---|
| 30 | ;1 Requires wet sig, DEA contains 1, or a 2
|
|---|
| 31 | ;2 = Controlled Sub, no wet sig required, DEA contains 3, 4, or 5
|
|---|
| 32 | ;0 = others
|
|---|
| 33 | Q:'$G(PSSDIENM)
|
|---|
| 34 | N PSSDEAX,PSSDEAXV
|
|---|
| 35 | S PSSDEAX=$P($G(^PSDRUG(PSSDIENM,0)),"^",3)
|
|---|
| 36 | I PSSDEAX[1!(PSSDEAX[2) S PSSDEAXV=1 G DSET
|
|---|
| 37 | I PSSDEAX[3!(PSSDEAX[4)!(PSSDEAX[5) S PSSDEAXV=2 G DSET
|
|---|
| 38 | S PSSDEAXV=0
|
|---|
| 39 | DSET ;
|
|---|
| 40 | S PSSX("DD",PSSDIENM)=PSSX("DD",PSSDIENM)_"^"_PSSDEAXV
|
|---|
| 41 | Q
|
|---|
| 42 | HELP ;
|
|---|
| 43 | Q:$G(X)=""
|
|---|
| 44 | N PSSSIG,PSSYX,PSSZ0,PSSZ1,PSSCTX,PSSLPX,PSSBVAR,PSSBVAR1,PSSIII,PSSFFF,PCT,PNNN,PSSBLIM,PSSIG
|
|---|
| 45 | S PSSIG(1)="",PSSCTX=1 Q:$L(X)<1 F PSSZ0=1:1:$L(X," ") G:PSSZ0="" HELP1 S PSSZ1=$P(X," ",PSSZ0) D G:'$D(X) HELP1
|
|---|
| 46 | .D:$D(X)&($G(PSSZ1)]"") D HELPADD
|
|---|
| 47 | ..S PSSYX=$O(^PS(51,"B",PSSZ1,0)) Q:'PSSYX!($P($G(^PS(51,+PSSYX,0)),"^",4)>1) S PSSZ1=$P($G(^PS(51,PSSYX,0)),"^",2) Q:'$D(^(9)) S PSSYX=$P(X," ",PSSZ0-1),PSSYX=$E(PSSYX,$L(PSSYX)) S:PSSYX>1 PSSZ1=^(9)
|
|---|
| 48 | HELP1 ;
|
|---|
| 49 | S (PSSBVAR,PSSBVAR1)="",PSSIII=1
|
|---|
| 50 | F PSSFFF=0:0 S PSSFFF=$O(PSSIG(PSSFFF)) Q:'PSSFFF S PCT=0 F PNNN=1:1:$L(PSSIG(PSSFFF)) I $E(PSSIG(PSSFFF),PNNN)=" "!($L(PSSIG(PSSFFF))=PNNN) S PCT=PCT+1 D I $L(PSSBVAR)>70 S PSSSIG(PSSIII)=PSSBLIM_" ",PSSIII=PSSIII+1,PSSBVAR=PSSBVAR1
|
|---|
| 51 | .S PSSBVAR1=$P(PSSIG(PSSFFF)," ",(PCT))
|
|---|
| 52 | .S PSSBLIM=PSSBVAR
|
|---|
| 53 | .S PSSBVAR=$S(PSSBVAR="":PSSBVAR1,1:PSSBVAR_" "_PSSBVAR1)
|
|---|
| 54 | I $G(PSSBVAR)'="" S PSSSIG(PSSIII)=PSSBVAR
|
|---|
| 55 | I $G(PSSSIG(1))=""!($G(PSSSIG(1))=" ") S PSSSIG(1)=$G(PSSSIG(2)) K PSSSIG(2)
|
|---|
| 56 | F PSSLPX=0:0 S PSSLPX=$O(PSSSIG(PSSLPX)) Q:'PSSLPX D:PSSLPX=1 EN^DDIOL(" ") D EN^DDIOL(" "_$G(PSSSIG(PSSLPX)))
|
|---|
| 57 | Q
|
|---|
| 58 | HELPADD ;
|
|---|
| 59 | I $L(PSSIG(PSSCTX))+$L(PSSZ1)+1<246 S PSSIG(PSSCTX)=PSSIG(PSSCTX)_" "_PSSZ1 Q
|
|---|
| 60 | S PSSCTX=PSSCTX+1 S PSSIG(PSSCTX)=PSSZ1
|
|---|
| 61 | Q
|
|---|
