PSNDINT ;BIR/DMA-ENTER/EDIT INTERACTIONS ;27 Aug 98 / 10:39 AM
;;4.0;NATIONAL DRUG FILE;**430**; 30 Oct 98;Build 1
GO W !!
S PSNDF=1
S DIC=50.416,DIC(0)="AEMQZ",DIC("A")="Choose first ingredient ",DIC("S")="I '$P(^(0),""^"",2)" D ^DIC G OUT:Y<0 S PSN1=+Y,PSNN($P(Y(0),"^"))=""
S DIC("A")="Choose second ingredient ",DIC("S")=DIC("S")_",+Y'=PSN1" D ^DIC G OUT:Y<0 S PSN2=+Y,PSNN($P(Y(0),"^"))=""
S DA=$O(^PS(56,"AE",PSN1,PSN2,0)) I DA S PSN=^PS(56,DA,0),PSNL=$G(^("L")) D G GO
.I DA<=15000!(DA>50000),$P(PSN,"^",4)=1,'PSNL W !!,"That interaction is nationally entered and may not be edited." Q ;430 edit
.S DIR(0)="Y",DIR("A")="That interaction already exists. Do you wish to edit it" D ^DIR Q:'Y K DIR S DIR(0)="56,3" D ^DIR Q:'Y S DIE="^PS(56,",DR="3////"_Y_";6////1" D ^DIE Q
S PSNNN=$O(PSNN(""))_"/"_$O(PSNN($O(PSNN(""))))
K DA,DIR S DIR(0)="56,3" D ^DIR G OUT:$D(DTOUT)!$D(DUOUT) S PSN=Y
W !,PSNNN," Severity : ",Y(0)
S DIR(0)="Y",DIR("A")="OK to add " D ^DIR G OUT:$D(DTOUT)!$D(DUOUT) I 'Y K PSNN,PSNNN G GO
F L +^PS(56):3 Q:$T
S DINUM=$O(^PS(56,50000),-1)+1 I DINUM<=15000 S DINUM=15001 ;430 edit
S DIC("DR")="1////"_PSN1_";2////"_PSN2_";3////"_PSN_";6////1",DIC="^PS(56,",DIC(0)="L",X=PSNNN K DD,DO D FILE^DICN L -^PS(56)
K PSN,PSN1,PSN2,PSNN,PSNNN G GO
;
OUT K PSN,PSN1,PSN2,PSNDF,PSNL,PSNN,PSNNN,DA,DIC,DIR,DIRUT,DR,X,Y,DIE,DINUM,DTOUT,DUOUT Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNDINT 1396 printed Sep 23, 2025@19:59:56 Page 2
PSNDINT ;BIR/DMA-ENTER/EDIT INTERACTIONS ;27 Aug 98 / 10:39 AM
+1 ;;4.0;NATIONAL DRUG FILE;**430**; 30 Oct 98;Build 1
GO WRITE !!
+1 SET PSNDF=1
+2 SET DIC=50.416
SET DIC(0)="AEMQZ"
SET DIC("A")="Choose first ingredient "
SET DIC("S")="I '$P(^(0),""^"",2)"
DO ^DIC
if Y<0
GOTO OUT
SET PSN1=+Y
SET PSNN($PIECE(Y(0),"^"))=""
+3 SET DIC("A")="Choose second ingredient "
SET DIC("S")=DIC("S")_",+Y'=PSN1"
DO ^DIC
if Y<0
GOTO OUT
SET PSN2=+Y
SET PSNN($PIECE(Y(0),"^"))=""
+4 SET DA=$ORDER(^PS(56,"AE",PSN1,PSN2,0))
IF DA
SET PSN=^PS(56,DA,0)
SET PSNL=$GET(^("L"))
Begin DoDot:1
+5 ;430 edit
IF DA<=15000!(DA>50000)
IF $PIECE(PSN,"^",4)=1
IF 'PSNL
WRITE !!,"That interaction is nationally entered and may not be edited."
QUIT
+6 SET DIR(0)="Y"
SET DIR("A")="That interaction already exists. Do you wish to edit it"
DO ^DIR
if 'Y
QUIT
KILL DIR
SET DIR(0)="56,3"
DO ^DIR
if 'Y
QUIT
SET DIE="^PS(56,"
SET DR="3////"_Y_";6////1"
DO ^DIE
QUIT
End DoDot:1
GOTO GO
+7 SET PSNNN=$ORDER(PSNN(""))_"/"_$ORDER(PSNN($ORDER(PSNN(""))))
+8 KILL DA,DIR
SET DIR(0)="56,3"
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO OUT
SET PSN=Y
+9 WRITE !,PSNNN," Severity : ",Y(0)
+10 SET DIR(0)="Y"
SET DIR("A")="OK to add "
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO OUT
IF 'Y
KILL PSNN,PSNNN
GOTO GO
+11 FOR
LOCK +^PS(56):3
if $TEST
QUIT
+12 ;430 edit
SET DINUM=$ORDER(^PS(56,50000),-1)+1
IF DINUM<=15000
SET DINUM=15001
+13 SET DIC("DR")="1////"_PSN1_";2////"_PSN2_";3////"_PSN_";6////1"
SET DIC="^PS(56,"
SET DIC(0)="L"
SET X=PSNNN
KILL DD,DO
DO FILE^DICN
LOCK -^PS(56)
+14 KILL PSN,PSN1,PSN2,PSNN,PSNNN
GOTO GO
+15 ;
OUT KILL PSN,PSN1,PSN2,PSNDF,PSNL,PSNN,PSNNN,DA,DIC,DIR,DIRUT,DR,X,Y,DIE,DINUM,DTOUT,DUOUT
QUIT
