- PSODGDG2 ;BIR/RTR-drug drug interaction continued ;8/8/96
- ;;7.0;OUTPATIENT PHARMACY;**27,130**;DEC 1997
- ;External reference to ^DPT supported by DBIA 10035
- ;External references to U, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
- EN ;Activate or process an Rx
- Q:'$G(DA)
- K ^PS(52.4,"ADI",DA,1),^PSRX(DA,"DRI") F ZZZ=8,9,10 S $P(^PS(52.4,DA,0),"^",ZZZ)=""
- K ZZZ Q
- PROC I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) W $C(7),$C(7),!!,"SITE PARAMETERS MUST BE DEFINED !",! G EX
- I '$D(^XUSEC("PSORPH",DUZ)) W $C(7),$C(7),!,"YOU MUST BE A PHARMACIST TO COMPLETE THIS PROCEDURE !",!! Q
- I $P($G(^VA(200,DUZ,20)),"^",4)']"" W $C(7),$C(7),!,"YOU DO NOT HAVE AN ELECTRONIC SIGNATURE CODE !",!! Q
- BEG S DIC="^PS(52.4,",DIC(0)="AQXEZ",DIC("A")="Select RX with Drug Interaction: ",DIC("S")="I $D(^PS(52.4,""ADI"",+Y))"
- S DIC("W")="W ?$X+5,$P(^DPT($P(^PS(52.4,+Y,0),""^"",2),0),""^"")_"" "",?40,$E($P(^(0),""^"",9),1,3)_""-""_$E($P(^(0),""^"",9),4,5)_""-""_$E($P(^(0),""^"",9),6,9)"
- D ^DIC K DIC G:"^"[$E(X)!($D(DTOUT)) EX
- ENT S (PSODFN,PSOVRDFN,DFN,PSDFN)=$P(Y(0),"^",2),PPL="",PSONAM=$P(^DPT(PSDFN,0),"^"),(PSONV,PSONVXX,IFN,DGDG)=+Y D STAT G:FLAGST BEG D ^PSOBUILD
- S PSOPLCK=$$L^PSSLOCK(PSODFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY K PSOPLCK G BEG
- K PSOPLCK D PSOL^PSSLOCK(PSONV) I '$G(PSOMSG) D UL^PSSLOCK(PSODFN) D K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,PSOMSG G BEG
- .I $P($G(PSOMSG),"^",2)'="" W !!,$P(PSOMSG,"^",2),! Q
- .W !!,"Another person is editing this order.",!
- D PID^VADPT
- D DGDGI^PSOVER I $G(VERLFLAG) D UL^PSSLOCK(PSOVRDFN) D PSOUL^PSSLOCK(PSONVXX) K VERLFLAG G BEG
- D PACK^PSOVER
- D UL^PSSLOCK(PSOVRDFN),PSOUL^PSSLOCK(PSONVXX)
- W !! G BEG
- EX D END^PSOVER K PSORX,PSOVRDFN,PSONVXX Q
- ;
- STAT ;
- S FLAGST=0
- S ST00=$P($G(^PSRX(PSONV,"STA")),"^")
- I $P($G(^PSRX(PSONV,2)),"^",6),+$P($G(^PSRX(PSONV,2)),"^",6)<DT,ST00<12 S $P(^PSRX(PSONV,"STA"),"^")=11,ST00=11
- I ST00=1!(ST00=4) Q
- S FLAGST=1
- K DIK S DA=PSONV,DIK="^PS(52.4," D ^DIK K DIK
- I ST00>10,ST00<16,$O(^PS(52.5,"B",PSONV,0)) S DA=$O(^PS(52.5,"B",PSONV,0)),DIK="^PS(52.5," D ^DIK K DIK
- I ST00>10,ST00<16,$G(^PSRX(PSONV,"H"))]"" K:$P(^PSRX(PSONV,"H"),"^") ^PSRX("AH",$P(^PSRX(PSONV,"H"),"^"),PSONV) S ^PSRX(PSONV,"H")=""
- S STEXT=$S(ST00=0:"Active",ST00=2:"Refill",ST00=3:"Hold",ST00=5:"Suspended",ST00=11:"Expired",ST00=12:"Canceled",ST00=13:"Deleted",ST00=14:"Discontinued",ST00=15:"Discontinued (Edit)",ST00=16:"Provider Hold",1:"Unknown")
- I '$G(CLFLAG) W !!?3,"Rx # ",$P($G(^PSRX(PSONV,0)),"^")," has a status of ",STEXT_".",! K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR W ! K DIR
- Q
- PSODGDG2 ;BIR/RTR-drug drug interaction continued ;8/8/96
- +1 ;;7.0;OUTPATIENT PHARMACY;**27,130**;DEC 1997
- +2 ;External reference to ^DPT supported by DBIA 10035
- +3 ;External references to U, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
- EN ;Activate or process an Rx
- +1 IF '$GET(DA)
- QUIT
- +2 KILL ^PS(52.4,"ADI",DA,1),^PSRX(DA,"DRI")
- FOR ZZZ=8,9,10
- SET $PIECE(^PS(52.4,DA,0),"^",ZZZ)=""
- +3 KILL ZZZ
- QUIT
- PROC IF '$DATA(PSOPAR)
- DO ^PSOLSET
- IF '$DATA(PSOPAR)
- WRITE $CHAR(7),$CHAR(7),!!,"SITE PARAMETERS MUST BE DEFINED !",!
- GOTO EX
- +1 IF '$DATA(^XUSEC("PSORPH",DUZ))
- WRITE $CHAR(7),$CHAR(7),!,"YOU MUST BE A PHARMACIST TO COMPLETE THIS PROCEDURE !",!!
- QUIT
- +2 IF $PIECE($GET(^VA(200,DUZ,20)),"^",4)']""
- WRITE $CHAR(7),$CHAR(7),!,"YOU DO NOT HAVE AN ELECTRONIC SIGNATURE CODE !",!!
- QUIT
- BEG SET DIC="^PS(52.4,"
- SET DIC(0)="AQXEZ"
- SET DIC("A")="Select RX with Drug Interaction: "
- SET DIC("S")="I $D(^PS(52.4,""ADI"",+Y))"
- +1 SET DIC("W")="W ?$X+5,$P(^DPT($P(^PS(52.4,+Y,0),""^"",2),0),""^"")_"" "",?40,$E($P(^(0),""^"",9),1,3)_""-""_$E($P(^(0),""^"",9),4,5)_""-""_$E($P(^(0),""^"",9),6,9)"
- +2 DO ^DIC
- KILL DIC
- IF "^"[$EXTRACT(X)!($DATA(DTOUT))
- GOTO EX
- ENT SET (PSODFN,PSOVRDFN,DFN,PSDFN)=$PIECE(Y(0),"^",2)
- SET PPL=""
- SET PSONAM=$PIECE(^DPT(PSDFN,0),"^")
- SET (PSONV,PSONVXX,IFN,DGDG)=+Y
- DO STAT
- IF FLAGST
- GOTO BEG
- DO ^PSOBUILD
- +1 SET PSOPLCK=$$L^PSSLOCK(PSODFN,0)
- IF '$GET(PSOPLCK)
- DO LOCK^PSOORCPY
- KILL PSOPLCK
- GOTO BEG
- +2 KILL PSOPLCK
- DO PSOL^PSSLOCK(PSONV)
- IF '$GET(PSOMSG)
- DO UL^PSSLOCK(PSODFN)
- Begin DoDot:1
- +3 IF $PIECE($GET(PSOMSG),"^",2)'=""
- WRITE !!,$PIECE(PSOMSG,"^",2),!
- QUIT
- +4 WRITE !!,"Another person is editing this order.",!
- End DoDot:1
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- KILL DIR,PSOMSG
- GOTO BEG
- +5 DO PID^VADPT
- +6 DO DGDGI^PSOVER
- IF $GET(VERLFLAG)
- DO UL^PSSLOCK(PSOVRDFN)
- DO PSOUL^PSSLOCK(PSONVXX)
- KILL VERLFLAG
- GOTO BEG
- +7 DO PACK^PSOVER
- +8 DO UL^PSSLOCK(PSOVRDFN)
- DO PSOUL^PSSLOCK(PSONVXX)
- +9 WRITE !!
- GOTO BEG
- EX DO END^PSOVER
- KILL PSORX,PSOVRDFN,PSONVXX
- QUIT
- +1 ;
- STAT ;
- +1 SET FLAGST=0
- +2 SET ST00=$PIECE($GET(^PSRX(PSONV,"STA")),"^")
- +3 IF $PIECE($GET(^PSRX(PSONV,2)),"^",6)
- IF +$PIECE($GET(^PSRX(PSONV,2)),"^",6)<DT
- IF ST00<12
- SET $PIECE(^PSRX(PSONV,"STA"),"^")=11
- SET ST00=11
- +4 IF ST00=1!(ST00=4)
- QUIT
- +5 SET FLAGST=1
- +6 KILL DIK
- SET DA=PSONV
- SET DIK="^PS(52.4,"
- DO ^DIK
- KILL DIK
- +7 IF ST00>10
- IF ST00<16
- IF $ORDER(^PS(52.5,"B",PSONV,0))
- SET DA=$ORDER(^PS(52.5,"B",PSONV,0))
- SET DIK="^PS(52.5,"
- DO ^DIK
- KILL DIK
- +8 IF ST00>10
- IF ST00<16
- IF $GET(^PSRX(PSONV,"H"))]""
- IF $PIECE(^PSRX(PSONV,"H"),"^")
- KILL ^PSRX("AH",$PIECE(^PSRX(PSONV,"H"),"^"),PSONV)
- SET ^PSRX(PSONV,"H")=""
- +9 SET STEXT=$SELECT(ST00=0:"Active",ST00=2:"Refill",ST00=3:"Hold",ST00=5:"Suspended",ST00=11:"Expired",ST00=12:"Canceled",ST00=13:"Deleted",ST00=14:"Discontinued",ST00=15:"Discontinued (Edit)",ST00=16:"Provider Hold",1:"Unknown")
- +10 IF '$GET(CLFLAG)
- WRITE !!?3,"Rx # ",$PIECE($GET(^PSRX(PSONV,0)),"^")," has a status of ",STEXT_".",!
- KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue"
- DO ^DIR
- WRITE !
- KILL DIR
- +11 QUIT
