| [613] | 1 | PSOLBL3 ;BHAM ISC/RTR-Label utility routine ; 7/10/94
|
|---|
| 2 | ;;7.0;OUTPATIENT PHARMACY;**117**;DEC 1997
|
|---|
| 3 | ;External reference ^PS(55 supported by DBIA 2228
|
|---|
| 4 | ;
|
|---|
| 5 | ;RX must be defined (Internal), Check already done for OERR SIG
|
|---|
| 6 | ;Format OERR Sig for New and Old label stock
|
|---|
| 7 | N CTCT,FFFF,LLIM,LLLL,LVAR,LVAR1,PPP,PPPP,SGCT,SIG9,OSIG,ZZZZ,PSLONG,PPPP
|
|---|
| 8 | I $P($G(^PS(55,DFN,"LAN")),"^") D OTHL G:$G(FND) FMSIG
|
|---|
| 9 | S PSLONG=$S($P(PSOPAR,"^",28):46,1:34)
|
|---|
| 10 | ; NEXT LINE IF SIG IS MOVED BACK TO MULTIPLE
|
|---|
| 11 | S PPPP=1 F PPP=0:0 S PPP=$O(^PSRX(RX,"SIG1",PPP)) Q:'PPP I $G(^PSRX(RX,"SIG1",PPP,0))'="" S SIG9(PPPP)=^(0) S PPPP=PPPP+1
|
|---|
| 12 | ;NEXT LINE IF 1ST FRONT DOOR SIG LINE LIVES IN BACK DOOR SPOT
|
|---|
| 13 | ;S SIG9(1)=$P($G(^PSRX(RX,"SIG")),"^") S PPP=2 F PPPP=0:0 S PPPP=$O(^PSRX(RX,"SIG1",PPPP)) Q:'PPPP I $G(^(PPPP,0))'="" S SIG9(PPP)=$G(^(0)),PPP=PPP+1
|
|---|
| 14 | FMSIG S (LVAR,LVAR1)="",LLLL=1
|
|---|
| 15 | F FFFF=0:0 S FFFF=$O(SIG9(FFFF)) Q:'FFFF S SGCT=0 F ZZZZ=1:1:$L(SIG9(FFFF)) I $E(SIG9(FFFF),ZZZZ)=" "!($L(SIG9(FFFF))=ZZZZ) S SGCT=SGCT+1 D I $L(LVAR)>PSLONG S SGY(LLLL)=LLIM_" ",LLLL=LLLL+1,LVAR=LVAR1
|
|---|
| 16 | .S LVAR1=$P(SIG9(FFFF)," ",(SGCT))
|
|---|
| 17 | .S LLIM=LVAR
|
|---|
| 18 | .S LVAR=$S(LVAR="":LVAR1,1:LVAR_" "_LVAR1)
|
|---|
| 19 | I $G(LVAR)'="" S SGY(LLLL)=LVAR
|
|---|
| 20 | I '$P(PSOPAR,"^",28) S SGC=0 F CTCT=0:0 S CTCT=$O(SGY(CTCT)) Q:'CTCT S SGC=SGC+1
|
|---|
| 21 | I $O(OSGY(0)) D
|
|---|
| 22 | .F I=0:0 S I=$O(SGY(I)) Q:'I I $G(OSGY(I))']"" S OSGY(I)=" "
|
|---|
| 23 | .F I=0:0 S I=$O(OSGY(I)) Q:'I I $G(SGY(I))']"" S SGY(I)=" "
|
|---|
| 24 | Q
|
|---|
| 25 | OTHL ;other lang. mod
|
|---|
| 26 | K P,PP,L,SPSIG,SIG9,OSIG,SIG2,OSGY S PSLONG=46,OI=$P(^PSRX(RX,"OR1"),"^")
|
|---|
| 27 | F I=0:0 S I=$O(^PSRX(RX,6,I)) Q:'I S INST=^(I,0) D
|
|---|
| 28 | .S SPSIG("DOSE",I)=$S($G(^PSRX(RX,6,I,1))]"":^PSRX(RX,6,I,1),1:$P(INST,"^")),SPSIG("DOSE ORDERED",I)=$P(INST,"^",2),SPSIG("UNITS",I)=$P(INST,"^",3),SPSIG("NOUN",I)=$P(INST,"^",4)
|
|---|
| 29 | .I $P(INST,"^",5)]"" S SPSIG("DURATION",I)=$S($E($P(INST,"^",5),1)'?.N:$E($P(INST,"^",5),2,99)_$E($P(INST,"^",5),1),1:$P(INST,"^",5))
|
|---|
| 30 | .S SPSIG("ROUTE",I)=$P(INST,"^",7),SPSIG("SCHEDULE",I)=$P(INST,"^",8)
|
|---|
| 31 | .S SPSIG("CONJUNCTION",I)=$P(INST,"^",6),SPSIG("VERB",I)=$P(INST,"^",9)
|
|---|
| 32 | S SPSIG("SIG",1)=$S($G(^PSRX(RX,"INSS"))]"":^PSRX(RX,"INSS"),1:"")
|
|---|
| 33 | NX K I,T S OTHL=1 D EN^PSOSPSIG(.SPSIG)
|
|---|
| 34 | S PP=1 F P=0:0 S P=$O(^PSRX(RX,"SIG1",P)) Q:'P I $G(^PSRX(RX,"SIG1",P,0))'="" S OSIG(PP)=^(0) S PP=PP+1
|
|---|
| 35 | S (LVAR,LVAR1)="",L=1
|
|---|
| 36 | F F=0:0 S F=$O(OSIG(F)) Q:'F S SGCT=0 F Z=1:1:$L(OSIG(F)) I $E(OSIG(F),Z)=" "!($L(OSIG(F))=Z) S SGCT=SGCT+1 D I $L(LVAR)>PSLONG S OSGY(L)=LLIM_" ",L=L+1,LVAR=LVAR1
|
|---|
| 37 | .S LVAR1=$P(OSIG(F)," ",(SGCT)),LLIM=LVAR,LVAR=$S(LVAR="":LVAR1,1:LVAR_" "_LVAR1)
|
|---|
| 38 | I $G(LVAR)'="" S OSGY(L)=LVAR
|
|---|
| 39 | I '$P(PSOPAR,"^",28) S SGC=0 F CTCT=0:0 S CTCT=$O(OSGY(CTCT)) Q:'CTCT S SGC=SGC+1
|
|---|
| 40 | K OI,SPSIG,INST,I,T,OTHL,L,PP,P,OSIG,F
|
|---|
| 41 | Q
|
|---|
| 42 | OTHL1(RX) ;builds cmop other lang. sig for transmission
|
|---|
| 43 | D OTHL K SIG9,PSLONG,OI
|
|---|
| 44 | Q
|
|---|
