BOPTSD.m

BOPTSD ;IHS/ILC/ALG/CIA/PLS -  Send All Active Inpatients to Interface;09-Feb-2006 15:35;DU

 ;;1.0;AUTOMATED DISPENSING INTERFACE;**1**;Jul 26, 2005

 ;;

ALL ;  send all active patients

 S LOOP="^DPT(""CN""",CHK=LOOP,LOOP=LOOP_")"

LOOP S LOOP=$Q(@LOOP) I $E(LOOP,1,$L(CHK))'=CHK G DONE

 S DFN=$P($P(LOOP,",",3),")",1)

 W !,LOOP,"  -  ",DFN

 D RUN

 G LOOP

DONE W !,"DONE"

 Q

 ;

RUN ;xmit to interface

 S (PSPG,BOPDFN)=DFN D

 .D INIT^BOPCAP I $D(BOPQ) W " *" Q

 .D ADT^BOPCAP

 .W !,"  ORDERS"

LOOP2 .S PSGP=DFN F BOPO=0:0 S BOPO=$O(^PS(55,DFN,5,BOPO)) Q:BOPO<1  D

 ..S BOPN0=$G(^PS(55,DFN,5,BOPO,0)) Q:'BOPN0

 ..S PSGORD=BOPO ;Order Number

 ..Q:$P(BOPN0,U,9)'="A"  ;Status

 ..Q:'$P($G(^PS(55,DFN,5,BOPO,4)),U,9)  ;Verified

 ..D NEW^BOPCAP

 Q

 ;

ONE ; EP - transmit one patient to interface

 N LOOP,DFN,CHK,PSPG,BOPDFN,Y,ANS,DIC S (ANS,Y)=0

 S DIC="^DPT(",DIC(0)="QEAM" D ^DIC Q:Y'>0  S DFN=+Y

 S DIR("A")="Is this the correct patient",DIR(0)="Y",DIR("B")="YES" D ^DIR K DIR Q:$D(DIRUT)

 I Y'=1 G ONE

 I '$D(^PS(55,DFN)) W !,"Not a pharmacy patient.",$C(7) G ONE

 D RUN G ONE

BOPTSD    ;IHS/ILC/ALG/CIA/PLS -  Send All Active Inpatients to Interface;09-Feb-2006 15:35;DU

 +1       ;;1.0;AUTOMATED DISPENSING INTERFACE;**1**;Jul 26, 2005

 +2       ;;

ALL       ;  send all active patients

 +1        SET LOOP="^DPT(""CN"""

           SET CHK=LOOP

           SET LOOP=LOOP_")"

LOOP       SET LOOP=$QUERY(@LOOP)

           IF $EXTRACT(LOOP,1,$LENGTH(CHK))'=CHK

               GOTO DONE

 +1        SET DFN=$PIECE($PIECE(LOOP,",",3),")",1)

 +2        WRITE !,LOOP,"  -  ",DFN

 +3        DO RUN

 +4        GOTO LOOP

DONE       WRITE !,"DONE"

 +1        QUIT 

 +2       ;

RUN       ;xmit to interface

 +1        SET (PSPG,BOPDFN)=DFN

           Begin DoDot:1

 +2            DO INIT^BOPCAP

               IF $DATA(BOPQ)

                   WRITE " *"

                   QUIT 

 +3            DO ADT^BOPCAP

 +4            WRITE !,"  ORDERS"

LOOP2          SET PSGP=DFN

               FOR BOPO=0:0

                   SET BOPO=$ORDER(^PS(55,DFN,5,BOPO))

                   IF BOPO<1

                       QUIT 

                   Begin DoDot:2

 +1                    SET BOPN0=$GET(^PS(55,DFN,5,BOPO,0))

                       IF 'BOPN0

                           QUIT 

 +2       ;Order Number

                       SET PSGORD=BOPO

 +3       ;Status

                       IF $PIECE(BOPN0,U,9)'="A"

                           QUIT 

 +4       ;Verified

                       IF '$PIECE($GET(^PS(55,DFN,5,BOPO,4)),U,9)

                           QUIT 

 +5                    DO NEW^BOPCAP

                   End DoDot:2

           End DoDot:1

 +6        QUIT 

 +7       ;

ONE       ; EP - transmit one patient to interface

 +1        NEW LOOP,DFN,CHK,PSPG,BOPDFN,Y,ANS,DIC

           SET (ANS,Y)=0

 +2        SET DIC="^DPT("

           SET DIC(0)="QEAM"

           DO ^DIC

           IF Y'>0

               QUIT 

           SET DFN=+Y

 +3        SET DIR("A")="Is this the correct patient"

           SET DIR(0)="Y"

           SET DIR("B")="YES"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               QUIT 

 +4        IF Y'=1

               GOTO ONE

 +5        IF '$DATA(^PS(55,DFN))

               WRITE !,"Not a pharmacy patient.",$CHAR(7)

               GOTO ONE

 +6        DO RUN

           GOTO ONE