PSSPOID1 ;BIR/RTR-Orderable Item cross references ;02/14/00
;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
KILL1 ;Kill x-ref from field 2.1 of File 50
K ^PS(50.7,"A50",X,DA)
S PSSCROSS=1 N PSPOINT,PSSZA,PSSZS,PSSZOI,PSSTEST
S PSSTEST=X D HOLD D EN1^PSSPOIDT D UNHOLD
F PSSZA=0:0 S PSSZA=$O(^PS(52.6,"AC",DA,PSSZA)) Q:'PSSZA D
.S PSSZOI=$P($G(^PS(52.6,PSSZA,0)),"^",11)
.I PSSZOI S $P(^PS(52.6,PSSZA,0),"^",11)="" K ^PS(52.6,"AOI",PSSZOI,PSSZA)
F PSSZS=0:0 S PSSZS=$O(^PS(52.7,"AC",DA,PSSZS)) Q:'PSSZS D
.S PSSZOI=$P($G(^PS(52.7,PSSZS,0)),"^",11)
.I PSSZOI S $P(^PS(52.7,PSSZS,0),"^",11)="" K ^PS(52.7,"AOI",PSSZOI,PSSZS)
K PSSCROSS
Q
SET1 ;Set x-ref from field 2.1 of File 50
S ^PS(50.7,"A50",X,DA)=""
S PSSCROSS=1 N PSPOINT,PSSZA,PSSZS,PSSTEST
S PSSTEST=X D HOLD D EN1^PSSPOIDT D UNHOLD
F PSSZA=0:0 S PSSZA=$O(^PS(52.6,"AC",DA,PSSZA)) Q:'PSSZA D
.S $P(^PS(52.6,PSSZA,0),"^",11)=X,^PS(52.6,"AOI",X,PSSZA)=""
F PSSZS=0:0 S PSSZS=$O(^PS(52.7,"AC",DA,PSSZS)) Q:'PSSZS D
.S $P(^PS(52.7,PSSZS,0),"^",11)=X,^PS(52.7,"AOI",X,PSSZS)=""
K PSSCROSS
Q
K526 ;Kill x-ref from generic pointer in IV Additives file
K ^PSDRUG("A526",X,DA)
N PSSTEST,PSSVAR S PSSCROSS=1
S PSSTEST=$P($G(^PS(52.6,DA,0)),"^",11)
I PSSTEST D HOLD D EN1^PSSPOIDT D UNHOLD
S PSSVAR=$P($G(^PS(52.6,DA,0)),"^",11) I PSSVAR S $P(^PS(52.6,DA,0),"^",11)="" K ^PS(52.6,"AOI",PSSVAR,DA)
K PSSCROSS
Q
S526 ;Set x-ref from generic pointer in IV Additives file
S ^PSDRUG("A526",X,DA)=""
N PSSTEST S PSSCROSS=1
S (PSSTEST,PSSTESTX)=$P($G(^PSDRUG(X,2)),"^") I PSSTEST D HOLD D EN1^PSSPOIDT D UNHOLD
I PSSTESTX S $P(^PS(52.6,DA,0),"^",11)=PSSTESTX,^PS(52.6,"AOI",PSSTESTX,DA)=""
K PSSTESTX,PSSCROSS
Q
K527 ;Kill x-ref from Generic pointer in IV Solutions file
K ^PSDRUG("A527",X,DA)
N PSSTEST,PSSVAR S PSSCROSS=1
S PSSTEST=$P($G(^PS(52.7,DA,0)),"^",11)
I PSSTEST D HOLD D EN1^PSSPOIDT D UNHOLD
S PSSVAR=$P($G(^PS(52.7,DA,0)),"^",11) I PSSVAR S $P(^PS(52.7,DA,0),"^",11)="" K ^PS(52.7,"AOI",PSSVAR,DA)
K PSSCROSS
Q
S527 ;Set x-ref from Generic pointer in IV Solutions file
S ^PSDRUG("A527",X,DA)=""
N PSSTEST S PSSCROSS=1
S (PSSTEST,PSSTESTX)=$P($G(^PSDRUG(X,2)),"^") I PSSTEST D HOLD D EN1^PSSPOIDT D UNHOLD
I PSSTESTX S $P(^PS(52.7,DA,0),"^",11)=PSSTESTX,^PS(52.7,"AOI",PSSTESTX,DA)=""
K PSSTESTX,PSSCROSS
Q
HOLD ;
S PSSHDZX=$G(X),PSSHDZDA=$G(DA)
Q
UNHOLD ;
S X=$G(PSSHDZX),DA=$G(PSSHDZDA)
K PSSHDZX,PSSHDZDA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSPOID1 2476 printed Apr 09, 2024@21:34:06 Page 2
PSSPOID1 ;BIR/RTR-Orderable Item cross references ;02/14/00
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
KILL1 ;Kill x-ref from field 2.1 of File 50
+1 KILL ^PS(50.7,"A50",X,DA)
+2 SET PSSCROSS=1
NEW PSPOINT,PSSZA,PSSZS,PSSZOI,PSSTEST
+3 SET PSSTEST=X
DO HOLD
DO EN1^PSSPOIDT
DO UNHOLD
+4 FOR PSSZA=0:0
SET PSSZA=$ORDER(^PS(52.6,"AC",DA,PSSZA))
if 'PSSZA
QUIT
Begin DoDot:1
+5 SET PSSZOI=$PIECE($GET(^PS(52.6,PSSZA,0)),"^",11)
+6 IF PSSZOI
SET $PIECE(^PS(52.6,PSSZA,0),"^",11)=""
KILL ^PS(52.6,"AOI",PSSZOI,PSSZA)
End DoDot:1
+7 FOR PSSZS=0:0
SET PSSZS=$ORDER(^PS(52.7,"AC",DA,PSSZS))
if 'PSSZS
QUIT
Begin DoDot:1
+8 SET PSSZOI=$PIECE($GET(^PS(52.7,PSSZS,0)),"^",11)
+9 IF PSSZOI
SET $PIECE(^PS(52.7,PSSZS,0),"^",11)=""
KILL ^PS(52.7,"AOI",PSSZOI,PSSZS)
End DoDot:1
+10 KILL PSSCROSS
+11 QUIT
SET1 ;Set x-ref from field 2.1 of File 50
+1 SET ^PS(50.7,"A50",X,DA)=""
+2 SET PSSCROSS=1
NEW PSPOINT,PSSZA,PSSZS,PSSTEST
+3 SET PSSTEST=X
DO HOLD
DO EN1^PSSPOIDT
DO UNHOLD
+4 FOR PSSZA=0:0
SET PSSZA=$ORDER(^PS(52.6,"AC",DA,PSSZA))
if 'PSSZA
QUIT
Begin DoDot:1
+5 SET $PIECE(^PS(52.6,PSSZA,0),"^",11)=X
SET ^PS(52.6,"AOI",X,PSSZA)=""
End DoDot:1
+6 FOR PSSZS=0:0
SET PSSZS=$ORDER(^PS(52.7,"AC",DA,PSSZS))
if 'PSSZS
QUIT
Begin DoDot:1
+7 SET $PIECE(^PS(52.7,PSSZS,0),"^",11)=X
SET ^PS(52.7,"AOI",X,PSSZS)=""
End DoDot:1
+8 KILL PSSCROSS
+9 QUIT
K526 ;Kill x-ref from generic pointer in IV Additives file
+1 KILL ^PSDRUG("A526",X,DA)
+2 NEW PSSTEST,PSSVAR
SET PSSCROSS=1
+3 SET PSSTEST=$PIECE($GET(^PS(52.6,DA,0)),"^",11)
+4 IF PSSTEST
DO HOLD
DO EN1^PSSPOIDT
DO UNHOLD
+5 SET PSSVAR=$PIECE($GET(^PS(52.6,DA,0)),"^",11)
IF PSSVAR
SET $PIECE(^PS(52.6,DA,0),"^",11)=""
KILL ^PS(52.6,"AOI",PSSVAR,DA)
+6 KILL PSSCROSS
+7 QUIT
S526 ;Set x-ref from generic pointer in IV Additives file
+1 SET ^PSDRUG("A526",X,DA)=""
+2 NEW PSSTEST
SET PSSCROSS=1
+3 SET (PSSTEST,PSSTESTX)=$PIECE($GET(^PSDRUG(X,2)),"^")
IF PSSTEST
DO HOLD
DO EN1^PSSPOIDT
DO UNHOLD
+4 IF PSSTESTX
SET $PIECE(^PS(52.6,DA,0),"^",11)=PSSTESTX
SET ^PS(52.6,"AOI",PSSTESTX,DA)=""
+5 KILL PSSTESTX,PSSCROSS
+6 QUIT
K527 ;Kill x-ref from Generic pointer in IV Solutions file
+1 KILL ^PSDRUG("A527",X,DA)
+2 NEW PSSTEST,PSSVAR
SET PSSCROSS=1
+3 SET PSSTEST=$PIECE($GET(^PS(52.7,DA,0)),"^",11)
+4 IF PSSTEST
DO HOLD
DO EN1^PSSPOIDT
DO UNHOLD
+5 SET PSSVAR=$PIECE($GET(^PS(52.7,DA,0)),"^",11)
IF PSSVAR
SET $PIECE(^PS(52.7,DA,0),"^",11)=""
KILL ^PS(52.7,"AOI",PSSVAR,DA)
+6 KILL PSSCROSS
+7 QUIT
S527 ;Set x-ref from Generic pointer in IV Solutions file
+1 SET ^PSDRUG("A527",X,DA)=""
+2 NEW PSSTEST
SET PSSCROSS=1
+3 SET (PSSTEST,PSSTESTX)=$PIECE($GET(^PSDRUG(X,2)),"^")
IF PSSTEST
DO HOLD
DO EN1^PSSPOIDT
DO UNHOLD
+4 IF PSSTESTX
SET $PIECE(^PS(52.7,DA,0),"^",11)=PSSTESTX
SET ^PS(52.7,"AOI",PSSTESTX,DA)=""
+5 KILL PSSTESTX,PSSCROSS
+6 QUIT
HOLD ;
+1 SET PSSHDZX=$GET(X)
SET PSSHDZDA=$GET(DA)
+2 QUIT
UNHOLD ;
+1 SET X=$GET(PSSHDZX)
SET DA=$GET(PSSHDZDA)
+2 KILL PSSHDZX,PSSHDZDA
+3 QUIT
