PSSSUTIL ;BIR/RTR-Utility routine for Orderable Item ;09/02/97
;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
MAT ; Match Additive to already existing Orderable Item
K DIE S DIE="^PS(52.6,",DA=PSAIEN,DR="15////"_ZZFLAG D ^DIE K DIE
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)
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)
I SCOUNT D
.S VV=0 F VVV=0:0 S VVV=$O(^PS(50.7,ZZFLAG,2,VVV)) Q:'VVV S VV=VVV
.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
.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)=""
.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
.S ^PS(50.7,ZZFLAG,2,0)="^50.72^"_SCLAST_"^"_SCOUNT
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
K PSSDIR,PSSCROSS D EN^PSSPOIDT(PSPOI) D:'$G(PSSSSS) EN2^PSSHL1(PSPOI,"MUP")
G EN^PSSADDIT
;
SOMAT ;Match Solution to an already existing Orderable Item
K DIE S DIE="^PS(52.7,",DA=PSSIEN,DR="9////"_ZZFLAG D ^DIE K DIE
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)
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)
I SCOUNT D
.S VV=0 F VVV=0:0 S VVV=$O(^PS(50.7,ZZFLAG,2,VVV)) Q:'VVV S VV=VVV
.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
.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)=""
.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
.S ^PS(50.7,ZZFLAG,2,0)="^50.72^"_SCLAST_"^"_SCOUNT
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
K PSSDIR,PSSCROSS D EN^PSSPOIDT(PSSOI) D:'$G(PSSSSS) EN2^PSSHL1(PSSOI,"MUP")
G ^PSSSOLIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSSUTIL 2319 printed Dec 13, 2024@02:34:27 Page 2
PSSSUTIL ;BIR/RTR-Utility routine for Orderable Item ;09/02/97
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**38**;9/30/97
MAT ; Match Additive to already existing Orderable Item
+1 KILL DIE
SET DIE="^PS(52.6,"
SET DA=PSAIEN
SET DR="15////"_ZZFLAG
DO ^DIE
KILL DIE
+2 KILL SYN1
SET SCOUNT=0
FOR SS=0:0
SET SS=$ORDER(^PS(52.6,PSAIEN,3,SS))
if 'SS
QUIT
SET SCOUNT=SCOUNT+1
SET SYN(SCOUNT)=^(SS,0)
+3 IF SCOUNT
SET SCOUNT=0
FOR WW=0:0
SET WW=$ORDER(SYN(WW))
if 'WW
QUIT
IF '$DATA(^PS(50.7,ZZFLAG,2,"B",SYN(WW)))
SET SCOUNT=SCOUNT+1
SET SYN1(SCOUNT)=SYN(WW)
+4 IF SCOUNT
Begin DoDot:1
+5 SET VV=0
FOR VVV=0:0
SET VVV=$ORDER(^PS(50.7,ZZFLAG,2,VVV))
if 'VVV
QUIT
SET VV=VVV
+6 SET VV=$SELECT('$GET(VV):1,1:VV+1)
FOR TT=0:0
SET TT=$ORDER(SYN1(TT))
if 'TT
QUIT
SET ^PS(50.7,ZZFLAG,2,VV,0)=SYN1(TT)
SET VV=VV+1
+7 FOR VV=0:0
SET VV=$ORDER(^PS(50.7,ZZFLAG,2,VV))
if 'VV
QUIT
SET SYNNAM=$PIECE(^(VV,0),"^")
SET ^PS(50.7,ZZFLAG,2,"B",SYNNAM,VV)=""
+8 SET (SCOUNT,SCLAST)=0
FOR TT=0:0
SET TT=$ORDER(^PS(50.7,ZZFLAG,2,TT))
if 'TT
QUIT
SET SCOUNT=SCOUNT+1
SET SCLAST=TT
+9 SET ^PS(50.7,ZZFLAG,2,0)="^50.72^"_SCLAST_"^"_SCOUNT
End DoDot:1
+10 SET PSPOI=ZZFLAG
SET NEWFLAG=1
DO DIR^PSSPOIM3
IF $GET(PSSDIR)
WRITE !!?3,"Now editing Orderable Item:",!?3,$PIECE(^PS(50.7,ZZFLAG,0),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^")
DO INACT^PSSADDIT
+11 KILL PSSDIR,PSSCROSS
DO EN^PSSPOIDT(PSPOI)
if '$GET(PSSSSS)
DO EN2^PSSHL1(PSPOI,"MUP")
+12 GOTO EN^PSSADDIT
+13 ;
SOMAT ;Match Solution to an already existing Orderable Item
+1 KILL DIE
SET DIE="^PS(52.7,"
SET DA=PSSIEN
SET DR="9////"_ZZFLAG
DO ^DIE
KILL DIE
+2 KILL SYN1
SET SCOUNT=0
FOR SS=0:0
SET SS=$ORDER(^PS(52.7,PSSIEN,3,SS))
if 'SS
QUIT
SET SCOUNT=SCOUNT+1
SET SYN(SCOUNT)=^(SS,0)
+3 IF SCOUNT
SET SCOUNT=0
FOR WW=0:0
SET WW=$ORDER(SYN(WW))
if 'WW
QUIT
IF '$DATA(^PS(50.7,ZZFLAG,2,"B",SYN(WW)))
SET SCOUNT=SCOUNT+1
SET SYN1(SCOUNT)=SYN(WW)
+4 IF SCOUNT
Begin DoDot:1
+5 SET VV=0
FOR VVV=0:0
SET VVV=$ORDER(^PS(50.7,ZZFLAG,2,VVV))
if 'VVV
QUIT
SET VV=VVV
+6 SET VV=$SELECT('$GET(VV):1,1:VV+1)
FOR TT=0:0
SET TT=$ORDER(SYN1(TT))
if 'TT
QUIT
SET ^PS(50.7,ZZFLAG,2,VV,0)=SYN1(TT)
SET VV=VV+1
+7 FOR VV=0:0
SET VV=$ORDER(^PS(50.7,ZZFLAG,2,VV))
if 'VV
QUIT
SET SYNNAM=$PIECE(^(VV,0),"^")
SET ^PS(50.7,ZZFLAG,2,"B",SYNNAM,VV)=""
+8 SET (SCOUNT,SCLAST)=0
FOR TT=0:0
SET TT=$ORDER(^PS(50.7,ZZFLAG,2,TT))
if 'TT
QUIT
SET SCOUNT=SCOUNT+1
SET SCLAST=TT
+9 SET ^PS(50.7,ZZFLAG,2,0)="^50.72^"_SCLAST_"^"_SCOUNT
End DoDot:1
+10 SET PSSOI=ZZFLAG
SET NEWFLAG=1
DO DIR^PSSPOIM3
IF $GET(PSSDIR)
WRITE !!?3,"Now editing Orderable Item:",!?3,$PIECE(^PS(50.7,ZZFLAG,0),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^")
DO INACT^PSSSOLIT
+11 KILL PSSDIR,PSSCROSS
DO EN^PSSPOIDT(PSSOI)
if '$GET(PSSSSS)
DO EN2^PSSHL1(PSSOI,"MUP")
+12 GOTO ^PSSSOLIT
