- 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/PSOVER1.m
r613 r623 1 PSOVER1 2 ;;7.0;OUTPATIENT PHARMACY;**32,46,90,131,202,207,148,243,268,281**;DEC 1997;Build 41 3 4 5 6 7 8 9 REDO 10 11 12 13 14 15 16 17 18 19 20 21 ALLR 22 23 24 25 26 27 28 29 30 31 EDIT 32 33 34 35 36 37 CHANGE 38 39 40 41 42 43 44 PROF 45 46 47 EXPIRE 48 49 VERIFY 50 51 52 53 VERY 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 . . S ACTION=$$HDLG^PSOREJU1(PSONV,0,"79,88","OF","IOQ","Q")81 82 KILL 83 OUT 84 DELETE 85 QUIT 86 UPSUS 87 88 CLEAN 89 90 91 92 93 94 KV1 95 96 KV 97 98 NVA 99 100 101 102 103 104 105 REMOTE 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 NOALRGY 121 122 123 124 125 126 127 128 1 PSOVER1 ;BHAM ISC/SAB - verify one rx ;3/9/05 12:53pm 2 ;;7.0;OUTPATIENT PHARMACY;**32,46,90,131,202,207,148,243,268**;DEC 1997;Build 9 3 ;External reference ^PSDRUG( supported by DBIA 221 4 ;External reference to PSOUL^PSSLOCK supported by DBIA 2789 5 ;External reference ^PS(55 supported by DBIA 2228 6 ;External reference to PSSORPH is supported by DBIA 3234 7 ;External references to ^ORRDI1 supported by DBIA 4659 8 ;External reference ^XTMP("ORRDI" supported by DBIA 4660 9 REDO ; 10 S (DRG,PSODRUG("NAME"))=$P(^PSDRUG(+$P(^PSRX(PSONV,0),"^",6),0),"^"),PSODRUG("VA CLASS")=$P(^(0),"^",2) 11 I '$D(PSODFN) S PSODFN=$P(^PSRX(PSONV,0),"^",2) 12 S (STA,DNM)="",PSDPSTOP=0,$P(PSONULN,"-",79)="-" F S STA=$O(PSOSD(STA)) Q:STA="" F S DNM=$O(PSOSD(STA,DNM)) Q:DNM="" K PSZZZDUP I $P(PSOSD(STA,DNM),"^",2)<10 D 13 .I STA="ZNONVA" D NVA Q 14 .I PSODRUG("NAME")=$P(DNM,"^")&(PSONV'=$P(PSOSD(STA,DNM),"^")) S PSZZZDUP=1 K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" W ! D ^DIR K DIR S PSDTSTOP=1 15 .I PSODRUG("VA CLASS")]"",$E(PSODRUG("VA CLASS"),1,4)=$E($P(PSOSD(STA,DNM),"^",5),1,4),PSODRUG("NAME")'=$P(DNM,"^") K DIR S DIR(0)="E",DIR("A")="Press RETURN to continue" W ! D ^DIR K DIR D CLS^PSODRDUP S PSDTSTOP=1 16 .I $G(PSZZZDUP),$G(PSVFLAG),$P($G(^PSRX($P(PSOSD(STA,DNM),"^"),"STA")),"^")=12,$D(^PS(52.4,$P(PSOSD(STA,DNM),"^"),0)) S DA=$P(PSOSD(STA,DNM),"^"),DIK="^PS(52.4," D ^DIK K DIK 17 .I $G(PSZZZDUP),$G(PSVFLAG),$P($G(^PSRX($P(PSOSD(STA,DNM),"^"),"STA")),"^")'=12 S PSZZQUIT=1 18 K MSG I $G(PSZZQUIT),$G(PSVFLAG) K PSZZQUIT,PSODRUG,PSODFN,PSZZZDUP,DNM,PSDTSTOP D CLEAN Q 19 D REMOTE 20 K PSODRUG,PSODFN,PSZZZDUP,DNM,PSZZQUIT 21 ALLR ;Allergy check 22 S PSONOAL="" D ALLERGY^PSOORUT2 D:PSONOAL'="" NOALRGY K PSONOAL I $G(PSZZQUIT) K MSG,PSZZQUIT,PSODRUG,PSODFN,PSZZZDUP,DNM,PSDTSTOP D CLEAN Q 23 G:'$P($G(^PSRX(PSONV,3)),"^",6) EDIT 24 I '$G(PSDTSTOP) K DIR S DIR(0)="E" D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) K PSDTSTOP G OUT 25 W !!,"A Drug-Allergy Reaction exists for this medication!",!!,"***SIGNIFICANT*** Allergy Reaction" 26 W !,"Drug: ",$P($G(^PSDRUG(+$P($G(^PSRX(PSONV,0)),"^",6),0)),"^") 27 I $O(^PSRX(PSONV,"DAI",0)) W !?6,"Ingredients: " D 28 .F PSPPP=0:0 S PSPPP=$O(^PSRX(PSONV,"DAI",PSPPP)) Q:'PSPPP I $G(^(PSPPP,0))'="" W:$X+$L($G(^PSRX(PSONV,"DAI",PSPPP,0)))+2>IOM !?19 W $G(^PSRX(PSONV,"DAI",PSPPP,0))_", " 29 W ! K DIR,PSPPP S DIR(0)="Y",DIR("B")="Y",DIR("A")="Do you want to intervene?" D ^DIR K DIR I X["^"!($D(DTOUT))!($D(DUOUT)) K PSDTSTOP G OUT 30 I Y S PSORX("INTERVENE")=0 D EN1^PSORXI(PSONV) 31 EDIT I $G(PKI1)=2 D DCV1^PSOPKIV1 G OUT 32 K PSDTSTOP S DIR("A")="EDIT",DIR("B")="N",DIR(0)="SB^Y:YES;N:NO;P:PROFILE",DIR("?")="Enter Y to change this RX, P to see a profile, or N to procede with verification" 33 D ^DIR K DIR I Y="Y",$G(PSOACT)]"" S VALMBCK="R" G OUT 34 I $D(DIRUT),$G(PSOCLK) S PSOCQ=1 G OUT 35 I $D(DIRUT),$G(PSOACT)]"" S VALMBCK="R" G OUT 36 G VERIFY:Y="N",PROF:Y="P",OUT:"YNP"'[$E(Y) 37 CHANGE S DA=PSONV,(PSRX1,PSRX2)=$P(^PSRX(PSONV,0),"^",6) 38 S DEA1=1,DEA2=0,PSDOLD=+DA,DIE="^PSRX(",DR="3;7;8;9;4;5;12;1;22;11;"_$S($P(PSOPAR,"^",12):"35;",1:"")_$S($P(PSOPAR,"^",15):"10.6",1:"")_";@2" D ^DIE 39 ;I PSRX1'=PSRX2,DEA1'=DEA2 S DR="6////"_PSRX1 D ^DIE 40 D EXPIRE K DIE,DR,DEA1,DEA2,P(5),PSRX1,PSRX2 41 K PSD(PSDOLD) S PSDNEW=$P(^PSDRUG($P(^PSRX(PSONV,0),"^",6),0),"^")_"^"_PSONV,PSD(PSDNEW)=PSONV_"^*^1^"_$P(^PSDRUG($P(^PSRX(PSONV,0),"^",6),0),"^",2) 42 S DA=PSONV D ^PSORXPR 43 G EDIT:PSDNEW=PSDOLD,REDO 44 PROF I '$D(PSOSD) W !,$C(7),"This patient has no other prescriptions on file",!! G EDIT Q 45 D ^PSODSPL G EDIT Q 46 ; 47 EXPIRE S RX0=^PSRX(DA,0),X1=$P($P(RX0,"^",13),"."),X2=$P(RX0,"^",9)+1*$P(RX0,"^",8),X2=$S($P(RX0,"^",8)=X2:X2,X2<181:184,X2=360:366,1:X2),X=X1 D:X1&X2 C^%DTC 48 K ^PS(55,PSDFN,"P","A",+$P(^PSRX(DA,2),"^",6),DA) S ^PS(55,PSDFN,"P","A",X,DA)="",$P(^PSRX(DA,2),"^",6)=X,$P(^PS(52.4,DA,0),"^",7)=X Q 49 VERIFY G:'$P(PSOPAR,"^",2) VERY 50 S DIR("A")="VERIFY FOR "_PSONAM_" ? (Y/N/Delete/Quit): ",DIR("B")="Y",DIR(0)="SA^Y:YES;N:NO;D:DELETE;Q:QUIT" 51 S DIR("?",1)="Enter Y (or return) to verify this prescription",DIR("?",2)="N to leave this prescription non-verified and to end this session of verification",DIR("?")="D to delete this prescription" 52 D ^DIR K DIR G OUT:Y="N",QUIT:"Q^"[$E(Y),DELETE:Y="D" 53 VERY I $G(PKI1)=1 D REA^PSOPKIV1 G:'$D(PKIR) VERIFY 54 K ^PSRX(PSONV,"DAI") S $P(^PSRX(PSONV,3),"^",6)="" 55 K ^PSRX(PSONV,"DRI"),SPFL 56 I '$O(^PSRX(PSONV,6,0)) D I $D(DUOUT)!($D(DTOUT)) W !!,"Rx: "_$P(^PSRX(DA,0),"^")_" not Verified!!",! H 2 G OUT 57 .W !!,"Dosing Instructions Missing. Please add!",! 58 .I $P($G(^PSRX(PSONV,"SIG")),"^")]"",'$P($G(^("SIG")),"^",2) W "SIG: "_$P(^PSRX(PSONV,"SIG"),"^"),! 59 .I $P($G(^PSRX(PSONV,"SIG")),"^",2),$O(^PSRX(PSONV,"SIG1",0)) D K I 60 ..W "SIG: " F I=0:0 S I=$O(^PSRX(PSONV,"SIG1",I)) Q:'I W ^PSRX(PSONV,"SIG1",I,0),! 61 .S DA=PSONV,PSOVER=1 K DIR,DIRUT,DUOUT,DTOUT 62 .S PSODRUG("IEN")=$P(^PSRX(DA,0),"^",6),PSODFN=$P(^(0),"^",2),PSORXED("IRXN")=DA,PSODRUG("OI")=$P(^PSRX(DA,"OR1"),"^") 63 .D DOSE^PSSORPH(.DOSE,PSODRUG("IEN"),"O",PSODFN),^PSOORED3 64 .K PSODFN,PSODRUG("IEN"),DOSE,PSOVER 65 .I '$G(ENT) S DUOUT=1 66 .Q:$D(DUOUT)!($D(DTOUT)) 67 .K DIR,DIRUT,DUOUT,DTOUT S DIE=52,DR=114 D ^DIE K DIE,DR,DTOUT 68 .I X'="" D SIG^PSOHELP D:$G(INS1)]"" EN^DDIOL($E(INS1,2,9999999)) S PSORXED("SIG",1)=$E(INS1,2,9999999) 69 .D EN^PSOFSIG(.PSORXED,1),UDSIG^PSOORED3 H 2 70 S DA=PSONV,$P(^PSRX(DA,2),"^",10)=DUZ I $P(^PSRX(DA,2),"^",2)>DT,$P(PSOPAR,"^",6) S (SPFL1,PSOVER)="",PSORX("FILL DATE")=$P(^(2),"^",2),RXF=0 D UPSUS S PSTRIVER=1 D SUS^PSORXL K PSORX("FILL DATE"),PSTRIVER G KILL 71 S PSOVER(PSONV)="" S $P(^PSRX(PSONV,"STA"),"^")=0,$P(PSOSD("NON-VERIFIED",DRG),"^",2)=0,PSOSD("ACTIVE",DRG)=PSOSD("NON-VERIFIED",DRG) 72 I $G(PKI1)=1,$G(PKIR)]"" D ACT^PSOPKIV1(DA) 73 K PSOSD("NON-VERIFIED",DRG) D EN^PSOHLSN1(PSONV,"SC","CM","") 74 ; 75 ; - Calling ECME for claims generation and transmission / REJECT handling 76 N ACTION 77 I $$SUBMIT^PSOBPSUT(PSONV) D I ACTION="Q"!(ACTION="^") Q 78 . S ACTION="" D ECMESND^PSOBPSU1(PSONV,,,$S($O(^PSRX(PSONV,1,0)):"RF",1:"OF")) 79 . I $$FIND^PSOREJUT(PSONV) D 80 . . S ACTION=$$HDLG^PSOREJU1(PSONV,0,"79,88","OF","IOQ","I") 81 ; 82 KILL S DA=PSONV,DIK="^PS(52.4," D ^DIK K DA,DIK D DCORD^PSONEW2 83 OUT K DIRUT,DTOUT,DUOUT,UPFLAGX D CLEAN Q 84 DELETE K UPFLAGX D DELETE^PSOVER2 G:$G(UPFLAGX) OUT K PSOSD("NON-VERIFIED",$G(DRG)) Q 85 QUIT S PSOQUIT="" D CLEAN Q 86 UPSUS S $P(PSOSD("NON-VERIFIED",DRG),"^",2)=5,PSOSD("ACTIVE",DRG)=PSOSD("NON-VERIFIED",DRG) K PSOSD("NON-VERIFIED",DRG) D EN^PSOHLSN1(PSONV,"SC","CM","") 87 Q 88 CLEAN ;cleans up tmp("psorxdc") global 89 I $O(^TMP("PSORXDC",$J,0)) F RORD=0:0 S RORD=$O(^TMP("PSORXDC",$J,RORD)) Q:'RORD D 90 .D PSOUL^PSSLOCK(RORD_$S($P(^TMP("PSORXDC",$J,RORD,0),"^")="P":"S",1:"")) 91 .W !,$S($P(^TMP("PSORXDC",$J,RORD,0),"^")=52:"Prescription",1:"Pending Order")_" #"_$S($P(^TMP("PSORXDC",$J,RORD,0),"^")=52:$P(^PSRX(RORD,0),"^"),1:RORD)_" NOT Discontinued." 92 K ^TMP("PSORXDC",$J),RORD 93 Q 94 KV1 ; 95 K PSOANSQD,DRET,LST,PSOQUIT,PSODRUG,PSONEW,SIG,PSODIR,PHI,PRC,ORCHK,ORDRG,PSOSIGFL,PSORX("ISSUE DATE"),PSORX("FILL DATE"),CLOZPAT 96 KV K DIR,DIRUT,DTOUT,DUOUT 97 Q 98 NVA ; 99 I $P(PSOSD(STA,DNM),"^",11) D NVA^PSODRDU1 Q 100 N PSOOI,CLASS,FLG,X,Y,RXREC,IFN 101 S (Y,FLG)="" 102 S RXREC=$P(PSOSD(STA,DNM),"^",10),PSOOI=+$G(^PS(55,DFN,"NVA",RXREC,0)),IFN=RXREC N DNM 103 F S Y=$O(^PSDRUG("ASP",PSOOI,Y)) Q:Y=""!(FLG) S DNM=$P(^PSDRUG(Y,0),"^"),CLASS=$P(^PSDRUG(Y,0),"^",2) I PSODRUG("NAME")=DNM!(CLASS=PSODRUG("VA CLASS")) D DSP^PSODRDU1 S FLG=1 Q 104 Q 105 REMOTE ; 106 K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),^TMP($J,"DI"_PSODFN) D 107 .I $T(HAVEHDR^ORRDI1)']"" Q 108 .I '$$HAVEHDR^ORRDI1 Q 109 .I $D(^XTMP("ORRDI","OUTAGE INFO","DOWN")) D Q 110 ..I $T(REMOTE^PSORX1)]"" Q 111 ..W !,"Remote data not available - Only local order checks processed." D PAUSE^PSOORRD2 112 .W !,"Now doing remote order checks. Please wait..." 113 .D REMOTE^PSOORRDI(PSODFN,+$P($G(^PSRX(PSONV,0)),"^",6)) 114 .I $P($G(^XTMP("ORRDI","PSOO",PSODFN,0)),"^",3)<0 W !,"Remote data not available - Only local order checks processed." D PAUSE^PSOORRD2 Q 115 .I $D(^TMP($J,"DD")) D DUP^PSOORRD2 116 .I $D(^TMP($J,"DC")) D CLS^PSOORRD2 117 .I $D(^TMP($J,"DI"_PSODFN)) K ^TMP($J,"DI") M ^TMP($J,"DI")=^TMP($J,"DI"_PSODFN) D DRGINT^PSOORRD2 118 K ^TMP($J,"DD"),^TMP($J,"DC"),^TMP($J,"DI"),^TMP($J,"DI"_PSODFN) 119 Q 120 NOALRGY ; 121 W $C(7),!,"There is no allergy assessment on file for this patient." 122 W !,"You will be prompted to intervene if you continue with this prescription" 123 K DIR 124 S DIR(0)="SA^1:YES;0:NO",DIR("A")="Do you want to Continue?: ",DIR("B")="N" D ^DIR 125 I 'Y S PSZZQUIT=1 Q 126 S PSORX("INTERVENE")=0 127 D EN1^PSORXI(PSONV) 128 Q
Note:
See TracChangeset
for help on using the changeset viewer.
