- PSSSEE ;BIR/ASJ-SYNONYM DRUG ENTER/EDIT ROUTINE ; 01/21/00 13:30
- ;;1.0;PHARMACY DATA MANAGEMENT;**37,57,70,77,82,125**;09/30/97;Build 2
- ;Reference to ^PS(59 supported by DBIA #1976
- ;
- N PSDRUG,PSSFLAG,XX,DVER,DMFU,DNSNAM,DNSPORT S XX=""
- BEGIN S PSSFLAG=0 D ^PSSDEE2 F PSSXX=1:1 K DA D ASK Q:PSSFLAG
- DONE D ^PSSDEE2 K PSSFLAG W @IOF Q
- ASK W ! S DIC="^PSDRUG(",DIC(0)="QEAMN" D ^DIC K DIC I Y<0 S PSSFLAG=1 Q
- S DA=+Y,DISPDRG=DA L +^PSDRUG(DISPDRG):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I '$T W !,$C(7),"Another person is editing this one." Q
- D COMMON I '$G(PSSHUIDG) D DRG^PSSHUIDG(DISPDRG) D L -^PSDRUG(DISPDRG)
- . F XX=0:0 S XX=$O(^PS(59,XX)) Q:'XX D
- ..S DVER=$$GET1^DIQ(59,XX_",",105,"I"),DMFU=$$GET1^DIQ(59,XX_",",105.2)
- ..I DVER="2.4" S DNSNAM=$$GET1^DIQ(59,XX_",",2006),DNSPORT=$$GET1^DIQ(59,XX_",",2007) I DNSNAM'=""&(DMFU="YES") D DRG^PSSDGUPD(DISPDRG,"",DNSNAM,DNSPORT)
- Q
- COMMON S DIE="^PSDRUG(",DR="[PSS SYNONYM]" D ^DIE K DIE,DR,DA,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSSEE 966 printed Feb 19, 2025@00:00:25 Page 2
- PSSSEE ;BIR/ASJ-SYNONYM DRUG ENTER/EDIT ROUTINE ; 01/21/00 13:30
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**37,57,70,77,82,125**;09/30/97;Build 2
- +2 ;Reference to ^PS(59 supported by DBIA #1976
- +3 ;
- +4 NEW PSDRUG,PSSFLAG,XX,DVER,DMFU,DNSNAM,DNSPORT
- SET XX=""
- BEGIN SET PSSFLAG=0
- DO ^PSSDEE2
- FOR PSSXX=1:1
- KILL DA
- DO ASK
- if PSSFLAG
- QUIT
- DONE DO ^PSSDEE2
- KILL PSSFLAG
- WRITE @IOF
- QUIT
- ASK WRITE !
- SET DIC="^PSDRUG("
- SET DIC(0)="QEAMN"
- DO ^DIC
- KILL DIC
- IF Y<0
- SET PSSFLAG=1
- QUIT
- +1 SET DA=+Y
- SET DISPDRG=DA
- LOCK +^PSDRUG(DISPDRG):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
- IF '$TEST
- WRITE !,$CHAR(7),"Another person is editing this one."
- QUIT
- +2 DO COMMON
- IF '$GET(PSSHUIDG)
- DO DRG^PSSHUIDG(DISPDRG)
- Begin DoDot:1
- +3 FOR XX=0:0
- SET XX=$ORDER(^PS(59,XX))
- if 'XX
- QUIT
- Begin DoDot:2
- +4 SET DVER=$$GET1^DIQ(59,XX_",",105,"I")
- SET DMFU=$$GET1^DIQ(59,XX_",",105.2)
- +5 IF DVER="2.4"
- SET DNSNAM=$$GET1^DIQ(59,XX_",",2006)
- SET DNSPORT=$$GET1^DIQ(59,XX_",",2007)
- IF DNSNAM'=""&(DMFU="YES")
- DO DRG^PSSDGUPD(DISPDRG,"",DNSNAM,DNSPORT)
- End DoDot:2
- End DoDot:1
- LOCK -^PSDRUG(DISPDRG)
- +6 QUIT
- COMMON SET DIE="^PSDRUG("
- SET DR="[PSS SYNONYM]"
- DO ^DIE
- KILL DIE,DR,DA,Y
- +1 QUIT
