source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSPOID1.m@ 1639

Last change on this file since 1639 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1PSSPOID1 ;BIR/RTR-Orderable Item cross references ;02/14/00
2 ;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
3KILL1 ;Kill x-ref from field 2.1 of File 50
4 K ^PS(50.7,"A50",X,DA)
5 S PSSCROSS=1 N PSPOINT,PSSZA,PSSZS,PSSZOI,PSSTEST
6 S PSSTEST=X D HOLD D EN1^PSSPOIDT D UNHOLD
7 F PSSZA=0:0 S PSSZA=$O(^PS(52.6,"AC",DA,PSSZA)) Q:'PSSZA D
8 .S PSSZOI=$P($G(^PS(52.6,PSSZA,0)),"^",11)
9 .I PSSZOI S $P(^PS(52.6,PSSZA,0),"^",11)="" K ^PS(52.6,"AOI",PSSZOI,PSSZA)
10 F PSSZS=0:0 S PSSZS=$O(^PS(52.7,"AC",DA,PSSZS)) Q:'PSSZS D
11 .S PSSZOI=$P($G(^PS(52.7,PSSZS,0)),"^",11)
12 .I PSSZOI S $P(^PS(52.7,PSSZS,0),"^",11)="" K ^PS(52.7,"AOI",PSSZOI,PSSZS)
13 K PSSCROSS
14 Q
15SET1 ;Set x-ref from field 2.1 of File 50
16 S ^PS(50.7,"A50",X,DA)=""
17 S PSSCROSS=1 N PSPOINT,PSSZA,PSSZS,PSSTEST
18 S PSSTEST=X D HOLD D EN1^PSSPOIDT D UNHOLD
19 F PSSZA=0:0 S PSSZA=$O(^PS(52.6,"AC",DA,PSSZA)) Q:'PSSZA D
20 .S $P(^PS(52.6,PSSZA,0),"^",11)=X,^PS(52.6,"AOI",X,PSSZA)=""
21 F PSSZS=0:0 S PSSZS=$O(^PS(52.7,"AC",DA,PSSZS)) Q:'PSSZS D
22 .S $P(^PS(52.7,PSSZS,0),"^",11)=X,^PS(52.7,"AOI",X,PSSZS)=""
23 K PSSCROSS
24 Q
25K526 ;Kill x-ref from generic pointer in IV Additives file
26 K ^PSDRUG("A526",X,DA)
27 N PSSTEST,PSSVAR S PSSCROSS=1
28 S PSSTEST=$P($G(^PS(52.6,DA,0)),"^",11)
29 I PSSTEST D HOLD D EN1^PSSPOIDT D UNHOLD
30 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)
31 K PSSCROSS
32 Q
33S526 ;Set x-ref from generic pointer in IV Additives file
34 S ^PSDRUG("A526",X,DA)=""
35 N PSSTEST S PSSCROSS=1
36 S (PSSTEST,PSSTESTX)=$P($G(^PSDRUG(X,2)),"^") I PSSTEST D HOLD D EN1^PSSPOIDT D UNHOLD
37 I PSSTESTX S $P(^PS(52.6,DA,0),"^",11)=PSSTESTX,^PS(52.6,"AOI",PSSTESTX,DA)=""
38 K PSSTESTX,PSSCROSS
39 Q
40K527 ;Kill x-ref from Generic pointer in IV Solutions file
41 K ^PSDRUG("A527",X,DA)
42 N PSSTEST,PSSVAR S PSSCROSS=1
43 S PSSTEST=$P($G(^PS(52.7,DA,0)),"^",11)
44 I PSSTEST D HOLD D EN1^PSSPOIDT D UNHOLD
45 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)
46 K PSSCROSS
47 Q
48S527 ;Set x-ref from Generic pointer in IV Solutions file
49 S ^PSDRUG("A527",X,DA)=""
50 N PSSTEST S PSSCROSS=1
51 S (PSSTEST,PSSTESTX)=$P($G(^PSDRUG(X,2)),"^") I PSSTEST D HOLD D EN1^PSSPOIDT D UNHOLD
52 I PSSTESTX S $P(^PS(52.7,DA,0),"^",11)=PSSTESTX,^PS(52.7,"AOI",PSSTESTX,DA)=""
53 K PSSTESTX,PSSCROSS
54 Q
55HOLD ;
56 S PSSHDZX=$G(X),PSSHDZDA=$G(DA)
57 Q
58UNHOLD ;
59 S X=$G(PSSHDZX),DA=$G(PSSHDZDA)
60 K PSSHDZX,PSSHDZDA
61 Q
Note: See TracBrowser for help on using the repository browser.