PSAP47.m

PSAP47 ;BHM/DB/PDW - CORRECT DATA IN XTMP("PSAPV" ;9/30/04

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

 Q:'$D(^XTMP("PSAPV"))

 S X=0 F  S X=$O(^XTMP("PSAPV",X)) Q:+X'>0  S Y=+X D

 . F  Q:'$D(^XTMP("PSAPNEW",Y))  S Y=Y+1

 . M ^XTMP("PSAPNEW",Y)=^XTMP("PSAPV",X) ;W !,X,?30," =>  ",Y

 S ^XTMP("PSAPNEW",0)=^XTMP("PSAPV",0)

 K ^XTMP("PSAPV")

 M ^XTMP("PSAPV")=^XTMP("PSAPNEW")

 K ^XTMP("PSAPNEW"),X,Y

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSAP47   433     printed  Dec 13, 2024@01:49:58                                                                                                                                                                                                       Page 2

PSAP47    ;BHM/DB/PDW - CORRECT DATA IN XTMP("PSAPV" ;9/30/04

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

 +2        if '$DATA(^XTMP("PSAPV"))

               QUIT 

 +3        SET X=0

           FOR 

               SET X=$ORDER(^XTMP("PSAPV",X))

               if +X'>0

                   QUIT 

               SET Y=+X

               Begin DoDot:1

 +4                FOR 

                       if '$DATA(^XTMP("PSAPNEW",Y))

                           QUIT 

                       SET Y=Y+1

 +5       ;W !,X,?30," =>  ",Y

                   MERGE ^XTMP("PSAPNEW",Y)=^XTMP("PSAPV",X)

               End DoDot:1

 +6        SET ^XTMP("PSAPNEW",0)=^XTMP("PSAPV",0)

 +7        KILL ^XTMP("PSAPV")

 +8        MERGE ^XTMP("PSAPV")=^XTMP("PSAPNEW")

 +9        KILL ^XTMP("PSAPNEW"),X,Y

 +10       QUIT