- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOHELP.m
r613 r623 1 PSOHELP ;BHAM ISC/SAB-outpatient utility routine ; 10/17/07 7:41am2 ;;7.0;OUTPATIENT PHARMACY;**3,23,29,48,46,117,131,222,268,206**;DEC 1997;Build 393 4 5 6 7 8 XREF 9 10 SIG 11 12 13 SIGONE 14 15 16 17 18 EN 19 20 SSIG 21 22 23 24 25 26 27 28 EX 29 30 QTY 31 32 33 34 35 36 37 38 39 40 41 HELP 42 43 44 HLP 45 46 47 48 49 50 ADD 51 52 53 54 QU 55 56 CRI 57 58 59 60 61 62 MAX 63 64 65 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 Q66 67 68 69 70 71 72 73 74 75 76 77 78 REF 79 80 81 82 83 84 PAT 85 86 87 88 89 90 DIR 91 92 93 BG 94 95 96 CLNAP 97 98 PRMI 99 100 101 102 103 104 105 PRMID 106 107 108 109 110 111 1 PSOHELP ;BHAM ISC/SAB-outpatient utility routine ; 2/17/93 18:00:36 2 ;;7.0;OUTPATIENT PHARMACY;**3,23,29,48,46,117,131,222,268**;DEC 1997;Build 9 3 ;External reference ^PS(51 supported by DBIA 2224 4 ;External reference ^PSDRUG( supported by DBIA 221 5 ;External reference ^PS(56 supported by DBIA 2229 6 ;External reference ^PSNPPIP supported by DBIA 2261 7 ; 8 XREF D XREF^PSOHELP3 9 Q 10 SIG ;checks PI for RXs 11 K VALMSG 12 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!" 13 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 14 .I $L(Z1)>32 W $C(7),!?5,"MAX OF 32 CHARACTERS ALLOWED BETWEEN SPACES.",! K X Q 15 .D:$D(X)&($G(Z1)]"") S INS1=$G(INS1)_" "_Z1 16 ..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) 17 ..I $G(^PS(51,+Y,9))]"" S Y=$P(X," ",Z0-1),Y=$E(Y,$L(Y)) S:Y>1 Z1=^(9) 18 EN K Z1,Z0 19 Q 20 SSIG ;other lang. mods 21 K VALMSG 22 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!" 23 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 24 .I $L(Z1)>32 W $C(7),!?5,"MAX OF 32 CHARACTERS ALLOWED BETWEEN SPACES.",! K X Q 25 .D:$D(X)&($G(Z1)]"") S SINS1=$G(SINS1)_" "_Z1 26 ..S Y=$O(^PS(51,"B",Z1,0)) Q:'Y S Z1=$P(^PS(51,Y,0),"^",2) 27 ..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) 28 EX K Z1,Z0 29 Q 30 QTY ;Check quantity dispensed against inventory 31 Q:'$G(PSODRUG("IEN")) 32 S Z0=$S($G(PSODRUG("IEN"))]"":PSODRUG("IEN"),$G(PSXYES):$P(^PSRX(ZRX,0),"^",6),$D(^PSRX(DA,0)):+$P(^(0),"^",6),1:0) 33 I $D(^PSDRUG("AQ",Z0)),(+X'=X) K X,Z0 Q 34 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 35 S ZX=X,ZZ0=$G(D0),D0=Z0 36 S Y(18,2)=$S($D(^PSDRUG(D0,660)):^(660),1:""),Y(18,1)=$S($D(^(660.1)):^(660.1),1:"") 37 S X=$P(Y(18,1),"^",1),X=$S($P(Y(18,2),"^",5):X/$P(Y(18,2),"^",5),1:"*******") 38 S X=$J(X,0,2) 39 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 40 Q 41 HELP ;qty help 42 G:$G(PSOFDR) HLP 43 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) 44 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 45 .D EN^DDIOL("Enter a number between 0 and 99999999 inclusive. The total entry cannot","","!") D EN^DDIOL("exceed 11 characters.","","!") 46 D EN^DDIOL("Enter a whole number between 0 and 99999999 inclusive. Alpha characters are","","!!") 47 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).","","!") 48 K Z0 49 Q 50 ADD ;add/edited local drug/drug interactions 51 W ! S DIC("A")="Select Drug Interaction: ",DIC(0)="AEMQL",DLAYGO=56 52 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 53 D ^DIE L:$G(DA) -^PS(56,DA) K DA G ADD 54 QU L -^PS(56,DA) K X,DIC,DIE,DA 55 Q 56 CRI ;change drug interaction severity to critical from significant 57 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 58 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 59 D ^DIE L -^PS(56,DA) K DA G CRI 60 G QU 61 Q 62 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) 63 S PSODEA=$P(^PSDRUG(P(5),0),"^",3),CS=0 64 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 65 I PSODEA["A"&(PSODEA'["B")!(PSODEA["F") D EN^DDIOL("No refills allowed on "_$S(PSODEA["F":"this drug.",1:"Narcotics .."),"","!") D EN^DDIOL(" ","","!") S $P(^PSRX(DA,0),"^",9)=0 K X,Y,PSODEA,CS,PTST Q 66 F DEA=1:1 Q:$E(PSODEA,DEA)="" I $E(+PSODEA,DEA)>1,$E(+PSODEA,DEA)<6 S CS=1 67 S PSOELSE=CS I PSOELSE D 68 .S PSOX1=$S(PTRF>5:5,1:PTRF),PSOT=$S(PSOX1=5:5,1:PSOX1) 69 .S PSOT=$S('PSOT:0,P(7)=90:1,1:PSOT),PSDY1=$S(P(7)<60:5,P(7)'<60&(P(7)'>89):2,P(7)=90:1,1:0) S MAX=$S(PSOT'>PSDY1:PSOT,1:PSDY1) 70 I 'PSOELSE D 71 .S PSOX1=PTRF,PSOT=$S(PSOX1=11:11,1:PSOX1),PSOT=$S('PSOT:0,P(7)=90:3,1:PSOT) 72 .S PSDY1=$S(P(7)<60:11,P(7)'<60&(P(7)'>89):5,P(7)=90:3,1:0) S MAX=$S(PSOT'>PSDY1:PSOT,1:PSDY1) 73 K PSODEA,PSOELSE,PSOT,PSOX1,PSDY,PSDY1,DEA,CS 74 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 75 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 76 Q 77 ; 78 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) 79 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 80 I $D(X),X<MIN D EN^DDIOL(" ** PATIENT HAS ALREADY RECEIVED "_MIN_" REFILLS ** ","","$C(7)") K X 81 D DAYS^PSOUTLA 82 K PTDY,PTRF,MAX,DAYS,PSDAYS,PSODEA,PSOX,PSOX1,PSDY,PSDY1,DEA,CS,PTST,PSRF,MIN,REF,P(2),P(7),P(5),MAX1 83 Q 84 PAT ;patient field screen in file 52 85 N DIC,DIE S DFN=X D INP^VADPT,DEM^VADPT 86 I $P(VADM(6),"^") D EN^DDIOL("PATIENT DIED "_$P(VADM(6),"^",2),"","$C(7),!?10") D EN^DDIOL(" ","","!") K X,DFN Q 87 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 88 E S X=DFN K DFN,DIRUT,DTOUT,DUOUT 89 Q 90 DIR S DIR(0)="Y",DIR("B")="YES",DIR("A")="DO YOU WISH TO CONTINUE" D ^DIR K DIR 91 K:'Y X S:Y X=DFN K DFN,DIRUT,DTOUT,DUOUT,VA,VADM,VAIN 92 Q 93 BG ;prevents editing of display groups with patients from name to ticket 94 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 95 Q 96 CLNAP ;quits action profile 97 Q 98 PRMI ;prints medication instruction sheets. select drug. 99 S X="PSNPPIP" X ^%ZOSF("TEST") I '$T S VALMBCK="",VALMSG="Medication Instruction Sheets Not Installed!" Q 100 I $G(PSODFN) N PSNDFN S PSNDFN=PSODFN 101 W !! K PSNPPI("MESSAGE") D FULL^VALM1,^PSNPPIP S VALMBCK="R" 102 I $G(PSNPPI("MESSAGE"))]"" D 103 .K DIR W PSNPPI("MESSAGE"),! S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DIRUT,DIRUT,PSNPPI("MESSGAE") 104 Q 105 PRMID ;prints medication instruction sheets. pass in drug. 106 I $T(ENOP^PSNPPIP)']"" S VALMBCK="",VALMSG="Medication Instruction Sheets Not Installed!" Q 107 K PSNPPI("MESSAGE") D FULL^VALM1 108 W !! D ENOP^PSNPPIP($P(RX0,"^",6),$G(^PSRX(RXN,"TN")),$P(RX0,"^"),PSODFN) 109 S VALMBCK="R" I $G(PSNPPI("MESSAGE"))]"" D 110 .K DIR W PSNPPI("MESSAGE"),! S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR,DIRUT,DIRUT,PSNPPI("MESSGAE") 111 Q
Note:
See TracChangeset
for help on using the changeset viewer.
