PSA48P0.m

PSA48P0 ;VMP/PDW-BUILD MCKESSON XTMP( ;9/19/2004

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

EN ;

 I $E(IOST)="C" W !

 S ^XTMP("PSAVSN",0)="3050308^3040909^DA McKesson VSNs DUOUs"

 F I=1:1:44 S ROUNM="PSA48P"_I D ROU I $E(IOST)="C" W "."

 Q

ROU ;

 F LN=3:1 S TAGROU="+"_LN_"^"_ROUNM S XX=$T(@TAGROU) Q:XX[";;END"  D LINE

 Q

LINE ;

 S XX=$P(XX,";;",2)

 F P=1:1 Q:$P(XX,U,P)=""  S YY=$P(XX,U,P),VSN=+YY,DUOU=$P(YY,"~",2),^XTMP("PSAVSN",VSN)=DUOU

 Q

EXIT K P,I,XX,LN,TAGROU,ROUNM,VSN,DUOU,YY

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSA48P0   527     printed  Mar 13, 2025@20:52:48                                                                                                                                                                                                      Page 2

PSA48P0   ;VMP/PDW-BUILD MCKESSON XTMP( ;9/19/2004

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

EN        ;

 +1        IF $EXTRACT(IOST)="C"

               WRITE !

 +2        SET ^XTMP("PSAVSN",0)="3050308^3040909^DA McKesson VSNs DUOUs"

 +3        FOR I=1:1:44

               SET ROUNM="PSA48P"_I

               DO ROU

               IF $EXTRACT(IOST)="C"

                   WRITE "."

 +4        QUIT 

ROU       ;

 +1        FOR LN=3:1

               SET TAGROU="+"_LN_"^"_ROUNM

               SET XX=$TEXT(@TAGROU)

               if XX[";;END"

                   QUIT 

               DO LINE

 +2        QUIT 

LINE      ;

 +1        SET XX=$PIECE(XX,";;",2)

 +2        FOR P=1:1

               if $PIECE(XX,U,P)=""

                   QUIT 

               SET YY=$PIECE(XX,U,P)

               SET VSN=+YY

               SET DUOU=$PIECE(YY,"~",2)

               SET ^XTMP("PSAVSN",VSN)=DUOU

 +3        QUIT 

EXIT       KILL P,I,XX,LN,TAGROU,ROUNM,VSN,DUOU,YY

 +1        QUIT