PSSDINT.m

PSSDINT ;BIR/DMA - ENTER/EDIT INTERACTIONS ; 02/11/15 12:53

 ;;1.0;PHARMACY DATA MANAGEMENT;**17,20,43,190**;9/30/97;Build 1

 ;

 ;Reference to $$KSP^XUPARAM("INST") supported by DBIA #2541

 ;Reference to ^PS(56 supported by DBIA #2133

 ;Reference to ^XMD supported by DBIA #10070

 ;

GO W !!

 S PSNDF=1 K PSN,PSN1,PSN2,PSNN,PSNNN

 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(^PS(56,DA,"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  ;190 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;" S:DA>15000&(DA<50001) DR=DR_"7;" D ^DIE D SEVMSG Q  ;190 edit

 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 ;190 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) D ADDMSG

 K PSN,PSN1,PSN2,PSNN,PSNNN G GO

 ;

OUT K PSN,PSN1,PSN2,PSNDF,PSNL,PSNN,PSNNN,DA,DIC,DIR,DIRUT,DR,X,Y,PSNIFN,PSNSEV,PSSFLTY,PSSIIEN,XMDUZ,XMSUB,XMTEXT,XMY,DIE,DINUM,DTOUT,DUOUT

 K ^TMP($J,"PSS")

 Q

 ;

SEVMSG ;If change in severity nationally; send mail message.

 Q:$G(PSNL)  S PSNIFN=^PS(56,DA,0) Q:$P(PSNIFN,U,4)=2

 D HEADER S XMSUB="Drug Interaction Severity Change from "_PSSFLTY_"."

 S ^TMP($J,"PSS",1)="The severity of a nationally entered drug interaction has been edited."

 S ^TMP($J,"PSS",2)="" S ^TMP($J,"PSS",3)=""_$P(PSNIFN,U)_" Drug Interaction severity"

 S ^TMP($J,"PSS",4)="changed from SIGNIFICANT to CRITICAL."

 S XMTEXT="^TMP($J,""PSS""," D ^XMD

 Q

 ;

ADDMSG ;If adding new local interaction; send mail message.

 D HEADER S XMSUB="Local Drug Interaction Added from "_PSSFLTY_"."

 S ^TMP($J,"PSS",1)="Local "_PSNNN_" Drug Interaction"

 S ^TMP($J,"PSS",2)="with a severity of "_$S($P(^PS(56,+Y,0),U,4)=2:"SIGNIFICANT",1:"CRITICAL")_" has been added."

 S XMTEXT="^TMP($J,""PSS""," D ^XMD

 Q

 ;

HEADER ;Message header; facility name

 S PSSIIEN=$$KSP^XUPARAM("INST"),PSSFLTY=$$GET1^DIQ(4,PSSIIEN,.01)

 S XMDUZ=DUZ,XMY("G.NDF SUPPORT@ISCPNDF.ISC-BIRM.VA.GOV")=""

 Q

PSSDINT   ;BIR/DMA - ENTER/EDIT INTERACTIONS ; 02/11/15 12:53

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;**17,20,43,190**;9/30/97;Build 1

 +2       ;

 +3       ;Reference to $$KSP^XUPARAM("INST") supported by DBIA #2541

 +4       ;Reference to ^PS(56 supported by DBIA #2133

 +5       ;Reference to ^XMD supported by DBIA #10070

 +6       ;

GO         WRITE !!

 +1        SET PSNDF=1

           KILL PSN,PSN1,PSN2,PSNN,PSNNN

 +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(^PS(56,DA,"L"))

               Begin DoDot:1

 +5       ;190 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"

 +7       ;190 edit

                   DO ^DIR

                   IF 'Y

                       QUIT 

                   SET DIE="^PS(56,"

                   SET DR="3////"_Y_";6////1;"

                   IF DA>15000&(DA<50001)

                       SET DR=DR_"7;"

                   DO ^DIE

                   DO SEVMSG

                   QUIT 

               End DoDot:1

               GOTO GO

 +8        SET PSNNN=$ORDER(PSNN(""))_"/"_$ORDER(PSNN($ORDER(PSNN(""))))

 +9        KILL DA,DIR

           SET DIR(0)="56,3"

           DO ^DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               GOTO OUT

           SET PSN=Y

 +10       WRITE !,PSNNN,"   Severity : ",Y(0)

 +11       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

 +12       FOR 

               LOCK +^PS(56):3

               IF $TEST

                   QUIT 

 +13      ;190 edit

           SET DINUM=$ORDER(^PS(56,50000),-1)+1

           IF DINUM<=15000

               SET DINUM=15001

 +14       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)

           DO ADDMSG

 +15       KILL PSN,PSN1,PSN2,PSNN,PSNNN

           GOTO GO

 +16      ;

OUT        KILL PSN,PSN1,PSN2,PSNDF,PSNL,PSNN,PSNNN,DA,DIC,DIR,DIRUT,DR,X,Y,PSNIFN,PSNSEV,PSSFLTY,PSSIIEN,XMDUZ,XMSUB,XMTEXT,XMY,DIE,DINUM,DTOUT,DUOUT

 +1        KILL ^TMP($JOB,"PSS")

 +2        QUIT 

 +3       ;

SEVMSG    ;If change in severity nationally; send mail message.

 +1        IF $GET(PSNL)

               QUIT 

           SET PSNIFN=^PS(56,DA,0)

           IF $PIECE(PSNIFN,U,4)=2

               QUIT 

 +2        DO HEADER

           SET XMSUB="Drug Interaction Severity Change from "_PSSFLTY_"."

 +3        SET ^TMP($JOB,"PSS",1)="The severity of a nationally entered drug interaction has been edited."

 +4        SET ^TMP($JOB,"PSS",2)=""

           SET ^TMP($JOB,"PSS",3)=""_$PIECE(PSNIFN,U)_" Drug Interaction severity"

 +5        SET ^TMP($JOB,"PSS",4)="changed from SIGNIFICANT to CRITICAL."

 +6        SET XMTEXT="^TMP($J,""PSS"","

           DO ^XMD

 +7        QUIT 

 +8       ;

ADDMSG    ;If adding new local interaction; send mail message.

 +1        DO HEADER

           SET XMSUB="Local Drug Interaction Added from "_PSSFLTY_"."

 +2        SET ^TMP($JOB,"PSS",1)="Local "_PSNNN_" Drug Interaction"

 +3        SET ^TMP($JOB,"PSS",2)="with a severity of "_$SELECT($PIECE(^PS(56,+Y,0),U,4)=2:"SIGNIFICANT",1:"CRITICAL")_" has been added."

 +4        SET XMTEXT="^TMP($J,""PSS"","

           DO ^XMD

 +5        QUIT 

 +6       ;

HEADER    ;Message header; facility name

 +1        SET PSSIIEN=$$KSP^XUPARAM("INST")

           SET PSSFLTY=$$GET1^DIQ(4,PSSIIEN,.01)

 +2        SET XMDUZ=DUZ

           SET XMY("G.NDF SUPPORT@ISCPNDF.ISC-BIRM.VA.GOV")=""

 +3        QUIT