PSOTALK1 ;BIR/EJW - SCRIPTALK INTERFACE FROM VISTA (CONT'D) ;11/09/17 12:18
;;7.0;OUTPATIENT PHARMACY;**135,318,282,442,502,541**;DEC 1997;Build 14
;External reference to File ^PS(51 supported by DBIA 2224
;ROB SILVERMAN-HINES DEVELOPED ORIGINAL VISTA CUSTOM SOFTWARE FOR SCRIPTALK
INST ;PARSE OUT PRINTED INSTRUCTIONS TO MAX 46 CHAR PER LINE
K PSOLNE
S PSOLEN=0,PSOLINE=1,PSOWDS=$L(SIG," ")
F PSOWORD=1:1 Q:PSOWORD>PSOWDS D ;
. S PSOLNE(PSOLINE)=$G(PSOLNE(PSOLINE))_$P(SIG," ",PSOWORD)_" "
. S PSOLEN=$G(PSOLEN)+$L($P(SIG," ",PSOWORD))+1
. I PSOLEN+$L($P(SIG," ",PSOWORD+1))>46 S PSOLINE=PSOLINE+1,PSOLEN=0
Q
;
LSIG(SIG) ;EXPAND A SIG
S SGY="" F P=1:1:$L(SIG," ") S X=$P(SIG," ",P) D:X]"" ;
.;PSO*7*282 Intended Use Check
.N PSOIN S PSOIN=$O(^PS(51,"B",X,0)) I PSOIN,($P(^PS(51,PSOIN,0),"^",4)<2)&($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)
.S SGY=SGY_X_" "
Q SGY
;
READER(ZDIR0,ZDIRA,ZDIRB) ;BASIC SHELL FOR DIR READS
N X,Y,DIRUT,DIROUT,DTOUT,DUOUT,DIR,ZREAD
S DIR(0)=ZDIR0 S:$G(ZDIRA)]"" DIR("A")=ZDIRA S:$G(ZDIRB)]"" DIR("B")=ZDIRB
D ^DIR K DIR
S:Y]"" ZREAD=Y
I $D(DTOUT)!($D(DIRUT)) K ZREAD
Q $G(ZREAD,"")
;
PSOSTALK ; SEE IF SCRIPTALK PATIENT AND PRINTER EXISTS AND IS SET TO AUTO-PRINT
N A
S PSOSTALK=0
I $G(PSOONEVA) Q ; Prevents printing ScripTalk Label for OneVA Pharmacy Fills
D AUTO^PSOTALK
I 'PSOSTALK Q
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
S IR=0 F FDA=0:0 S FDA=$O(^PSRX(RX,"L",FDA)) Q:'FDA S IR=FDA
S IR=IR+1,^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR
S ^PSRX(RX,"L",IR,0)=NOW_"^"_$S($G(RXP):99-RXPI,1:RXF)_"^"_"ScripTalk label printed"_$S($G(RXP):" (Partial)",1:"")_$S($G(REPRINT):" (Reprint)",1:"")_"^"_PDUZ_"^^"_$G(PSOLAP) ;*442
S A=$P($G(^PS(59,+PSOSITE,"STALK")),"^",4) I A=0 S PSOSTALK=0
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOTALK1 1917 printed Jun 11, 2024@22:21:21 Page 2
PSOTALK1 ;BIR/EJW - SCRIPTALK INTERFACE FROM VISTA (CONT'D) ;11/09/17 12:18
+1 ;;7.0;OUTPATIENT PHARMACY;**135,318,282,442,502,541**;DEC 1997;Build 14
+2 ;External reference to File ^PS(51 supported by DBIA 2224
+3 ;ROB SILVERMAN-HINES DEVELOPED ORIGINAL VISTA CUSTOM SOFTWARE FOR SCRIPTALK
INST ;PARSE OUT PRINTED INSTRUCTIONS TO MAX 46 CHAR PER LINE
+1 KILL PSOLNE
+2 SET PSOLEN=0
SET PSOLINE=1
SET PSOWDS=$LENGTH(SIG," ")
+3 ;
FOR PSOWORD=1:1
if PSOWORD>PSOWDS
QUIT
Begin DoDot:1
+4 SET PSOLNE(PSOLINE)=$GET(PSOLNE(PSOLINE))_$PIECE(SIG," ",PSOWORD)_" "
+5 SET PSOLEN=$GET(PSOLEN)+$LENGTH($PIECE(SIG," ",PSOWORD))+1
+6 IF PSOLEN+$LENGTH($PIECE(SIG," ",PSOWORD+1))>46
SET PSOLINE=PSOLINE+1
SET PSOLEN=0
End DoDot:1
+7 QUIT
+8 ;
LSIG(SIG) ;EXPAND A SIG
+1 ;
SET SGY=""
FOR P=1:1:$LENGTH(SIG," ")
SET X=$PIECE(SIG," ",P)
if X]""
Begin DoDot:1
+2 ;PSO*7*282 Intended Use Check
+3 NEW PSOIN
SET PSOIN=$ORDER(^PS(51,"B",X,0))
IF PSOIN
IF ($PIECE(^PS(51,PSOIN,0),"^",4)<2)&($DATA(^PS(51,"A",X)))
SET %=^(X)
SET X=$PIECE(%,"^")
IF $PIECE(%,"^",2)]""
SET Y=$PIECE(SIG,"",P-1)
SET Y=$EXTRACT(Y,$LENGTH(Y))
if Y>1
SET X=$PIECE(%,"^",2)
+4 SET SGY=SGY_X_" "
End DoDot:1
+5 QUIT SGY
+6 ;
READER(ZDIR0,ZDIRA,ZDIRB) ;BASIC SHELL FOR DIR READS
+1 NEW X,Y,DIRUT,DIROUT,DTOUT,DUOUT,DIR,ZREAD
+2 SET DIR(0)=ZDIR0
if $GET(ZDIRA)]""
SET DIR("A")=ZDIRA
if $GET(ZDIRB)]""
SET DIR("B")=ZDIRB
+3 DO ^DIR
KILL DIR
+4 if Y]""
SET ZREAD=Y
+5 IF $DATA(DTOUT)!($DATA(DIRUT))
KILL ZREAD
+6 QUIT $GET(ZREAD,"")
+7 ;
PSOSTALK ; SEE IF SCRIPTALK PATIENT AND PRINTER EXISTS AND IS SET TO AUTO-PRINT
+1 NEW A
+2 SET PSOSTALK=0
+3 ; Prevents printing ScripTalk Label for OneVA Pharmacy Fills
IF $GET(PSOONEVA)
QUIT
+4 DO AUTO^PSOTALK
+5 IF 'PSOSTALK
QUIT
+6 DO NOW^%DTC
SET NOW=%
KILL %,%H,%I
IF $GET(RXF)=""
SET RXF=0
FOR I=0:0
SET I=$ORDER(^PSRX(RX,1,I))
if 'I
QUIT
SET RXF=I
+7 SET IR=0
FOR FDA=0:0
SET FDA=$ORDER(^PSRX(RX,"L",FDA))
if 'FDA
QUIT
SET IR=FDA
+8 SET IR=IR+1
SET ^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR
+9 ;*442
SET ^PSRX(RX,"L",IR,0)=NOW_"^"_$SELECT($GET(RXP):99-RXPI,1:RXF)_"^"_"ScripTalk label printed"_$SELECT($GET(RXP):" (Partial)",1:"")_$SELECT($GET(REPRINT):" (Reprint)",1:"")_"^"_PDUZ_"^^"_$GET(PSOLAP)
+10 SET A=$PIECE($GET(^PS(59,+PSOSITE,"STALK")),"^",4)
IF A=0
SET PSOSTALK=0
+11 QUIT
+12 ;
