- 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 Jan 18, 2025@03:35:08 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