source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSSUTIL.m@ 1773

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

initial load of WorldVistAEHR
File size: 2.2 KB
Line 
1PSSSUTIL ;BIR/RTR-Utility routine for Orderable Item ;09/02/97
2 ;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
3MAT ; Match Additive to already existing Orderable Item
4 K DIE S DIE="^PS(52.6,",DA=PSAIEN,DR="15////"_ZZFLAG D ^DIE K DIE
5 K SYN1 S SCOUNT=0 F SS=0:0 S SS=$O(^PS(52.6,PSAIEN,3,SS)) Q:'SS S SCOUNT=SCOUNT+1,SYN(SCOUNT)=^(SS,0)
6 I SCOUNT S SCOUNT=0 F WW=0:0 S WW=$O(SYN(WW)) Q:'WW I '$D(^PS(50.7,ZZFLAG,2,"B",SYN(WW))) S SCOUNT=SCOUNT+1,SYN1(SCOUNT)=SYN(WW)
7 I SCOUNT D
8 .S VV=0 F VVV=0:0 S VVV=$O(^PS(50.7,ZZFLAG,2,VVV)) Q:'VVV S VV=VVV
9 .S VV=$S('$G(VV):1,1:VV+1) F TT=0:0 S TT=$O(SYN1(TT)) Q:'TT S ^PS(50.7,ZZFLAG,2,VV,0)=SYN1(TT),VV=VV+1
10 .F VV=0:0 S VV=$O(^PS(50.7,ZZFLAG,2,VV)) Q:'VV S SYNNAM=$P(^(VV,0),"^"),^PS(50.7,ZZFLAG,2,"B",SYNNAM,VV)=""
11 .S (SCOUNT,SCLAST)=0 F TT=0:0 S TT=$O(^PS(50.7,ZZFLAG,2,TT)) Q:'TT S SCOUNT=SCOUNT+1,SCLAST=TT
12 .S ^PS(50.7,ZZFLAG,2,0)="^50.72^"_SCLAST_"^"_SCOUNT
13 S PSPOI=ZZFLAG,NEWFLAG=1 D DIR^PSSPOIM3 I $G(PSSDIR) W !!?3,"Now editing Orderable Item:",!?3,$P(^PS(50.7,ZZFLAG,0),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^") D INACT^PSSADDIT
14 K PSSDIR,PSSCROSS D EN^PSSPOIDT(PSPOI) D:'$G(PSSSSS) EN2^PSSHL1(PSPOI,"MUP")
15 G EN^PSSADDIT
16 ;
17SOMAT ;Match Solution to an already existing Orderable Item
18 K DIE S DIE="^PS(52.7,",DA=PSSIEN,DR="9////"_ZZFLAG D ^DIE K DIE
19 K SYN1 S SCOUNT=0 F SS=0:0 S SS=$O(^PS(52.7,PSSIEN,3,SS)) Q:'SS S SCOUNT=SCOUNT+1,SYN(SCOUNT)=^(SS,0)
20 I SCOUNT S SCOUNT=0 F WW=0:0 S WW=$O(SYN(WW)) Q:'WW I '$D(^PS(50.7,ZZFLAG,2,"B",SYN(WW))) S SCOUNT=SCOUNT+1,SYN1(SCOUNT)=SYN(WW)
21 I SCOUNT D
22 .S VV=0 F VVV=0:0 S VVV=$O(^PS(50.7,ZZFLAG,2,VVV)) Q:'VVV S VV=VVV
23 .S VV=$S('$G(VV):1,1:VV+1) F TT=0:0 S TT=$O(SYN1(TT)) Q:'TT S ^PS(50.7,ZZFLAG,2,VV,0)=SYN1(TT),VV=VV+1
24 .F VV=0:0 S VV=$O(^PS(50.7,ZZFLAG,2,VV)) Q:'VV S SYNNAM=$P(^(VV,0),"^"),^PS(50.7,ZZFLAG,2,"B",SYNNAM,VV)=""
25 .S (SCOUNT,SCLAST)=0 F TT=0:0 S TT=$O(^PS(50.7,ZZFLAG,2,TT)) Q:'TT S SCOUNT=SCOUNT+1,SCLAST=TT
26 .S ^PS(50.7,ZZFLAG,2,0)="^50.72^"_SCLAST_"^"_SCOUNT
27 S PSSOI=ZZFLAG,NEWFLAG=1 D DIR^PSSPOIM3 I $G(PSSDIR) W !!?3,"Now editing Orderable Item:",!?3,$P(^PS(50.7,ZZFLAG,0),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^") D INACT^PSSSOLIT
28 K PSSDIR,PSSCROSS D EN^PSSPOIDT(PSSOI) D:'$G(PSSSSS) EN2^PSSHL1(PSSOI,"MUP")
29 G ^PSSSOLIT
Note: See TracBrowser for help on using the repository browser.