PSORXI.m

PSORXI ;IHS/DSD/JCM - logs pharmacy interventions ;29-May-2012 15:12;PLS

 ;;7.0;OUTPATIENT PHARMACY;**268,1015**;DEC 1997;Build 62

 ; This routine is used to create entries in the APSP INTERVENTION file.

 ; Modified - IHS/CIA/PLS - 12/22/03 - Line DIC+2

START ;

 D INIT,DIC G:PSORXI("QFLG") END

 D EDIT

 S:'$D(PSONEW("PROVIDER")) PSONEW("PROVIDER")=$P(^APSPQA(32.4,PSORXI("DA"),0),"^",3)

END D EOJ

 Q

INIT ;

 W !!,"Now creating Pharmacy Intervention",!

 I $G(PSODRUG("IEN")) W "for  "_$P($G(^PSDRUG(PSODRUG("IEN"),0)),"^"),!

 K PSORXI S PSORXI("QFLG")=0

 Q

DIC ;

 K DIC,DR,DA,X,Y,DD,DO S DIC="^APSPQA(32.4,",DLAYGO=9009032.4,DIC(0)="L",X=DT

 ; IHS/CIA/PLS - 12/22/03 - Adjust .07 value

 N APSPCRI,APSPSIG,APSPINT

 S APSPINT=+$G(PSORX("INTERVENE"))

 S APSPCRI=$O(^APSPQA(32.3,"B","CRITICAL DRUG INTERACTION","")),APSPSIG=$O(^APSPQA(32.3,"B","SIGNIFICANT DRUG INTERACTION",""))

 S DIC("DR")=".02////"_+PSODFN_";.04////"_DUZ_";.05////"_PSODRUG("IEN")_";.06///PHARMACY"

 ;S DIC("DR")=DIC("DR")_";.07"_$S($G(PSORX("INTERVENE"))=1:"////18",$G(PSORX("INTERVENE"))=2:"////19",1:"////6")_";.14////0"_";.16////"_$S($G(PSOSITE)]"":PSOSITE,1:"")

 S DIC("DR")=DIC("DR")_";.07"_$S(APSPINT=1:"////"_APSPCRI,APSPINT=2:"////"_APSPSIG,APSPINT=3:"////6",APSPINT=4:"////10",1:"")_";.14////0"_";.16////"_$S($G(PSOSITE)]"":PSOSITE,1:"")

 D FILE^DICN K DIC,DR,DA

 ; IHS/CIA/PLS - 12/22/03 - Commented next line and modified to set interacting drug

 ;I Y>0 S PSORXI("DA")=+Y

 I Y>0 S PSORXI("DA")=+Y D

 .I APSPINT=1!(APSPINT=2) D

 ..S ^APSPQA(32.4,+Y,13,0)="^^1^1^"_$P(Y,U,2)_U,^(1,0)="INTERACTING DRUG IS "_$G(DRG)

 E  S PSORXI("QFLG")=1 G DICX

 D DIE

DICX K X,Y

 Q

DIE ;

 K DIE,DIC,DR,DA

 S DIE="^APSPQA(32.4,",DA=PSORXI("DA"),DR=$S($G(PSORXI("EDIT"))]"":".03:1600",1:".03;.08")

 L +^APSPQA(32.4,PSORXI("DA")):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) D ^DIE K DIE,DIC,DR,X,Y,DA L -^APSPQA(32.4,PSORXI("DA"))

 W $C(7),!!,"See 'Pharmacy Intervention Menu' if you want to delete this",!,"intervention or for more options.",!

 Q

EDIT ;

 K DIR W ! S DIR(0)="Y",DIR("A")="Would you like to edit this intervention ",DIR("B")="N" D ^DIR K DIR I $D(DIRUT)!'Y G EDITX

 S PSORXI("EDIT")=1 D DIE G EDIT

EDITX K X,Y

 Q

EOJ ;

 K PSORXI

 Q

EN1(PSOX) ; Entry Point if have internal rx #

 N PSODFN,PSONEW,PSODRUG,PSOY

 I $G(^PSRX(+$G(PSOX),0))']"" W !,$C(7),"No prescription data" G EN1X

 S PSORXI("IRXN")=PSOX K PSOY S PSOY=^PSRX(PSORXI("IRXN"),0)

 S PSODFN=$P(PSOY,"^",2),PSONEW("PROVIDER")=$P(PSOY,"^",4),PSODRUG("IEN")=$P(PSOY,"^",6)

 D START

EN1X Q

PSORXI    ;IHS/DSD/JCM - logs pharmacy interventions ;29-May-2012 15:12;PLS

 +1       ;;7.0;OUTPATIENT PHARMACY;**268,1015**;DEC 1997;Build 62

 +2       ; This routine is used to create entries in the APSP INTERVENTION file.

 +3       ; Modified - IHS/CIA/PLS - 12/22/03 - Line DIC+2

