- 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
