- 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 Feb 19, 2025@00:02:06 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 ;