BOPCLN.m

BOPCLN ;IHS/ILC/ALG/CIA/PLS - Clean Up Files in 90355.1;15-Jul-2005 08:44;SM

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

 Q

R ; entry point to clean up file 90355.1 of old query responses

 S U="^",COUNTER=0,COUNT=0

R1 S COUNTER=$O(^BOP(90355.1,"AS",0,COUNTER)) I 'COUNTER G DONE

 S B=$G(^BOP(90355.1,COUNTER,0)),C=$G(^BOP(90355.1,COUNTER,1))

 I B'="" D KILL

 G R1

 ;

KILL ; remove entry

 I $P(B,U,2)'="Q03" Q  ;  only clean up old response to queries

 S X=$P(B,U) I X]"" K ^BOP(90355.1,"B",X,COUNTER)

 S X=$P(B,U,3) I X]"" K ^BOP(90355.1,"AD",X,COUNTER)

 S X=$P(C,U,1) I X]"" K ^BOP(90355.1,"ADFN",X,COUNTER)

 S X=$P(C,U,3) I X]"" S F=$P(X,",",1),G=$P(X,",",2,999) I F'=""&(G'="") K ^BOP(90355.1,"ANAME",F,G,COUNTER)

 K ^BOP(90355.1,COUNTER)

 K ^BOP(90355.1,"AS",0,COUNTER)

 S COUNT=COUNT+1

 Q

 ;

DONE W !,"TOTAL 'Q03' ENTRIES REMOVED: ",COUNT

 Q

 ;

EOR ;BOPCLN - Clean Up Files in 90355.1

BOPCLN    ;IHS/ILC/ALG/CIA/PLS - Clean Up Files in 90355.1;15-Jul-2005 08:44;SM

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

 +2        QUIT 

R         ; entry point to clean up file 90355.1 of old query responses

 +1        SET U="^"

           SET COUNTER=0

           SET COUNT=0

R1         SET COUNTER=$ORDER(^BOP(90355.1,"AS",0,COUNTER))

           IF 'COUNTER

               GOTO DONE

 +1        SET B=$GET(^BOP(90355.1,COUNTER,0))

           SET C=$GET(^BOP(90355.1,COUNTER,1))

 +2        IF B'=""

               DO KILL

 +3        GOTO R1

 +4       ;

KILL      ; remove entry

 +1       ;  only clean up old response to queries

           IF $PIECE(B,U,2)'="Q03"

               QUIT 

 +2        SET X=$PIECE(B,U)

           IF X]""

               KILL ^BOP(90355.1,"B",X,COUNTER)

 +3        SET X=$PIECE(B,U,3)

           IF X]""

               KILL ^BOP(90355.1,"AD",X,COUNTER)

 +4        SET X=$PIECE(C,U,1)

           IF X]""

               KILL ^BOP(90355.1,"ADFN",X,COUNTER)

 +5        SET X=$PIECE(C,U,3)

           IF X]""

               SET F=$PIECE(X,",",1)

               SET G=$PIECE(X,",",2,999)

               IF F'=""&(G'="")

                   KILL ^BOP(90355.1,"ANAME",F,G,COUNTER)

 +6        KILL ^BOP(90355.1,COUNTER)

 +7        KILL ^BOP(90355.1,"AS",0,COUNTER)

 +8        SET COUNT=COUNT+1

 +9        QUIT 

 +10      ;

DONE       WRITE !,"TOTAL 'Q03' ENTRIES REMOVED: ",COUNT

 +1        QUIT 

 +2       ;

EOR       ;BOPCLN - Clean Up Files in 90355.1