- 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 Jan 18, 2025@03:30:44 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