| 1 | PSOTALK1 ;BIR/EJW - SCRIPTALK INTERFACE FROM VISTA (CONT'D) ;04/18/2003
 | 
|---|
| 2 |  ;;7.0;OUTPATIENT PHARMACY;**135**;DEC 1997
 | 
|---|
| 3 |  ;External reference to File ^PS(51 supported by DBIA 2224
 | 
|---|
| 4 |  ;ROB SILVERMAN-HINES DEVELOPED ORIGINAL VISTA CUSTOM SOFTWARE FOR SCRIPTALK
 | 
|---|
| 5 | INST ;PARSE OUT PRINTED INSTRUCTIONS TO MAX 46 CHAR PER LINE
 | 
|---|
| 6 |  K PSOLNE
 | 
|---|
| 7 |  S PSOLEN=0,PSOLINE=1,PSOWDS=$L(SIG," ")
 | 
|---|
| 8 |  F PSOWORD=1:1 Q:PSOWORD>PSOWDS  D  ;
 | 
|---|
| 9 |  . S PSOLNE(PSOLINE)=$G(PSOLNE(PSOLINE))_$P(SIG," ",PSOWORD)_" "
 | 
|---|
| 10 |  . S PSOLEN=$G(PSOLEN)+$L($P(SIG," ",PSOWORD))+1
 | 
|---|
| 11 |  . I PSOLEN+$L($P(SIG," ",PSOWORD+1))>46 S PSOLINE=PSOLINE+1,PSOLEN=0
 | 
|---|
| 12 |  Q
 | 
|---|
| 13 |  ;
 | 
|---|
| 14 | LSIG(SIG) ;EXPAND A SIG
 | 
|---|
| 15 |  S SGY="" F P=1:1:$L(SIG," ") S X=$P(SIG," ",P) D:X]""  ;
 | 
|---|
| 16 |  .I $D(^PS(51,"A",X)) S %=^(X),X=$P(%,"^") I $P(%,"^",2)]"" S Y=$P(SIG,"",P-1),Y=$E(Y,$L(Y)) S:Y>1 X=$P(%,"^",2)
 | 
|---|
| 17 |  .S SGY=SGY_X_" "
 | 
|---|
| 18 |  Q SGY
 | 
|---|
| 19 |  ;
 | 
|---|
| 20 | READER(ZDIR0,ZDIRA,ZDIRB) ;BASIC SHELL FOR DIR READS
 | 
|---|
| 21 |  N X,Y,DIRUT,DIROUT,DTOUT,DUOUT,DIR,ZREAD
 | 
|---|
| 22 |  S DIR(0)=ZDIR0 S:$G(ZDIRA)]"" DIR("A")=ZDIRA S:$G(ZDIRB)]"" DIR("B")=ZDIRB
 | 
|---|
| 23 |  D ^DIR K DIR
 | 
|---|
| 24 |  S:Y]"" ZREAD=Y
 | 
|---|
| 25 |  I $D(DTOUT)!($D(DIRUT)) K ZREAD
 | 
|---|
| 26 |  Q $G(ZREAD,"")
 | 
|---|
| 27 |  ;
 | 
|---|
| 28 | PSOSTALK ; SEE IF SCRIPTALK PATIENT AND PRINTER EXISTS AND IS SET TO AUTO-PRINT
 | 
|---|
| 29 |  S PSOSTALK=0
 | 
|---|
| 30 |  D AUTO^PSOTALK
 | 
|---|
| 31 |  I 'PSOSTALK Q
 | 
|---|
| 32 |  D NOW^%DTC S NOW=% K %,%H,%I I $G(RXF)="" S RXF=0 F I=0:0 S I=$O(^PSRX(RX,1,I)) Q:'I  S RXF=I
 | 
|---|
| 33 |  S IR=0 F FDA=0:0 S FDA=$O(^PSRX(RX,"L",FDA)) Q:'FDA  S IR=FDA
 | 
|---|
| 34 |  S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR
 | 
|---|
| 35 |  S ^PSRX(RX,"L",IR,0)=NOW_"^"_$S($G(RXP):99-RXPI,1:RXF)_"^"_"ScripTalk label printed"_$S($G(RXP):" (Partial)",1:"")_$S($D(REPRINT):" (Reprint)",1:"")_"^"_PDUZ_"^"_$G(%ZTIO)
 | 
|---|
| 36 |  Q
 | 
|---|
| 37 |  ;
 | 
|---|