PSOHELP ;BHAM ISC/SAB-outpatient utility routine ; 10/17/07 7:41am
;;7.0;OUTPATIENT PHARMACY;**3,23,29,48,46,117,131,222,268,206,276,282,444,505**;DEC 1997;Build 39
;External reference ^PS(51 supported by DBIA 2224
;External reference ^PSDRUG( supported by DBIA 221
;External reference ^PS(56 supported by DBIA 2229
;External reference ^PSNPPIP supported by DBIA 2261
;
XREF D XREF^PSOHELP3
Q
SIG ;checks PI for RXs
K VALMSG
I $E(X)=" " D EN^DDIOL("Leading spaces should not entered in the Patient Instructions! ","","$C(7),!") S VALMSG="There are leading spaces in Patient Instructions!"
SIGONE K INS1 Q:$L(X)<1 F Z0=1:1:$L(X," ") G:Z0="" EN S Z1=$P(X," ",Z0) D G:'$D(X) EN
.I $L(Z1)>32 W $C(7),!?5,"MAX OF 32 CHARACTERS ALLOWED BETWEEN SPACES.",! K X Q
.D:$D(X)&($G(Z1)]"") S INS1=$G(INS1)_" "_Z1
..S Z1=$$UPPER^PSOSIG(Z1) ;*282 Provider Comments
..S Y=$O(^PS(51,"B",Z1,0)) Q:'Y!($P($G(^PS(51,+Y,0)),"^",4)>1) S Z1=$P(^PS(51,Y,0),"^",2)
..I $G(^PS(51,+Y,9))]"" S Y=$P(X," ",Z0-1),Y=$E(Y,$L(Y)) S:Y>1 Z1=^(9)
EN K Z1,Z0
Q
SSIG ;other lang. mods
K VALMSG
I $E(X)=" " D EN^DDIOL("Leading spaces should not entered in the Patient Instructions! ","","$C(7),!") S VALMSG="There are leading spaces in Patient Instructions!"
K SINS1 Q:$L(X)<1 F Z0=1:1:$L(X," ") G:Z0="" EX S Z1=$P(X," ",Z0) D G:'$D(X) EX
.I $L(Z1)>32 W $C(7),!?5,"MAX OF 32 CHARACTERS ALLOWED BETWEEN SPACES.",! K X Q
.D:$D(X)&($G(Z1)]"") S SINS1=$G(SINS1)_" "_Z1
..S Z1=$$UPPER^PSOSIG(Z1) ;*282 Provider Comments
..S Y=$O(^PS(51,"B",Z1,0)) Q:'Y!($P($G(^PS(51,+Y,0)),"^",4)>1) S Z1=$P(^PS(51,Y,0),"^",2)
..I $G(^PS(51,+Y,4))]"" S Z1=^PS(51,+Y,4) ;,Y=$P(X," ",Z0-1),Y=$E(Y,$L(Y)) S:Y>1 Z1=^(9)
EX K Z1,Z0
Q
QTY ;Check quantity dispensed against inventory
Q:'$G(PSODRUG("IEN"))
S Z0=$S($G(PSODRUG("IEN"))]"":PSODRUG("IEN"),$G(PSXYES):$P(^PSRX(ZRX,0),"^",6),$D(^PSRX(DA,0)):+$P(^(0),"^",6),1:0)
; PSO*7*505 - Removed the following line to prevent the removal of leading zero's 0.5 being 'plused' removes the 0 and
; evaluates to false, killing X in the event the drug is a cmop drug.
;I $D(^PSDRUG("AQ",Z0)),(+X'=X) K X,Z0 Q
S Z1=$S($D(^PSDRUG(Z0,660.1)):^(660.1),1:0)+(+X) D:X>Z1 EN^DDIOL(" Greater Than Current Inventory!","","$C(7)") K Z1
S ZX=X,ZZ0=$G(D0),D0=Z0
S Y(18,2)=$S($D(^PSDRUG(D0,660)):^(660),1:""),Y(18,1)=$S($D(^(660.1)):^(660.1),1:"")
S X=$P(Y(18,1),"^",1),X=$S($P(Y(18,2),"^",5):X/$P(Y(18,2),"^",5),1:"*******")
S X=$J(X,0,2)
D:X<$S($D(^PSDRUG(Z0,660)):+^(660),1:1) EN^DDIOL(" Below Reorder Level.","","$C(7)") S X=ZX,D0=$G(ZZ0) K ZZ0,Z0,ZX
Q
HELP ;qty help
G:$G(PSOFDR) HLP
S Z0=$S($G(PSODRUG("IEN"))]"":PSODRUG("IEN"),$G(PSXYES):$P(^PSRX(ZRX,0),"^",6),$D(^PSRX(DA,0)):$P(^PSRX(DA,0),"^",6),1:0)
HLP S Z0=+$G(PSODRUG("IEN")) I $D(^PSDRUG("AQ",Z0)) D EN^DDIOL("This is a CMOP drug. The quantity may not contain alpha characters (i.e.; ML)","","!!") D EN^DDIOL("or more than two fractional decimal places (i.e.; .01).","","!") D K Z0 Q
.D EN^DDIOL("Enter a number between 0 and 99999999 inclusive. The total entry cannot","","!") D EN^DDIOL("exceed 11 characters.","","!")
D EN^DDIOL("Enter a whole number between 0 and 99999999 inclusive. Alpha characters are","","!!")
D EN^DDIOL("not allowed, and the entry cannot exceed 11 characters, or contain more than","","!") D EN^DDIOL("two fractional decimal places (i.e.; .01).","","!")
K Z0
Q
ADD ;add/edited local drug/drug interactions
W ! S DIC("A")="Select Drug Interaction: ",DIC(0)="AEMQL",DLAYGO=56
S (DIC,DIE)="^PS(56,",DIC("S")="I '$P(^(0),""^"",5)" D ^DIC G:"^"[X QU G:Y<0 ADD S DA=+Y,DR="[PSO INTERACT]" L +^PS(56,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T W !,"Entry is being edited by another user. Try Later!",! G ADD
D ^DIE L:$G(DA) -^PS(56,DA) K DA G ADD
QU L -^PS(56,DA) K X,DIC,DIE,DA
Q
CRI ;change drug interaction severity to critical from significant
W ! S DIC("A")="Select Drug Interaction: ",DIC(0)="AEQM",(DIC,DIE)="^PS(56,",DIC("S")="I $P(^(0),""^"",4)=2" D ^DIC G:"^"[X QU G:Y<0 CRI S DA=+Y,DR=3
L +^PS(56,DA):$S(+$G(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3) I '$T W !,"Entry is being edited by another user. Try Later!",! G CRI
D ^DIE L -^PS(56,DA) K DA G CRI
G QU
Q
MAX S:$G(EXH) P(7)=$P(^PSRX(DA,0),"^",8),P(5)=$P(^(0),"^",6),P(2)=+$P(^(0),"^",3) S:P(2) PTST=$G(^PS(53,P(2),0)),PTDY=$P($G(^(0)),"^",3),PTRF=$P($G(^(0)),"^",4)
S PSODEA=$P(^PSDRUG(P(5),0),"^",3),CS=0
I $D(CLOZPAT) S MAX=$S(CLOZPAT=2&($P(^PSRX(DA,0),"^",8)=14):1,CLOZPAT=2&($P(^PSRX(DA,0),"^",8)=7):3,CLOZPAT=1&($P(^PSRX(DA,0),"^",8)=7):1,1:0),MIN=0 Q
I PSODEA["A"&(PSODEA'["B")!(PSODEA["F")!(PSODEA[1)!(PSODEA[2) D EN^DDIOL("No refills allowed on "_$S(PSODEA["A":"this narcotic drug.",1:"this drug."),"","!") D EN^DDIOL(" ","","!") S $P(^PSRX(DA,0),"^",9)=0 K X,Y,PSODEA,CS,PTST Q
; Retrieving the Maximum Number of Refills allowed
S MAX=$$MAXNUMRF^PSOUTIL(+$G(P(5)),+$G(P(7)),+$G(P(2)),.CLOZPAT)
I $D(X) S MIN=0 I $D(DA) F REF=0:0 S REF=$O(^PSRX(DA,1,REF)) Q:'REF I $D(^(REF,0)) S MIN=MIN+1
I $G(EXH) D EN^DDIOL("Enter a number Between "_MIN_" AND "_MAX_".","","!?10") K P(2),P(5),P(7),MAX,MAX1,MIN,REF
Q
;
REF S PSRF=X,P(7)=$P(^PSRX(DA,0),"^",8),P(5)=$P(^(0),"^",6),P(2)=+$P(^(0),"^",3) S:P(2) PTST=$G(^PS(53,P(2),0)) S PTDY=$P(^(0),"^",3),PTRF=$P(^(0),"^",4)
D MAX Q:'$D(X) I (+X'=X)!(X<0)!(X>MAX)!(X?.E1"."1N.N) D EN^DDIOL(" ** MAX REFILLS ALLOWED ARE "_MAX_" ** ","","$C(7)") K X
I $D(X),X<MIN D EN^DDIOL(" ** PATIENT HAS ALREADY RECEIVED "_MIN_" REFILLS ** ","","$C(7)") K X
D DAYS^PSOUTLA
K PTDY,PTRF,MAX,DAYS,PSDAYS,PSODEA,PSOX,PSOX1,PSDY,PSDY1,DEA,CS,PTST,PSRF,MIN,REF,P(2),P(7),P(5),MAX1
Q
PAT ;patient field screen in file 52
N DIC,DIE S DFN=X D INP^VADPT,DEM^VADPT
I $P(VADM(6),"^") D EN^DDIOL("PATIENT DIED "_$P(VADM(6),"^",2),"","$C(7),!?10") D EN^DDIOL(" ","","!") K X,DFN Q
I $P(VAIN(4),"^") D EN^DDIOL("PATIENT IS AN INPATIENT ON WARD "_$P(VAIN(4),"^",2)_" !!","","$C(7),!?10") K DIR D DIR K VA,VADN,VAIN Q
E S X=DFN K DFN,DIRUT,DTOUT,DUOUT
Q
DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="DO YOU WISH TO CONTINUE" D ^DIR K DIR
K:'Y X S:Y X=DFN K DFN,DIRUT,DTOUT,DUOUT,VA,VADM,VAIN
Q
BG ;prevents editing of display groups with patients from name to ticket
S $P(^PS(59.3,DA,0),"^",2)=PDP W !,$C(7),"The display cannot be changed from NAME to TICKET when patients are",!,"already in the Display Group. All patients must be purged and re-entered.",!,"Ticket numbers must be issued !!",! K Y,PDP
Q
CLNAP ;quits action profile
Q
PRMI ;prints medication instruction sheets. select drug.
S X="PSNPPIP" X ^%ZOSF("TEST") I '$T S VALMBCK="",VALMSG="Medication Instruction Sheets Not Installed!" Q
I $G(PSODFN) N PSNDFN S PSNDFN=PSODFN
W !! K PSNPPI("MESSAGE") D FULL^VALM1,^PSNPPIP S VALMBCK="R"
I $G(PSNPPI("MESSAGE"))]"" D
.K DIR W PSNPPI("MESSAGE"),! S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DIRUT,DIRUT,PSNPPI("MESSGAE")
Q
PRMID ;prints medication instruction sheets. pass in drug.
N RX0,RXN ;*276
S RXN=$P($G(PSOLST(ORN)),"^",2) Q:RXN="" ;*276
I $T(ENOP^PSNPPIP)']"" S VALMBCK="",VALMSG="Medication Instruction Sheets Not Installed!" Q
K PSNPPI("MESSAGE") D FULL^VALM1
S RX0=$G(^PSRX(RXN,0)) ;*276
W !! D ENOP^PSNPPIP($P(RX0,"^",6),$G(^PSRX(RXN,"TN")),$P(RX0,"^"),PSODFN)
S VALMBCK="R" I $G(PSNPPI("MESSAGE"))]"" D
.K DIR W PSNPPI("MESSAGE"),! S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DIRUT,DIRUT,PSNPPI("MESSGAE")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOHELP 7522 printed Oct 16, 2024@18:30:14 Page 2
PSOHELP ;BHAM ISC/SAB-outpatient utility routine ; 10/17/07 7:41am
+1 ;;7.0;OUTPATIENT PHARMACY;**3,23,29,48,46,117,131,222,268,206,276,282,444,505**;DEC 1997;Build 39
+2 ;External reference ^PS(51 supported by DBIA 2224
+3 ;External reference ^PSDRUG( supported by DBIA 221
+4 ;External reference ^PS(56 supported by DBIA 2229
+5 ;External reference ^PSNPPIP supported by DBIA 2261
+6 ;
XREF DO XREF^PSOHELP3
+1 QUIT
SIG ;checks PI for RXs
+1 KILL VALMSG
+2 IF $EXTRACT(X)=" "
DO EN^DDIOL("Leading spaces should not entered in the Patient Instructions! ","","$C(7),!")
SET VALMSG="There are leading spaces in Patient Instructions!"
SIGONE KILL INS1
if $LENGTH(X)<1
QUIT
FOR Z0=1:1:$LENGTH(X," ")
if Z0=""
GOTO EN
SET Z1=$PIECE(X," ",Z0)
Begin DoDot:1
+1 IF $LENGTH(Z1)>32
WRITE $CHAR(7),!?5,"MAX OF 32 CHARACTERS ALLOWED BETWEEN SPACES.",!
KILL X
QUIT
+2 if $DATA(X)&($GET(Z1)]"")
Begin DoDot:2
+3 ;*282 Provider Comments
SET Z1=$$UPPER^PSOSIG(Z1)
+4 SET Y=$ORDER(^PS(51,"B",Z1,0))
if 'Y!($PIECE($GET(^PS(51,+Y,0)),"^",4)>1)
QUIT
SET Z1=$PIECE(^PS(51,Y,0),"^",2)
+5 IF $GET(^PS(51,+Y,9))]""
SET Y=$PIECE(X," ",Z0-1)
SET Y=$EXTRACT(Y,$LENGTH(Y))
if Y>1
SET Z1=^(9)
End DoDot:2
SET INS1=$GET(INS1)_" "_Z1
End DoDot:1
if '$DATA(X)
GOTO EN
EN KILL Z1,Z0
+1 QUIT
SSIG ;other lang. mods
+1 KILL VALMSG
+2 IF $EXTRACT(X)=" "
DO EN^DDIOL("Leading spaces should not entered in the Patient Instructions! ","","$C(7),!")
SET VALMSG="There are leading spaces in Patient Instructions!"
+3 KILL SINS1
if $LENGTH(X)<1
QUIT
FOR Z0=1:1:$LENGTH(X," ")
if Z0=""
GOTO EX
SET Z1=$PIECE(X," ",Z0)
Begin DoDot:1
+4 IF $LENGTH(Z1)>32
WRITE $CHAR(7),!?5,"MAX OF 32 CHARACTERS ALLOWED BETWEEN SPACES.",!
KILL X
QUIT
+5 if $DATA(X)&($GET(Z1)]"")
Begin DoDot:2
+6 ;*282 Provider Comments
SET Z1=$$UPPER^PSOSIG(Z1)
+7 SET Y=$ORDER(^PS(51,"B",Z1,0))
if 'Y!($PIECE($GET(^PS(51,+Y,0)),"^",4)>1)
QUIT
SET Z1=$PIECE(^PS(51,Y,0),"^",2)
+8 ;,Y=$P(X," ",Z0-1),Y=$E(Y,$L(Y)) S:Y>1 Z1=^(9)
IF $GET(^PS(51,+Y,4))]""
SET Z1=^PS(51,+Y,4)
End DoDot:2
SET SINS1=$GET(SINS1)_" "_Z1
End DoDot:1
if '$DATA(X)
GOTO EX
EX KILL Z1,Z0
+1 QUIT
QTY ;Check quantity dispensed against inventory
+1 if '$GET(PSODRUG("IEN"))
QUIT
+2 SET Z0=$SELECT($GET(PSODRUG("IEN"))]"":PSODRUG("IEN"),$GET(PSXYES):$PIECE(^PSRX(ZRX,0),"^",6),$DATA(^PSRX(DA,0)):+$PIECE(^(0),"^",6),1:0)
+3 ; PSO*7*505 - Removed the following line to prevent the removal of leading zero's 0.5 being 'plused' removes the 0 and
+4 ; evaluates to false, killing X in the event the drug is a cmop drug.
+5 ;I $D(^PSDRUG("AQ",Z0)),(+X'=X) K X,Z0 Q
+6 SET Z1=$SELECT($DATA(^PSDRUG(Z0,660.1)):^(660.1),1:0)+(+X)
if X>Z1
DO EN^DDIOL(" Greater Than Current Inventory!","","$C(7)")
KILL Z1
+7 SET ZX=X
SET ZZ0=$GET(D0)
SET D0=Z0
+8 SET Y(18,2)=$SELECT($DATA(^PSDRUG(D0,660)):^(660),1:"")
SET Y(18,1)=$SELECT($DATA(^(660.1)):^(660.1),1:"")
+9 SET X=$PIECE(Y(18,1),"^",1)
SET X=$SELECT($PIECE(Y(18,2),"^",5):X/$PIECE(Y(18,2),"^",5),1:"*******")
+10 SET X=$JUSTIFY(X,0,2)
+11 if X<$SELECT($DATA(^PSDRUG(Z0,660))
DO EN^DDIOL(" Below Reorder Level.","","$C(7)")
SET X=ZX
SET D0=$GET(ZZ0)
KILL ZZ0,Z0,ZX
+12 QUIT
HELP ;qty help
+1 if $GET(PSOFDR)
GOTO HLP
+2 SET Z0=$SELECT($GET(PSODRUG("IEN"))]"":PSODRUG("IEN"),$GET(PSXYES):$PIECE(^PSRX(ZRX,0),"^",6),$DATA(^PSRX(DA,0)):$PIECE(^PSRX(DA,0),"^",6),1:0)
HLP SET Z0=+$GET(PSODRUG("IEN"))
IF $DATA(^PSDRUG("AQ",Z0))
DO EN^DDIOL("This is a CMOP drug. The quantity may not contain alpha characters (i.e.; ML)","","!!")
DO EN^DDIOL("or more than two fractional decimal places (i.e.; .01).","","!")
Begin DoDot:1
+1 DO EN^DDIOL("Enter a number between 0 and 99999999 inclusive. The total entry cannot","","!")
DO EN^DDIOL("exceed 11 characters.","","!")
End DoDot:1
KILL Z0
QUIT
+2 DO EN^DDIOL("Enter a whole number between 0 and 99999999 inclusive. Alpha characters are","","!!")
+3 DO EN^DDIOL("not allowed, and the entry cannot exceed 11 characters, or contain more than","","!")
DO EN^DDIOL("two fractional decimal places (i.e.; .01).","","!")
+4 KILL Z0
+5 QUIT
ADD ;add/edited local drug/drug interactions
+1 WRITE !
SET DIC("A")="Select Drug Interaction: "
SET DIC(0)="AEMQL"
SET DLAYGO=56
+2 SET (DIC,DIE)="^PS(56,"
SET DIC("S")="I '$P(^(0),""^"",5)"
DO ^DIC
if "^"[X
GOTO QU
if Y<0
GOTO ADD
SET DA=+Y
SET DR="[PSO INTERACT]"
LOCK +^PS(56,DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
IF '$TEST
WRITE !,"Entry is being edited by another user. Try Later!",!
GOTO ADD
+3 DO ^DIE
if $GET(DA)
LOCK -^PS(56,DA)
KILL DA
GOTO ADD
QU LOCK -^PS(56,DA)
KILL X,DIC,DIE,DA
+1 QUIT
CRI ;change drug interaction severity to critical from significant
+1 WRITE !
SET DIC("A")="Select Drug Interaction: "
SET DIC(0)="AEQM"
SET (DIC,DIE)="^PS(56,"
SET DIC("S")="I $P(^(0),""^"",4)=2"
DO ^DIC
if "^"[X
GOTO QU
if Y<0
GOTO CRI
SET DA=+Y
SET DR=3
+2 LOCK +^PS(56,DA):$SELECT(+$GET(^DD("DILOCKTM"))>0:+^DD("DILOCKTM"),1:3)
IF '$TEST
WRITE !,"Entry is being edited by another user. Try Later!",!
GOTO CRI
+3 DO ^DIE
LOCK -^PS(56,DA)
KILL DA
GOTO CRI
+4 GOTO QU
+5 QUIT
MAX if $GET(EXH)
SET P(7)=$PIECE(^PSRX(DA,0),"^",8)
SET P(5)=$PIECE(^(0),"^",6)
SET P(2)=+$PIECE(^(0),"^",3)
if P(2)
SET PTST=$GET(^PS(53,P(2),0))
SET PTDY=$PIECE($GET(^(0)),"^",3)
SET PTRF=$PIECE($GET(^(0)),"^",4)
+1 SET PSODEA=$PIECE(^PSDRUG(P(5),0),"^",3)
SET CS=0
+2 IF $DATA(CLOZPAT)
SET MAX=$SELECT(CLOZPAT=2&($PIECE(^PSRX(DA,0),"^",8)=14):1,CLOZPAT=2&($PIECE(^PSRX(DA,0),"^",8)=7):3,CLOZPAT=1&($PIECE(^PSRX(DA,0),"^",8)=7):1,1:0)
SET MIN=0
QUIT
+3 IF PSODEA["A"&(PSODEA'["B")!(PSODEA["F")!(PSODEA[1)!(PSODEA[2)
DO EN^DDIOL("No refills allowed on "_$SELECT(PSODEA["A":"this narcotic drug.",1:"this drug."),"","!")
DO EN^DDIOL(" ","","!")
SET $PIECE(^PSRX(DA,0),"^",9)=0
KILL X,Y,PSODEA,CS,PTST
QUIT
+4 ; Retrieving the Maximum Number of Refills allowed
+5 SET MAX=$$MAXNUMRF^PSOUTIL(+$GET(P(5)),+$GET(P(7)),+$GET(P(2)),.CLOZPAT)
+6 IF $DATA(X)
SET MIN=0
IF $DATA(DA)
FOR REF=0:0
SET REF=$ORDER(^PSRX(DA,1,REF))
if 'REF
QUIT
IF $DATA(^(REF,0))
SET MIN=MIN+1
+7 IF $GET(EXH)
DO EN^DDIOL("Enter a number Between "_MIN_" AND "_MAX_".","","!?10")
KILL P(2),P(5),P(7),MAX,MAX1,MIN,REF
+8 QUIT
+9 ;
REF SET PSRF=X
SET P(7)=$PIECE(^PSRX(DA,0),"^",8)
SET P(5)=$PIECE(^(0),"^",6)
SET P(2)=+$PIECE(^(0),"^",3)
if P(2)
SET PTST=$GET(^PS(53,P(2),0))
SET PTDY=$PIECE(^(0),"^",3)
SET PTRF=$PIECE(^(0),"^",4)
+1 DO MAX
if '$DATA(X)
QUIT
IF (+X'=X)!(X<0)!(X>MAX)!(X?.E1"."1N.N)
DO EN^DDIOL(" ** MAX REFILLS ALLOWED ARE "_MAX_" ** ","","$C(7)")
KILL X
+2 IF $DATA(X)
IF X<MIN
DO EN^DDIOL(" ** PATIENT HAS ALREADY RECEIVED "_MIN_" REFILLS ** ","","$C(7)")
KILL X
+3 DO DAYS^PSOUTLA
+4 KILL PTDY,PTRF,MAX,DAYS,PSDAYS,PSODEA,PSOX,PSOX1,PSDY,PSDY1,DEA,CS,PTST,PSRF,MIN,REF,P(2),P(7),P(5),MAX1
+5 QUIT
PAT ;patient field screen in file 52
+1 NEW DIC,DIE
SET DFN=X
DO INP^VADPT
DO DEM^VADPT
+2 IF $PIECE(VADM(6),"^")
DO EN^DDIOL("PATIENT DIED "_$PIECE(VADM(6),"^",2),"","$C(7),!?10")
DO EN^DDIOL(" ","","!")
KILL X,DFN
QUIT
+3 IF $PIECE(VAIN(4),"^")
DO EN^DDIOL("PATIENT IS AN INPATIENT ON WARD "_$PIECE(VAIN(4),"^",2)_" !!","","$C(7),!?10")
KILL DIR
DO DIR
KILL VA,VADN,VAIN
QUIT
+4 IF '$TEST
SET X=DFN
KILL DFN,DIRUT,DTOUT,DUOUT
+5 QUIT
DIR SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="DO YOU WISH TO CONTINUE"
DO ^DIR
KILL DIR
+1 if 'Y
KILL X
if Y
SET X=DFN
KILL DFN,DIRUT,DTOUT,DUOUT,VA,VADM,VAIN
+2 QUIT
BG ;prevents editing of display groups with patients from name to ticket
+1 SET $PIECE(^PS(59.3,DA,0),"^",2)=PDP
WRITE !,$CHAR(7),"The display cannot be changed from NAME to TICKET when patients are",!,"already in the Display Group. All patients must be purged and re-entered.",!,"Ticket numbers must be issued !!",!
KILL Y,PDP
+2 QUIT
CLNAP ;quits action profile
+1 QUIT
PRMI ;prints medication instruction sheets. select drug.
+1 SET X="PSNPPIP"
XECUTE ^%ZOSF("TEST")
IF '$TEST
SET VALMBCK=""
SET VALMSG="Medication Instruction Sheets Not Installed!"
QUIT
+2 IF $GET(PSODFN)
NEW PSNDFN
SET PSNDFN=PSODFN
+3 WRITE !!
KILL PSNPPI("MESSAGE")
DO FULL^VALM1
DO ^PSNPPIP
SET VALMBCK="R"
+4 IF $GET(PSNPPI("MESSAGE"))]""
Begin DoDot:1
+5 KILL DIR
WRITE PSNPPI("MESSAGE"),!
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR,DIRUT,DIRUT,PSNPPI("MESSGAE")
End DoDot:1
+6 QUIT
PRMID ;prints medication instruction sheets. pass in drug.
+1 ;*276
NEW RX0,RXN
+2 ;*276
SET RXN=$PIECE($GET(PSOLST(ORN)),"^",2)
if RXN=""
QUIT
+3 IF $TEXT(ENOP^PSNPPIP)']""
SET VALMBCK=""
SET VALMSG="Medication Instruction Sheets Not Installed!"
QUIT
+4 KILL PSNPPI("MESSAGE")
DO FULL^VALM1
+5 ;*276
SET RX0=$GET(^PSRX(RXN,0))
+6 WRITE !!
DO ENOP^PSNPPIP($PIECE(RX0,"^",6),$GET(^PSRX(RXN,"TN")),$PIECE(RX0,"^"),PSODFN)
+7 SET VALMBCK="R"
IF $GET(PSNPPI("MESSAGE"))]""
Begin DoDot:1
+8 KILL DIR
WRITE PSNPPI("MESSAGE"),!
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR,DIRUT,DIRUT,PSNPPI("MESSGAE")
End DoDot:1
+9 QUIT
