| 1 | PSGVBW ;BIR/CML3,MV-VERIFY ORDERS BY WARD, WARD GROUP, OR PATIENT ;22 Oct 98 / 3:14 PM
|
---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**5,16,39,59,62,67,58,81,80,110,111,133,139,155**;16 DEC 97
|
---|
| 3 | ;
|
---|
| 4 | ; Reference to ^PS(55 is supported by DBIA #2191
|
---|
| 5 | ;
|
---|
| 6 | N PSJNEW,PSGPTMP,PPAGE,CL,CG S PSJNEW=1
|
---|
| 7 | START ;
|
---|
| 8 | D ENCV^PSGSETU I $D(XQUIT) K XQUIT Q
|
---|
| 9 | ;I ($P(PSJSYSU,";")=3)!($P(PSJSYSU,";",3)=2)
|
---|
| 10 | D ^PSIVXU I $D(XQUIT) K XQUIT Q
|
---|
| 11 | D NOW^%DTC S PSGDT=%
|
---|
| 12 | I '$D(^XTMP("PSJPVNV")) D
|
---|
| 13 | .K DIR S DIR(0)="Y",DIR("A")="Display an Order Summary",DIR("B")="NO"
|
---|
| 14 | .S DIR("?",1)="Enter 'YES' to see a summary of orders by type and ward group",DIR("?")="or 'NO' to go directly to patient selection."
|
---|
| 15 | .D ^DIR K DIR Q:$D(DIRUT)!$D(DUOUT) I Y D CNTORDRS^PSGVBWU
|
---|
| 16 | K ^TMP("PSJ",$J) S PSGPXN=0 D GTOOP G:$D(DIRUT) DONE L +^PS(53.45,PSJSYSP):1 E D LOCKERR^PSJOE G DONE
|
---|
| 17 | S PSGSSH="VBW",PSGPXN=0,PSJPROT=$S($P(PSJSYSU,";",3)=3:3,$G(PSJRNF):3,$G(PSJIRNF):3,1:1)
|
---|
| 18 | S PSGVBWW=$S(PSJTOO=1:"NON-VERIFIED",PSJTOO=2:"PENDING",1:"NON-VERIFIED AND/OR PENDING")
|
---|
| 19 | F K ^TMP("PSJSELECT",$J) D ^PSGSEL Q:"^"[PSGSS F S (PSGP,WD,WG)=0 S PSGPTMP=0,PPAGE=1 D @PSGSS Q:+Y'>0 D GO
|
---|
| 20 | ;
|
---|
| 21 | DONE ;
|
---|
| 22 | K ^TMP("PSGVBW",$J),^TMP("PSJSELECT",$J),^TMP("PSJLIST",$J),^TMP("PSJON",$J)
|
---|
| 23 | K CHK,D0,DRGI,FQC,J,ND,ON,PN,PSGODT,PSGOEA,PSGOP,PSGSS,PSGSSH,RB,SD,ST,TM,WD,WDN,WG,PRI,PSJPNV,PSJCT,PSGCLF
|
---|
| 24 | K PSGODDD,PSGOEORF,PSJORL,PSJORPCL,PSJORTOU,PSJORVP,PSGTOL,PSJTOO,PSGUOW,PSGONV,PX,PSGOEAV,PSGPX,PSGVBWTO,PSGVBWW,PSJOPC,PSGOENOF,PSJPROT,PSJLM,PSJASK
|
---|
| 25 | L -^PS(53.45,PSJSYSP) G:$G(PSGPXN) ^PSGPER1 D ENKV^PSGSETU K ND Q
|
---|
| 26 | ;
|
---|
| 27 | GO ;
|
---|
| 28 | I PSGSS'="P" W !,"...a few moments, please..." K ^TMP("PSGVBW",$J) D ARRAY K CHK,ON,PN,RB,SD,TM,WD,WDN,WG,X,Y
|
---|
| 29 | I PSGSS'="P",'$D(^TMP("PSGVBW",$J)) W !,$C(7),"NO ",PSGVBWW," ORDERS FOR ",$S(PSGSS="P":"PATIENT",PSGSS="L":"CLINIC GROUP",PSGSS="C":"CLINIC",1:"WARD"),$S(PSGSS="G":" GROUP",1:"")," SELECTED." Q
|
---|
| 30 | D ^PSGVBW0 Q
|
---|
| 31 | ;
|
---|
| 32 | ; look-ups on ward group, ward, or patient; depending on value of SS
|
---|
| 33 | G ;
|
---|
| 34 | K DIR S DIR(0)="FAO",DIR("A")="Select WARD GROUP: "
|
---|
| 35 | S DIR("?")="^D GDIC^PSGVBW" W ! D ^DIR
|
---|
| 36 | I Y="^OTHER" D OUTPT^PSGVBW1 Q
|
---|
| 37 | ;S DIC="^PS(57.5,",DIC(0)="QEAMI",DIC("A")="Select WARD GROUP: "
|
---|
| 38 | GDIC ;
|
---|
| 39 | K DIC S DIC="^PS(57.5,",DIC(0)="QEMI" D ^DIC K DIC S:+Y>0 WG=+Y
|
---|
| 40 | W:X["?" !!,"Enter ""^OTHER"" to include all Outpatient IV orders and orders from the",!,"wards that do not belong to a ward group",!
|
---|
| 41 | Q
|
---|
| 42 | C ;
|
---|
| 43 | K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: "
|
---|
| 44 | S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR
|
---|
| 45 | CDIC ;
|
---|
| 46 | K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 CL=+Y
|
---|
| 47 | W:X["?" !!,"Enter the clinic you want to use to select patients for processing.",!
|
---|
| 48 | Q
|
---|
| 49 | L ;
|
---|
| 50 | K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC GROUP: "
|
---|
| 51 | S DIR("?")="^D LDIC^PSGVBW" W ! D ^DIR
|
---|
| 52 | LDIC ;
|
---|
| 53 | K DIC S DIC="^PS(57.8,",DIC(0)="QEMI" D ^DIC K DIC S:+Y>0 CG=+Y
|
---|
| 54 | W:X["?" !!,"Enter the name of the clinic group you want to use to select patients for processing."
|
---|
| 55 | Q
|
---|
| 56 | W ;
|
---|
| 57 | K DIR S DIR(0)="FAO",DIR("A")="Select WARD: "
|
---|
| 58 | S DIR("?")="^D WDIC^PSGVBW" W ! D ^DIR
|
---|
| 59 | I Y="^OTHER" D OUTPT^PSGVBW1 Q
|
---|
| 60 | WDIC ;
|
---|
| 61 | ;S DIC="^DIC(42,",DIC(0)="QEAMI",DIC("A")="Select WARD: "
|
---|
| 62 | K DIC S DIC="^DIC(42,",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 WD=+Y
|
---|
| 63 | W:X["?" !!,"Enter ""^OTHER"" for Outpatient IV orders",!
|
---|
| 64 | Q
|
---|
| 65 | P ;
|
---|
| 66 | K ^TMP("PSJSELECT",$J) S PSJCNT=1 F D ^PSJP Q:PSGP<0 D
|
---|
| 67 | .S PSJNV=0
|
---|
| 68 | .NEW ON,XX F ON=0:0 S ON=$O(^PS(53.1,"AS","N",PSGP,ON)) Q:'ON S ND=$P($G(^PS(53.1,ON,0)),U,4) S XX=$S(ND="U"&(PSJPAC'=2):1,ND'="U"&(PSJPAC'=1):1,1:0) I XX S PSJNV=1 Q
|
---|
| 69 | .;S PSJNV=$O(^PS(53.1,"AS","N",+PSGP,0)),PSJPEN=$O(^PS(53.1,"AS","P",+PSGP,0))
|
---|
| 70 | .S PSJPEN=$O(^PS(53.1,"AS","P",+PSGP,0))
|
---|
| 71 | .I 'PSJNV D ^PSJAC D
|
---|
| 72 | ..I '$D(PSGDT) D NOW^%DTC S PSGDT=$E(%,1,12)
|
---|
| 73 | ..S X1=$P(PSGDT,"."),X2=-2 D C^%DTC S PSGODT=X_(PSGDT#1)
|
---|
| 74 | ..I PSJPAC'=2 F ST="C","O","OC","P","R" F SD=$S(ST="O":PSJPAD,1:PSGODT):0 S SD=$O(^PS(55,PSGP,5,"AU",ST,SD)) Q:'SD!PSJNV F ON=0:0 S ON=$O(^PS(55,PSGP,5,"AU",ST,SD,ON)) Q:'ON I $D(^PS(55,PSGP,5,ON,0)),$P(^(0),"^",9)'["D" D IFT I S PSJNV=1 Q
|
---|
| 75 | ..I PSJPAC'=1 F SD=+PSJPAD:0 S SD=$O(^PS(55,PSGP,"IV","AIS",SD)) Q:'SD F ON=0:0 S ON=$O(^PS(55,PSGP,"IV","AIS",SD,ON)) Q:'ON I $D(^PS(55,PSGP,"IV",ON,0)),$P(^(0),"^",17)'["D" D IFT2 I S PSJNV=1 Q
|
---|
| 76 | .S X=$S(PSJTOO=1:PSJNV,PSJTOO=2:PSJPEN,1:(PSJNV+PSJPEN))
|
---|
| 77 | .I X D SETPN S ^TMP("PSJSELECT",$J,PSJCNT)=PN,^TMP("PSJSELECT",$J,"B",$P(PN,U),PSJCNT)="",PSJCNT=PSJCNT+1 Q
|
---|
| 78 | .W !,"No ",PSGVBWW," orders found for this patient."
|
---|
| 79 | S:$D(^TMP("PSJSELECT",$J)) Y=1
|
---|
| 80 | Q
|
---|
| 81 | ;
|
---|
| 82 | ARRAY ; put patient(s) with non-verified orders into array
|
---|
| 83 | I '$D(PSGDT) D NOW^%DTC S PSGDT=$E(%,1,12)
|
---|
| 84 | S X1=$P(PSGDT,"."),X2=-2 D C^%DTC S PSGODT=X_(PSGDT#1),PSGVBWW=$S(PSJTOO=1:"NON-VERIFIED",PSJTOO=2:"PENDING",1:"NON-VERIFIED AND/OR PENDING") I PSGSS="P" D IF S:$T ^TMP("PSGVBW",$J)=$P(PSGP(0),"^")_"^"_PSGP Q
|
---|
| 85 | G CG:PSGSS="L",CL:PSGSS="C",WD:PSGSS="W" F WD=0:0 S WD=$O(^PS(57.5,"AC",WG,WD)) Q:'WD D WD
|
---|
| 86 | Q
|
---|
| 87 | ;
|
---|
| 88 | CG S CL="" F S CL=$O(^PS(57.8,"AD",CG,CL)) Q:CL="" D CL
|
---|
| 89 | Q
|
---|
| 90 | CL S WDN=$S($D(^SC(CL,0)):$P(^(0),"^"),1:"")
|
---|
| 91 | S PSGP="",PSGCLF=1 F S PSGP=$O(^PS(53.1,"AD",CL,PSGP)) Q:PSGP="" D ^PSJAC,IF
|
---|
| 92 | K PSGCLF
|
---|
| 93 | Q
|
---|
| 94 | WD S WDN=$S($D(^DIC(42,WD,0)):$P(^(0),"^"),1:"") I WDN]"" F PSGP=0:0 S PSGP=$O(^DPT("CN",WDN,PSGP)) Q:'PSGP I $S($D(^PS(55,"APV",PSGP)):1,$D(^PS(55,"APIV",PSGP)):1,$O(^PS(55,PSGP,5,"AUS",PSGDT)):1,1:$D(^PS(53.1,"AC",PSGP))) D ^PSJAC,IF
|
---|
| 95 | Q
|
---|
| 96 | IF ;BHW;PSJ*5*155;Added PSGCLF and PS(53.1,"AD" Check below. If called from CL subroutine and the order Doesn't exist for that Clinic, then QUIT.
|
---|
| 97 | W "." I PSJTOO'=1 F ON=0:0 S ON=$O(^PS(53.1,"AS","P",PSGP,ON)) Q:'ON!(($G(PSGCLF))&('$D(^PS(53.1,"AD",+$G(CL),PSGP,+$G(ON))))) S X=$P($G(^PS(53.1,ON,0)),U,4),Y=0 I "FIU"[X D G:Y SET
|
---|
| 98 | .I PSJPAC=3 S Y=1 Q
|
---|
| 99 | .I PSJPAC=2 S Y=X'="U" Q
|
---|
| 100 | .I PSJPAC=1 S Y=X="U"
|
---|
| 101 | Q:PSJTOO=2
|
---|
| 102 | F X="N","I" I $D(^PS(53.1,"AS",X,PSGP)) NEW XX S XX=0 D G:XX SET
|
---|
| 103 | . NEW ON F ON=0:0 S ON=$O(^PS(53.1,"AS",X,PSGP,ON)) Q:'ON S ND=$P($G(^PS(53.1,ON,0)),U,4) S XX=$S(ND="U"&(PSJPAC'=2):1,ND'="U"&(PSJPAC'=1):1,1:0) Q:XX
|
---|
| 104 | S X1=$P(PSGDT,"."),X2=-2 D C^%DTC S PSGODT=X_(PSGDT#1)
|
---|
| 105 | I PSJPAC'=2 F ST="C","O","OC","P","R" F SD=$S(ST="O":PSJPAD,1:PSGODT):0 S SD=$O(^PS(55,PSGP,5,"AU",ST,SD)) Q:'SD F ON=0:0 S ON=$O(^PS(55,PSGP,5,"AU",ST,SD,ON)) Q:'ON I $D(^PS(55,PSGP,5,ON,0)),$P(^(0),"^",9)'["D" D IFT I G SET
|
---|
| 106 | I PSJPAC'=1 F SD=+PSJPAD:0 S SD=$O(^PS(55,PSGP,"IV","AIS",SD)) Q:'SD F ON=0:0 S ON=$O(^PS(55,PSGP,"IV","AIS",SD,ON)) Q:'ON I $D(^PS(55,PSGP,"IV",ON,0)),$P(^(0),"^",17)'["D" D IFT2 I G SET
|
---|
| 107 | Q
|
---|
| 108 | ;
|
---|
| 109 | IFT ;
|
---|
| 110 | S ND=$G(^PS(55,PSGP,5,ON,4)) I $S(SD>PSGDT:$S(ND="":1,'$P(ND,"^",$S(PSJSYSU:PSJSYSU,1:1)):1,$P(ND,"^",13):1,$P(ND,"^",19):1,$P(ND,"^",23):1,1:$P(ND,"^",16)),ST="O":$S(ND="":1,1:'$P(ND,"^",$S(PSJSYSU:PSJSYSU,1:1))),1:$P(ND,"^",16))
|
---|
| 111 | Q
|
---|
| 112 | ;
|
---|
| 113 | IFT2 ;
|
---|
| 114 | ;S ND=$G(^PS(55,PSGP,"IV",ON,4)) I $S((SD>PSGDT)&(ND=""):1,'$P(ND,"^",$S(+PSJSYSU=1:1,1:4)):1,1:0)
|
---|
| 115 | S ND=$G(^PS(55,PSGP,"IV",ON,4))
|
---|
| 116 | I ($P($G(^PS(55,PSGP,"IV",ON,.2)),"^",4)="D")&('$P(ND,"^",$S(+PSJSYSU=1:1,1:4))) Q
|
---|
| 117 | I $S((SD>PSGDT)&('$P(ND,"^",$S(+PSJSYSU=1:1,1:4))):1,1:0)
|
---|
| 118 | Q
|
---|
| 119 | SET ;
|
---|
| 120 | S TM=$S(PSJPRB="":"",1:$P($G(^PS(57.7,WD,1,+$O(^PS(57.7,"AWRT",WD,PSJPRB,0)),0)),"^")) S:TM="" TM="zz"
|
---|
| 121 | ;
|
---|
| 122 | SETPN ;
|
---|
| 123 | S PN=$P(PSGP(0),"^")_U_PSGP_U_PSJPBID S:PSGSS'="P" ^TMP("PSGVBW",$J,WDN,TM,PN)=""
|
---|
| 124 | Q
|
---|
| 125 | ;
|
---|
| 126 | GTOOP ; Get 'Type Of Order' and Package
|
---|
| 127 | I $P(PSJSYSU,";",3)<2,'$G(PSJRNF),'$G(PSJIRNF) S PSJPAC=0,PSJTOO=1 D GTPAC Q
|
---|
| 128 | S (PSJPAC,PSJTOO)=0 W !!,"1) Non-Verified Orders",!,"2) Pending Orders",!!
|
---|
| 129 | N DIR S DIR(0)="LAO^1:2",DIR("A")="Select Order Type(s) (1-2): ",DIR("?")="^D TOH^PSGVBW" D ^DIR
|
---|
| 130 | I 'Y D EXIT("TYPE OF ORDER") Q
|
---|
| 131 | S PSJTOO=$S($L(Y)>2:3,1:$P(Y,","))
|
---|
| 132 | D GTPAC
|
---|
| 133 | I 'PSJPAC D EXIT("PACKAGE") Q
|
---|
| 134 | Q
|
---|
| 135 | GTPAC ;
|
---|
| 136 | ;S PSJTOO=$S($L(Y)>2:3,1:$P(Y,",")) Q:PSJTOO=1
|
---|
| 137 | ;I $G(PSJRNF) S PSJPAC=1 Q
|
---|
| 138 | I ($G(PSJRNF))&('$G(PSJIRNF))&(PSJTOO=2) S PSJPAC=1 Q
|
---|
| 139 | I ($G(PSJIRNF))&('$G(PSJRNF))&(PSJTOO=2) S PSJPAC=2 Q
|
---|
| 140 | W !!,"1) Unit Dose Orders",!,"2) IV Orders",!
|
---|
| 141 | K DIR S DIR(0)="LAO^1:2",DIR("A")="Select Package(s) (1-2): ",DIR("?")="^D TOH^PSGVBW" W ! D ^DIR
|
---|
| 142 | S PSJPAC=$S($L(Y)>2:3,1:$P(Y,","))
|
---|
| 143 | Q
|
---|
| 144 | EXIT(X) ;
|
---|
| 145 | W !!,X," not selected, option terminated."
|
---|
| 146 | Q
|
---|
| 147 | ;
|
---|
| 148 | TOH ;
|
---|
| 149 | W !!,"SELECT FROM:",!?5,"1 - NON-VERIFIED ORDERS",!?5,"2 - PENDING ORDERS"
|
---|
| 150 | W !!?2,"Enter '1' if you want to verify non-verified orders. Enter '2' if you",!,"want to complete pending orders. Enter '1,2' or '1-2' if you want to do both." Q
|
---|