| 1 | PSSSUTIL ;BIR/RTR-Utility routine for Orderable Item ;09/02/97
|
---|
| 2 | ;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
|
---|
| 3 | MAT ; 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 | ;
|
---|
| 17 | SOMAT ;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
|
---|