START     ;

 +1        DO INIT

           DO DIC

           IF PSORXI("QFLG")

               GOTO END

 +2        DO EDIT

 +3        IF '$DATA(PSONEW("PROVIDER"))

               SET PSONEW("PROVIDER")=$PIECE(^APSPQA(32.4,PSORXI("DA"),0),"^",3)

END        DO EOJ

 +1        QUIT 

INIT      ;

 +1        WRITE !!,"Now creating Pharmacy Intervention",!

 +2        IF $GET(PSODRUG("IEN"))

               WRITE "for  "_$PIECE($GET(^PSDRUG(PSODRUG("IEN"),0)),"^"),!

 +3        KILL PSORXI

           SET PSORXI("QFLG")=0

 +4        QUIT 

DIC       ;

 +1        KILL DIC,DR,DA,X,Y,DD,DO

           SET DIC="^APSPQA(32.4,"

           SET DLAYGO=9009032.4

           SET DIC(0)="L"

           SET X=DT

 +2       ; IHS/CIA/PLS - 12/22/03 - Adjust .07 value

 +3        NEW APSPCRI,APSPSIG,APSPINT

 +4        SET APSPINT=+$GET(PSORX("INTERVENE"))

 +5        SET APSPCRI=$ORDER(^APSPQA(32.3,"B","CRITICAL DRUG INTERACTION",""))

           SET APSPSIG=$ORDER(^APSPQA(32.3,"B","SIGNIFICANT DRUG INTERACTION",""))

 +6        SET DIC("DR")=".02////"_+PSODFN_";.04////"_DUZ_";.05////"_PSODRUG("IEN")_";.06///PHARMACY"

 +7       ;S DIC("DR")=DIC("DR")_";.07"_$S($G(PSORX("INTERVENE"))=1:"////18",$G(PSORX("INTERVENE"))=2:"////19",1:"////6")_";.14////0"_";.16////"_$S($G(PSOSITE)]"":PSOSITE,1:"")

 +8        SET DIC("DR")=DIC("DR")_";.07"_$SELECT(APSPINT=1:"////"_APSPCRI,APSPINT=2:"////"_APSPSIG,APSPINT=3:"////6",APSPINT=4:"////10",1:"")_";.14////0"_";.16////"_$SELECT($GET(PSOSITE)]"":PSOSITE,1:"")

 +9        DO FILE^DICN

           KILL DIC,DR,DA

 +10      ; IHS/CIA/PLS - 12/22/03 - Commented next line and modified to set interacting drug

 +11      ;I Y>0 S PSORXI("DA")=+Y

 +12       IF Y>0

               SET PSORXI("DA")=+Y

               Begin DoDot:1

 +13               IF APSPINT=1!(APSPINT=2)

                       Begin DoDot:2

 +14                       SET ^APSPQA(32.4,+Y,13,0)="^^1^1^"_$PIECE(Y,U,2)_U

                           SET ^(1,0)="INTERACTING DRUG IS "_$GET(DRG)

                       End DoDot:2

               End DoDot:1

 +15      IF '$TEST

               SET PSORXI("QFLG")=1

               GOTO DICX

 +16       DO DIE

DICX       KILL X,Y

 +1        QUIT 

DIE       ;

 +1        KILL DIE,DIC,DR,DA

 +2        SET DIE="^APSPQA(32.4,"

           SET DA=PSORXI("DA")

           SET DR=$SELECT($GET(PSORXI("EDIT"))]"":".03:1600",1:".03;.08")

 +3        LOCK +^APSPQA(32.4,PSORXI("DA")):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)

           DO ^DIE

           KILL DIE,DIC,DR,X,Y,DA

           LOCK -^APSPQA(32.4,PSORXI("DA"))

 +4        WRITE $CHAR(7),!!,"See 'Pharmacy Intervention Menu' if you want to delete this",!,"intervention or for more options.",!

 +5        QUIT 

EDIT      ;

 +1        KILL DIR

           WRITE !

           SET DIR(0)="Y"

           SET DIR("A")="Would you like to edit this intervention "

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)!'Y

               GOTO EDITX

 +2        SET PSORXI("EDIT")=1

           DO DIE

           GOTO EDIT

EDITX      KILL X,Y

 +1        QUIT 

EOJ       ;

 +1        KILL PSORXI

 +2        QUIT 

EN1(PSOX) ; Entry Point if have internal rx #

 +1        NEW PSODFN,PSONEW,PSODRUG,PSOY

 +2        IF $GET(^PSRX(+$GET(PSOX),0))']""

               WRITE !,$CHAR(7),"No prescription data"

               GOTO EN1X

 +3        SET PSORXI("IRXN")=PSOX

           KILL PSOY

           SET PSOY=^PSRX(PSORXI("IRXN"),0)

 +4        SET PSODFN=$PIECE(PSOY,"^",2)

           SET PSONEW("PROVIDER")=$PIECE(PSOY,"^",4)

           SET PSODRUG("IEN")=$PIECE(PSOY,"^",6)

 +5        DO START

EN1X       QUIT