PSOTALK1.m

PSOTALK1 ;BIR/EJW - SCRIPTALK INTERFACE FROM VISTA (CONT'D) ;04/18/2003

 ;;7.0;OUTPATIENT PHARMACY;**135**;DEC 1997

 ;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]""  ;

 .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)

 .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

 S PSOSTALK=0

 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($D(REPRINT):" (Reprint)",1:"")_"^"_PDUZ_"^"_$G(%ZTIO)

 Q

 ;

PSOTALK1  ;BIR/EJW - SCRIPTALK INTERFACE FROM VISTA (CONT'D) ;04/18/2003

 +1       ;;7.0;OUTPATIENT PHARMACY;**135**;DEC 1997

 +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                    IF $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)

 +3                    SET SGY=SGY_X_" "

                   End DoDot:1

 +4        QUIT SGY

 +5       ;

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        SET PSOSTALK=0

 +2        DO AUTO^PSOTALK

 +3        IF 'PSOSTALK

               QUIT 

 +4        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

 +5        SET IR=0

           FOR FDA=0:0

               SET FDA=$ORDER(^PSRX(RX,"L",FDA))

               IF 'FDA

                   QUIT 

               SET IR=FDA

 +6        SET IR=IR+1

           SET ^PSRX(RX,"L",0)="^52.032DA^"_IR_"^"_IR

 +7        SET ^PSRX(RX,"L",IR,0)=NOW_"^"_$SELECT($GET(RXP):99-RXPI,1:RXF)_"^"_"ScripTalk label printed"_$SELECT($GET(RXP):" (Partial)",1:"")_$SELECT($DATA(REPRINT):" (Reprint)",1:"")_"^"_PDUZ_"^"_$GET(%ZTIO)

 +8        QUIT 

 +9       ;