PSGVBW ;BIR/CML3,MV-VERIFY ORDERS BY WARD, WARD GROUP, OR PATIENT ;22 Oct 98 / 3:14 PM
;;5.0; INPATIENT MEDICATIONS ;**5,16,39,59,62,67,58,81,80,110,111,133,139,155**;16 DEC 97
;
; Reference to ^PS(55 is supported by DBIA #2191
;
N PSJNEW,PSGPTMP,PPAGE,CL,CG S PSJNEW=1
START ;
D ENCV^PSGSETU I $D(XQUIT) K XQUIT Q
;I ($P(PSJSYSU,";")=3)!($P(PSJSYSU,";",3)=2)
D ^PSIVXU I $D(XQUIT) K XQUIT Q
D NOW^%DTC S PSGDT=%
I '$D(^XTMP("PSJPVNV")) D
.K DIR S DIR(0)="Y",DIR("A")="Display an Order Summary",DIR("B")="NO"
.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."
.D ^DIR K DIR Q:$D(DIRUT)!$D(DUOUT) I Y D CNTORDRS^PSGVBWU
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
S PSGSSH="VBW",PSGPXN=0,PSJPROT=$S($P(PSJSYSU,";",3)=3:3,$G(PSJRNF):3,$G(PSJIRNF):3,1:1)
S PSGVBWW=$S(PSJTOO=1:"NON-VERIFIED",PSJTOO=2:"PENDING",1:"NON-VERIFIED AND/OR PENDING")
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
;
DONE ;
K ^TMP("PSGVBW",$J),^TMP("PSJSELECT",$J),^TMP("PSJLIST",$J),^TMP("PSJON",$J)
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
K PSGODDD,PSGOEORF,PSJORL,PSJORPCL,PSJORTOU,PSJORVP,PSGTOL,PSJTOO,PSGUOW,PSGONV,PX,PSGOEAV,PSGPX,PSGVBWTO,PSGVBWW,PSJOPC,PSGOENOF,PSJPROT,PSJLM,PSJASK
L -^PS(53.45,PSJSYSP) G:$G(PSGPXN) ^PSGPER1 D ENKV^PSGSETU K ND Q
;
GO ;
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
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
D ^PSGVBW0 Q
;
; look-ups on ward group, ward, or patient; depending on value of SS
G ;
K DIR S DIR(0)="FAO",DIR("A")="Select WARD GROUP: "
S DIR("?")="^D GDIC^PSGVBW" W ! D ^DIR
I Y="^OTHER" D OUTPT^PSGVBW1 Q
;S DIC="^PS(57.5,",DIC(0)="QEAMI",DIC("A")="Select WARD GROUP: "
GDIC ;
K DIC S DIC="^PS(57.5,",DIC(0)="QEMI" D ^DIC K DIC S:+Y>0 WG=+Y
W:X["?" !!,"Enter ""^OTHER"" to include all Outpatient IV orders and orders from the",!,"wards that do not belong to a ward group",!
Q
C ;
K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: "
S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR
CDIC ;
K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 CL=+Y
W:X["?" !!,"Enter the clinic you want to use to select patients for processing.",!
Q
L ;
K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC GROUP: "
S DIR("?")="^D LDIC^PSGVBW" W ! D ^DIR
LDIC ;
K DIC S DIC="^PS(57.8,",DIC(0)="QEMI" D ^DIC K DIC S:+Y>0 CG=+Y
W:X["?" !!,"Enter the name of the clinic group you want to use to select patients for processing."
Q
W ;
K DIR S DIR(0)="FAO",DIR("A")="Select WARD: "
S DIR("?")="^D WDIC^PSGVBW" W ! D ^DIR
I Y="^OTHER" D OUTPT^PSGVBW1 Q
WDIC ;
;S DIC="^DIC(42,",DIC(0)="QEAMI",DIC("A")="Select WARD: "
K DIC S DIC="^DIC(42,",DIC(0)="QEMIZ" D ^DIC K DIC S:+Y>0 WD=+Y
W:X["?" !!,"Enter ""^OTHER"" for Outpatient IV orders",!
Q
P ;
K ^TMP("PSJSELECT",$J) S PSJCNT=1 F D ^PSJP Q:PSGP<0 D
.S PSJNV=0
.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
.;S PSJNV=$O(^PS(53.1,"AS","N",+PSGP,0)),PSJPEN=$O(^PS(53.1,"AS","P",+PSGP,0))
.S PSJPEN=$O(^PS(53.1,"AS","P",+PSGP,0))
.I 'PSJNV D ^PSJAC D
..I '$D(PSGDT) D NOW^%DTC S PSGDT=$E(%,1,12)
..S X1=$P(PSGDT,"."),X2=-2 D C^%DTC S PSGODT=X_(PSGDT#1)
..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
..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
.S X=$S(PSJTOO=1:PSJNV,PSJTOO=2:PSJPEN,1:(PSJNV+PSJPEN))
.I X D SETPN S ^TMP("PSJSELECT",$J,PSJCNT)=PN,^TMP("PSJSELECT",$J,"B",$P(PN,U),PSJCNT)="",PSJCNT=PSJCNT+1 Q
.W !,"No ",PSGVBWW," orders found for this patient."
S:$D(^TMP("PSJSELECT",$J)) Y=1
Q
;
ARRAY ; put patient(s) with non-verified orders into array
I '$D(PSGDT) D NOW^%DTC S PSGDT=$E(%,1,12)
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
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
Q
;
CG S CL="" F S CL=$O(^PS(57.8,"AD",CG,CL)) Q:CL="" D CL
Q
CL S WDN=$S($D(^SC(CL,0)):$P(^(0),"^"),1:"")
S PSGP="",PSGCLF=1 F S PSGP=$O(^PS(53.1,"AD",CL,PSGP)) Q:PSGP="" D ^PSJAC,IF
K PSGCLF
Q
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
Q
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.
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
.I PSJPAC=3 S Y=1 Q
.I PSJPAC=2 S Y=X'="U" Q
.I PSJPAC=1 S Y=X="U"
Q:PSJTOO=2
F X="N","I" I $D(^PS(53.1,"AS",X,PSGP)) NEW XX S XX=0 D G:XX SET
. 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
S X1=$P(PSGDT,"."),X2=-2 D C^%DTC S PSGODT=X_(PSGDT#1)
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
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
Q
;
IFT ;
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))
Q
;
IFT2 ;
;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)
S ND=$G(^PS(55,PSGP,"IV",ON,4))
I ($P($G(^PS(55,PSGP,"IV",ON,.2)),"^",4)="D")&('$P(ND,"^",$S(+PSJSYSU=1:1,1:4))) Q
I $S((SD>PSGDT)&('$P(ND,"^",$S(+PSJSYSU=1:1,1:4))):1,1:0)
Q
SET ;
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"
;
SETPN ;
S PN=$P(PSGP(0),"^")_U_PSGP_U_PSJPBID S:PSGSS'="P" ^TMP("PSGVBW",$J,WDN,TM,PN)=""
Q
;
GTOOP ; Get 'Type Of Order' and Package
I $P(PSJSYSU,";",3)<2,'$G(PSJRNF),'$G(PSJIRNF) S PSJPAC=0,PSJTOO=1 D GTPAC Q
S (PSJPAC,PSJTOO)=0 W !!,"1) Non-Verified Orders",!,"2) Pending Orders",!!
N DIR S DIR(0)="LAO^1:2",DIR("A")="Select Order Type(s) (1-2): ",DIR("?")="^D TOH^PSGVBW" D ^DIR
I 'Y D EXIT("TYPE OF ORDER") Q
S PSJTOO=$S($L(Y)>2:3,1:$P(Y,","))
D GTPAC
I 'PSJPAC D EXIT("PACKAGE") Q
Q
GTPAC ;
;S PSJTOO=$S($L(Y)>2:3,1:$P(Y,",")) Q:PSJTOO=1
;I $G(PSJRNF) S PSJPAC=1 Q
I ($G(PSJRNF))&('$G(PSJIRNF))&(PSJTOO=2) S PSJPAC=1 Q
I ($G(PSJIRNF))&('$G(PSJRNF))&(PSJTOO=2) S PSJPAC=2 Q
W !!,"1) Unit Dose Orders",!,"2) IV Orders",!
K DIR S DIR(0)="LAO^1:2",DIR("A")="Select Package(s) (1-2): ",DIR("?")="^D TOH^PSGVBW" W ! D ^DIR
S PSJPAC=$S($L(Y)>2:3,1:$P(Y,","))
Q
EXIT(X) ;
W !!,X," not selected, option terminated."
Q
;
TOH ;
W !!,"SELECT FROM:",!?5,"1 - NON-VERIFIED ORDERS",!?5,"2 - PENDING ORDERS"
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
PSGVBW ;BIR/CML3,MV-VERIFY ORDERS BY WARD, WARD GROUP, OR PATIENT ;22 Oct 98 / 3:14 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**5,16,39,59,62,67,58,81,80,110,111,133,139,155**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA #2191
+4 ;
+5 NEW PSJNEW,PSGPTMP,PPAGE,CL,CG
SET PSJNEW=1
START ;
+1 DO ENCV^PSGSETU
IF $DATA(XQUIT)
KILL XQUIT
QUIT
+2 ;I ($P(PSJSYSU,";")=3)!($P(PSJSYSU,";",3)=2)
+3 DO ^PSIVXU
IF $DATA(XQUIT)
KILL XQUIT
QUIT
+4 DO NOW^%DTC
SET PSGDT=%
+5 IF '$DATA(^XTMP("PSJPVNV"))
Begin DoDot:1
+6 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Display an Order Summary"
SET DIR("B")="NO"
+7 SET DIR("?",1)="Enter 'YES' to see a summary of orders by type and ward group"
SET DIR("?")="or 'NO' to go directly to patient selection."
+8 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!$DATA(DUOUT)
QUIT
IF Y
DO CNTORDRS^PSGVBWU
End DoDot:1
+9 KILL ^TMP("PSJ",$JOB)
SET PSGPXN=0
DO GTOOP
IF $DATA(DIRUT)
GOTO DONE
LOCK +^PS(53.45,PSJSYSP):1
IF '$TEST
DO LOCKERR^PSJOE
GOTO DONE
+10 SET PSGSSH="VBW"
SET PSGPXN=0
SET PSJPROT=$SELECT($PIECE(PSJSYSU,";",3)=3:3,$GET(PSJRNF):3,$GET(PSJIRNF):3,1:1)
+11 SET PSGVBWW=$SELECT(PSJTOO=1:"NON-VERIFIED",PSJTOO=2:"PENDING",1:"NON-VERIFIED AND/OR PENDING")
+12 FOR
KILL ^TMP("PSJSELECT",$JOB)
DO ^PSGSEL
IF "^"[PSGSS
QUIT
FOR
SET (PSGP,WD,WG)=0
SET PSGPTMP=0
SET PPAGE=1
DO @PSGSS
IF +Y'>0
QUIT
DO GO
+13 ;
DONE ;
+1 KILL ^TMP("PSGVBW",$JOB),^TMP("PSJSELECT",$JOB),^TMP("PSJLIST",$JOB),^TMP("PSJON",$JOB)
+2 KILL CHK,D0,DRGI,FQC,J,ND,ON,PN,PSGODT,PSGOEA,PSGOP,PSGSS,PSGSSH,RB,SD,ST,TM,WD,WDN,WG,PRI,PSJPNV,PSJCT,PSGCLF
+3 KILL PSGODDD,PSGOEORF,PSJORL,PSJORPCL,PSJORTOU,PSJORVP,PSGTOL,PSJTOO,PSGUOW,PSGONV,PX,PSGOEAV,PSGPX,PSGVBWTO,PSGVBWW,PSJOPC,PSGOENOF,PSJPROT,PSJLM,PSJASK
+4 LOCK -^PS(53.45,PSJSYSP)
IF $GET(PSGPXN)
GOTO ^PSGPER1
DO ENKV^PSGSETU
KILL ND
QUIT
+5 ;
GO ;
+1 IF PSGSS'="P"
WRITE !,"...a few moments, please..."
KILL ^TMP("PSGVBW",$JOB)
DO ARRAY
KILL CHK,ON,PN,RB,SD,TM,WD,WDN,WG,X,Y
+2 IF PSGSS'="P"
IF '$DATA(^TMP("PSGVBW",$JOB))
WRITE !,$CHAR(7),"NO ",PSGVBWW," ORDERS FOR ",$SELECT(PSGSS="P":"PATIENT",PSGSS="L":"CLINIC GROUP",PSGSS="C":"CLINIC",1:"WARD"),$SELECT(PSGSS="G":" GROUP",1:"")," SELECTED."
QUIT
+3 DO ^PSGVBW0
QUIT
+4 ;
+5 ; look-ups on ward group, ward, or patient; depending on value of SS
G ;
+1 KILL DIR
SET DIR(0)="FAO"
SET DIR("A")="Select WARD GROUP: "
+2 SET DIR("?")="^D GDIC^PSGVBW"
WRITE !
DO ^DIR
+3 IF Y="^OTHER"
DO OUTPT^PSGVBW1
QUIT
+4 ;S DIC="^PS(57.5,",DIC(0)="QEAMI",DIC("A")="Select WARD GROUP: "
GDIC ;
+1 KILL DIC
SET DIC="^PS(57.5,"
SET DIC(0)="QEMI"
DO ^DIC
KILL DIC
IF +Y>0
SET WG=+Y
+2 IF X["?"
WRITE !!,"Enter ""^OTHER"" to include all Outpatient IV orders and orders from the",!,"wards that do not belong to a ward group",!
+3 QUIT
C ;
+1 KILL DIR
SET DIR(0)="FAO"
SET DIR("A")="Select CLINIC: "
+2 SET DIR("?")="^D CDIC^PSGVBW"
WRITE !
DO ^DIR
CDIC ;
+1 KILL DIC
SET DIC="^SC("
SET DIC(0)="QEMIZ"
DO ^DIC
KILL DIC
IF +Y>0
SET CL=+Y
+2 IF X["?"
WRITE !!,"Enter the clinic you want to use to select patients for processing.",!
+3 QUIT
L ;
+1 KILL DIR
SET DIR(0)="FAO"
SET DIR("A")="Select CLINIC GROUP: "
+2 SET DIR("?")="^D LDIC^PSGVBW"
WRITE !
DO ^DIR
LDIC ;
+1 KILL DIC
SET DIC="^PS(57.8,"
SET DIC(0)="QEMI"
DO ^DIC
KILL DIC
IF +Y>0
SET CG=+Y
+2 IF X["?"
WRITE !!,"Enter the name of the clinic group you want to use to select patients for processing."
+3 QUIT
W ;
+1 KILL DIR
SET DIR(0)="FAO"
SET DIR("A")="Select WARD: "
+2 SET DIR("?")="^D WDIC^PSGVBW"
WRITE !
DO ^DIR
+3 IF Y="^OTHER"
DO OUTPT^PSGVBW1
QUIT
WDIC ;
+1 ;S DIC="^DIC(42,",DIC(0)="QEAMI",DIC("A")="Select WARD: "
+2 KILL DIC
SET DIC="^DIC(42,"
SET DIC(0)="QEMIZ"
DO ^DIC
KILL DIC
IF +Y>0
SET WD=+Y
+3 IF X["?"
WRITE !!,"Enter ""^OTHER"" for Outpatient IV orders",!
+4 QUIT
P ;
+1 KILL ^TMP("PSJSELECT",$JOB)
SET PSJCNT=1
FOR
DO ^PSJP
IF PSGP<0
QUIT
Begin DoDot:1
+2 SET PSJNV=0
+3 NEW ON,XX
FOR ON=0:0
SET ON=$ORDER(^PS(53.1,"AS","N",PSGP,ON))
IF 'ON
QUIT
SET ND=$PIECE($GET(^PS(53.1,ON,0)),U,4)
SET XX=$SELECT(ND="U"&(PSJPAC'=2):1,ND'="U"&(PSJPAC'=1):1,1:0)
IF XX
SET PSJNV=1
QUIT
+4 ;S PSJNV=$O(^PS(53.1,"AS","N",+PSGP,0)),PSJPEN=$O(^PS(53.1,"AS","P",+PSGP,0))
+5 SET PSJPEN=$ORDER(^PS(53.1,"AS","P",+PSGP,0))
+6 IF 'PSJNV
DO ^PSJAC
Begin DoDot:2
+7 IF '$DATA(PSGDT)
DO NOW^%DTC
SET PSGDT=$EXTRACT(%,1,12)
+8 SET X1=$PIECE(PSGDT,".")
SET X2=-2
DO C^%DTC
SET PSGODT=X_(PSGDT#1)
+9 IF PSJPAC'=2
FOR ST="C","O","OC","P","R"
FOR SD=$SELECT(ST="O":PSJPAD,1:PSGODT):0
SET SD=$ORDER(^PS(55,PSGP,5,"AU",ST,SD))
IF 'SD!PSJNV
QUIT
FOR ON=0:0
SET ON=$ORDER(^PS(55,PSGP,5,"AU",ST,SD,ON))
IF 'ON
QUIT
IF $DATA(^PS(55,PSGP,5,ON,0))
IF $PIECE(^(0),"^",9)'["D"
DO IFT
IF $TEST
SET PSJNV=1
QUIT
+10 IF PSJPAC'=1
FOR SD=+PSJPAD:0
SET SD=$ORDER(^PS(55,PSGP,"IV","AIS",SD))
IF 'SD
QUIT
FOR ON=0:0
SET ON=$ORDER(^PS(55,PSGP,"IV","AIS",SD,ON))
IF 'ON
QUIT
IF $DATA(^PS(55,PSGP,"IV",ON,0))
IF $PIECE(^(0),"^",17)'["D"
DO IFT2
IF $TEST
SET PSJNV=1
QUIT
End DoDot:2
+11 SET X=$SELECT(PSJTOO=1:PSJNV,PSJTOO=2:PSJPEN,1:(PSJNV+PSJPEN))
+12 IF X
DO SETPN
SET ^TMP("PSJSELECT",$JOB,PSJCNT)=PN
SET ^TMP("PSJSELECT",$JOB,"B",$PIECE(PN,U),PSJCNT)=""
SET PSJCNT=PSJCNT+1
QUIT
+13 WRITE !,"No ",PSGVBWW," orders found for this patient."
End DoDot:1
+14 IF $DATA(^TMP("PSJSELECT",$JOB))
SET Y=1
+15 QUIT
+16 ;
ARRAY ; put patient(s) with non-verified orders into array
+1 IF '$DATA(PSGDT)
DO NOW^%DTC
SET PSGDT=$EXTRACT(%,1,12)
+2 SET X1=$PIECE(PSGDT,".")
SET X2=-2
DO C^%DTC
SET PSGODT=X_(PSGDT#1)
SET PSGVBWW=$SELECT(PSJTOO=1:"NON-VERIFIED",PSJTOO=2:"PENDING",1:"NON-VERIFIED AND/OR PENDING")
IF PSGSS="P"
DO IF
IF $TEST
SET ^TMP("PSGVBW",$JOB)=$PIECE(PSGP(0),"^")_"^"_PSGP
QUIT
+3 IF PSGSS="L"
GOTO CG
IF PSGSS="C"
GOTO CL
IF PSGSS="W"
GOTO WD
FOR WD=0:0
SET WD=$ORDER(^PS(57.5,"AC",WG,WD))
IF 'WD
QUIT
DO WD
+4 QUIT
+5 ;
CG SET CL=""
FOR
SET CL=$ORDER(^PS(57.8,"AD",CG,CL))
IF CL=""
QUIT
DO CL
+1 QUIT
CL SET WDN=$SELECT($DATA(^SC(CL,0)):$PIECE(^(0),"^"),1:"")
+1 SET PSGP=""
SET PSGCLF=1
FOR
SET PSGP=$ORDER(^PS(53.1,"AD",CL,PSGP))
IF PSGP=""
QUIT
DO ^PSJAC
DO IF
+2 KILL PSGCLF
+3 QUIT
WD SET WDN=$SELECT($DATA(^DIC(42,WD,0)):$PIECE(^(0),"^"),1:"")
IF WDN]""
FOR PSGP=0:0
SET PSGP=$ORDER(^DPT("CN",WDN,PSGP))
IF 'PSGP
QUIT
IF $SELECT($DATA(^PS(55,"APV",PSGP)):1,$DATA(^PS(55,"APIV",PSGP)):1,$ORDER(^PS(55,PSGP,5,"AUS",PSGDT)):1,1:$DATA(^PS(53.1,"AC",PSGP)))
DO ^PSJAC
DO IF
+1 QUIT
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.
+1 WRITE "."
IF PSJTOO'=1
FOR ON=0:0
SET ON=$ORDER(^PS(53.1,"AS","P",PSGP,ON))
IF 'ON!(($GET(PSGCLF))&('$DATA(^PS(53.1,"AD",+$GET(CL),PSGP,+$GET(ON)))))
QUIT
SET X=$PIECE($GET(^PS(53.1,ON,0)),U,4)
SET Y=0
IF "FIU"[X
Begin DoDot:1
+2 IF PSJPAC=3
SET Y=1
QUIT
+3 IF PSJPAC=2
SET Y=X'="U"
QUIT
+4 IF PSJPAC=1
SET Y=X="U"
End DoDot:1
IF Y
GOTO SET
+5 IF PSJTOO=2
QUIT
+6 FOR X="N","I"
IF $DATA(^PS(53.1,"AS",X,PSGP))
NEW XX
SET XX=0
Begin DoDot:1
+7 NEW ON
FOR ON=0:0
SET ON=$ORDER(^PS(53.1,"AS",X,PSGP,ON))
IF 'ON
QUIT
SET ND=$PIECE($GET(^PS(53.1,ON,0)),U,4)
SET XX=$SELECT(ND="U"&(PSJPAC'=2):1,ND'="U"&(PSJPAC'=1):1,1:0)
IF XX
QUIT
End DoDot:1
IF XX
GOTO SET
+8 SET X1=$PIECE(PSGDT,".")
SET X2=-2
DO C^%DTC
SET PSGODT=X_(PSGDT#1)
+9 IF PSJPAC'=2
FOR ST="C","O","OC","P","R"
FOR SD=$SELECT(ST="O":PSJPAD,1:PSGODT):0
SET SD=$ORDER(^PS(55,PSGP,5,"AU",ST,SD))
IF 'SD
QUIT
FOR ON=0:0
SET ON=$ORDER(^PS(55,PSGP,5,"AU",ST,SD,ON))
IF 'ON
QUIT
IF $DATA(^PS(55,PSGP,5,ON,0))
IF $PIECE(^(0),"^",9)'["D"
DO IFT
IF $TEST
GOTO SET
+10 IF PSJPAC'=1
FOR SD=+PSJPAD:0
SET SD=$ORDER(^PS(55,PSGP,"IV","AIS",SD))
IF 'SD
QUIT
FOR ON=0:0
SET ON=$ORDER(^PS(55,PSGP,"IV","AIS",SD,ON))
IF 'ON
QUIT
IF $DATA(^PS(55,PSGP,"IV",ON,0))
IF $PIECE(^(0),"^",17)'["D"
DO IFT2
IF $TEST
GOTO SET
+11 QUIT
+12 ;
IFT ;
+1 SET ND=$GET(^PS(55,PSGP,5,ON,4))
IF $SELECT(SD>PSGDT:$SELECT(ND="":1,'$PIECE(ND,"^",$SELECT(PSJSYSU:PSJSYSU,1:1)):1,$PIECE(ND,"^",13):1,$PIECE(ND,"^",19):1,$PIECE(ND,"^",23):1,1:$PIECE(ND,"^",16)),ST="O":$SELECT(ND="":1,1:'$PIECE(ND,"^",$SELECT(PSJSYSU:PSJSYSU,1:1))),1:...
... $PIECE(ND,"^",16))
+2 QUIT
+3 ;
IFT2 ;
+1 ;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)
+2 SET ND=$GET(^PS(55,PSGP,"IV",ON,4))
+3 IF ($PIECE($GET(^PS(55,PSGP,"IV",ON,.2)),"^",4)="D")&('$PIECE(ND,"^",$SELECT(+PSJSYSU=1:1,1:4)))
QUIT
+4 IF $SELECT((SD>PSGDT)&('$PIECE(ND,"^",$SELECT(+PSJSYSU=1:1,1:4))):1,1:0)
+5 QUIT
SET ;
+1 SET TM=$SELECT(PSJPRB="":"",1:$PIECE($GET(^PS(57.7,WD,1,+$ORDER(^PS(57.7,"AWRT",WD,PSJPRB,0)),0)),"^"))
IF TM=""
SET TM="zz"
+2 ;
SETPN ;
+1 SET PN=$PIECE(PSGP(0),"^")_U_PSGP_U_PSJPBID
IF PSGSS'="P"
SET ^TMP("PSGVBW",$JOB,WDN,TM,PN)=""
+2 QUIT
+3 ;
GTOOP ; Get 'Type Of Order' and Package
+1 IF $PIECE(PSJSYSU,";",3)<2
IF '$GET(PSJRNF)
IF '$GET(PSJIRNF)
SET PSJPAC=0
SET PSJTOO=1
DO GTPAC
QUIT
+2 SET (PSJPAC,PSJTOO)=0
WRITE !!,"1) Non-Verified Orders",!,"2) Pending Orders",!!
+3 NEW DIR
SET DIR(0)="LAO^1:2"
SET DIR("A")="Select Order Type(s) (1-2): "
SET DIR("?")="^D TOH^PSGVBW"
DO ^DIR
+4 IF 'Y
DO EXIT("TYPE OF ORDER")
QUIT
+5 SET PSJTOO=$SELECT($LENGTH(Y)>2:3,1:$PIECE(Y,","))
+6 DO GTPAC
+7 IF 'PSJPAC
DO EXIT("PACKAGE")
QUIT
+8 QUIT
GTPAC ;
+1 ;S PSJTOO=$S($L(Y)>2:3,1:$P(Y,",")) Q:PSJTOO=1
+2 ;I $G(PSJRNF) S PSJPAC=1 Q
+3 IF ($GET(PSJRNF))&('$GET(PSJIRNF))&(PSJTOO=2)
SET PSJPAC=1
QUIT
+4 IF ($GET(PSJIRNF))&('$GET(PSJRNF))&(PSJTOO=2)
SET PSJPAC=2
QUIT
+5 WRITE !!,"1) Unit Dose Orders",!,"2) IV Orders",!
+6 KILL DIR
SET DIR(0)="LAO^1:2"
SET DIR("A")="Select Package(s) (1-2): "
SET DIR("?")="^D TOH^PSGVBW"
WRITE !
DO ^DIR
+7 SET PSJPAC=$SELECT($LENGTH(Y)>2:3,1:$PIECE(Y,","))
+8 QUIT
EXIT(X) ;
+1 WRITE !!,X," not selected, option terminated."
+2 QUIT
+3 ;
TOH ;
+1 WRITE !!,"SELECT FROM:",!?5,"1 - NON-VERIFIED ORDERS",!?5,"2 - PENDING ORDERS"
+2 WRITE !!?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."
QUIT
