PSAVSN.m

PSAVSN ;BHM/DAV - Check for and reduce size of VSN node ;10/9/97

 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**37**; 10/24/97

 S PSACTRL=0

1 S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) G DONE:PSACTRL'>0 S PSALINE=0

PSAP31 ;entry point from PSAUP5

2 S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) G WHERE:PSALINE'>0

 S PSADATA=$G(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))

 S PSAP31=$P($G(PSADATA),"^",5) I $L(PSAP31)'>25 G 2

 S CNT=0,PSAP31A=$P(PSAP31,"~~",2) F X=3:1 Q:$P(PSAP31,"~~",X)=""  S PSAP31B=$P(PSAP31,"~~",X) I $G(PSAP31B)=PSAP31A S $P(PSAP31,"~~",X)=""

 S PSAP31D=$L(PSAP31) F X=PSAP31D:-1 S X1=$E(PSAP31,X) Q:X1'="~"  S PSAP31=$E(PSAP31,1,(X-1))

 G 2

DONE K PSALINE,PSAP31,PSAP31A,PSAP31B,PSAP31C,PSAP31D,CNT S X="PSAP31" X ^%ZOSF("DEL") Q

WHERE ;Doing actual upload or Post PSA*3*31 utility

 I $G(PSAUPLD)'=1 G 1

 G DONE

PSAVSN    ;BHM/DAV - Check for and reduce size of VSN node ;10/9/97

 +1       ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**37**; 10/24/97

 +2        SET PSACTRL=0

1          SET PSACTRL=$ORDER(^XTMP("PSAPV",PSACTRL))

           IF PSACTRL'>0

               GOTO DONE

           SET PSALINE=0

PSAP31    ;entry point from PSAUP5

2          SET PSALINE=$ORDER(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))

           IF PSALINE'>0

               GOTO WHERE

 +1        SET PSADATA=$GET(^XTMP("PSAPV",PSACTRL,"IT",PSALINE))

 +2        SET PSAP31=$PIECE($GET(PSADATA),"^",5)

           IF $LENGTH(PSAP31)'>25

               GOTO 2

 +3        SET CNT=0

           SET PSAP31A=$PIECE(PSAP31,"~~",2)

           FOR X=3:1

               IF $PIECE(PSAP31,"~~",X)=""

                   QUIT 

               SET PSAP31B=$PIECE(PSAP31,"~~",X)

               IF $GET(PSAP31B)=PSAP31A

                   SET $PIECE(PSAP31,"~~",X)=""

 +4        SET PSAP31D=$LENGTH(PSAP31)

           FOR X=PSAP31D:-1

               SET X1=$EXTRACT(PSAP31,X)

               IF X1'="~"

                   QUIT 

               SET PSAP31=$EXTRACT(PSAP31,1,(X-1))

 +5        GOTO 2

DONE       KILL PSALINE,PSAP31,PSAP31A,PSAP31B,PSAP31C,PSAP31D,CNT

           SET X="PSAP31"

           XECUTE ^%ZOSF("DEL")

           QUIT 

WHERE     ;Doing actual upload or Post PSA*3*31 utility

 +1        IF $GET(PSAUPLD)'=1

               GOTO 1

 +2        GOTO DONE