- 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 Dec 13, 2024@02:33:55 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