BOPTD.m

BOPTD ;IHS/ILC/ALG/CIA/PLS - SEND ALL ACTIVE INPATIENTS TO INTERFACE;06-Apr-2005 13:41;SM

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

 ;;

 S LOOP="^DPT("_$C(34)_"CN"_$C(34),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)

 D ADT^BOPCAP

 G LOOP

 ;

LOOP2 ; send orders

 S (PSPG,VEFDFN)=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

DONE W !,"DONE"

 K DFN,DIC,PSGORD,PSGP

 Q

BOPTD     ;IHS/ILC/ALG/CIA/PLS - SEND ALL ACTIVE INPATIENTS TO INTERFACE;06-Apr-2005 13:41;SM

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

 +2       ;;

 +3        SET LOOP="^DPT("_$CHAR(34)_"CN"_$CHAR(34)

           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        DO ADT^BOPCAP

 +3        GOTO LOOP

 +4       ;

LOOP2     ; send orders

 +1        SET (PSPG,VEFDFN)=DFN

 +2        FOR BOPO=0:0

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

               IF BOPO<1

                   QUIT 

               Begin DoDot:1

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

                   IF 'BOPN0

                       QUIT 

 +4       ;Order Number

                   SET PSGORD=BOPO

 +5       ;Status

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

                       QUIT 

 +6       ;Verified

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

                       QUIT 

 +7                DO NEW^BOPCAP

 +8                QUIT 

               End DoDot:1

DONE       WRITE !,"DONE"

 +1        KILL DFN,DIC,PSGORD,PSGP

 +2        QUIT