- PSGVBW ;BIR/CML,MV - VERIFY ORDERS BY WARD, WARD GROUP, PATIENT, OR PRIORITY ;10/22/98 3:14 PM
- ;;5.0;INPATIENT MEDICATIONS;**5,16,39,59,62,67,58,81,80,110,111,133,139,155,241,243,265,275,304,325,422,407**;DEC 16, 1997;Build 26
- ;
- ; Reference to ^PS(55 is supported by DBIA #2191
- ; Reference to ^PS(51.1 is supported by DBIA #2177
- ; Reference to ^DPT is supported by DBIA #10035
- ;
- N PSJNEW,PSGPTMP,PPAGE,CL,CG S PSJNEW=1
- START ; Lookup patient by ward group, ward, priority, or patient; depending on value of PSGSS
- ;
- D ENCV^PSGSETU I $D(XQUIT) K XQUIT Q
- D ^PSIVXU I $D(XQUIT) K XQUIT Q
- Q:$G(DONE) ;P407
- 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 PRI^PSGSEL Q:"^"[PSGSS F S (PSGP,WD,WG)=0 S PSGPTMP=0,PPAGE=1 K PSGPRIF D @PSGSS Q:+Y'>0 D GO
- ;
- DONE ; Cleanup
- D DONE2
- K SETWDN,PTPRI,SETTM,SETPN,SUBS,TMPWD,STATUS
- 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,PSGPRIF,LIDT,WDNAME,IFPRI
- K PSGODDD,PSGOEORF,PSJORL,PSJORPCL,PSJORTOU,PSJORVP,PSGTOL,PSJTOO,PSGUOW,PSGONV,PX,PSGOEAV,PSGPX,PSGVBWTO,PSGVBWW,PSJOPC,PSGOENOF,PSJPROT,PSJLM,PSJASK
- K PSJPAC,PSJINDEX,PSJCNT,PSIVSN,PSGWORP1,PSGWORP2,PSGVBY,PSGVBWN,PSGVBTM,PSGVBPN,PSGPXN,PSGPRIN,PSGPRD,PSGINWD,PSGINCL,PRDON,PRDNS,PRD,PPN,ORDT
- L -^PS(53.45,PSJSYSP) G:$G(PSGPXN) ^PSGPER1 D ENKV^PSGSETU K ND Q
- ;
- DONE2 ; Partial Cleanup
- K ^TMP("PSGVBW",$J),^TMP("PSGVBW2",$J),^TMP("PSGVBW3",$J),^TMP("PSJSELECT",$J),^TMP("PSJLIST",$J),^TMP("PSJON",$J)
- K PRD
- Q
- ;
- GO ; Find and display matching patients
- D START^PSIVARH
- I PSGSS'="P" W !,"...a few moments, please..." K ^TMP("PSGVBW",$J),^TMP("PSGVBW2",$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",PSGSS="PR":"PRIORITY",1:"WARD"),$S(PSGSS="G":" GROUP",1:"")," SELECTED." Q
- D ^PSGVBW0,DONE2 Q
- ;
- G ; Select a Ward Group
- 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
- GDIC ; Ward Group lookup
- 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 orders from the wards that do not",!,"belong to a ward group, or orders that have neither a ward nor a clinic.",! ;PSJ*5*241: Updated help text
- Q
- C ; Select a Clinic
- K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: "
- S DIR("?")="^D CDIC^PSGVBW" W ! D ^DIR
- CDIC ; Clinic lookup
- 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 ; Select a Clinic Group
- K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC GROUP: "
- S DIR("?")="^D LDIC^PSGVBW" W ! D ^DIR
- LDIC ; Clinic Group lookup
- 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 ; Select a Ward
- 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 ; Ward lookup
- 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
- PR ; Select order priority
- K DIR S DIR(0)="SO^1:STAT;2:ASAP;3:ROUTINE"
- S DIR("A")="Select 1-3 ",DIR("?")=" Choose a Priority."
- S DIR("?",1)="Enter a PRIORITY to include all patients with orders containing that PRIORITY"
- D ^DIR S:Y>0 PRD=+Y S:+Y>0 WDN=$S(PRD=1:"STAT",PRD=2:"ASAP",3:"ROUTINE")
- Q
- P ; Select patient
- 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!(SD'=+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",PRI:PSGSS="PR" S WD=0 F S WD=$O(^PS(57.5,"AC",WG,WD)) Q:'WD D WD
- Q
- ;
- CG ; Find all clinics in selected clinic group
- S CL="" F S CL=$O(^PS(57.8,"AD",CG,CL)) Q:CL="" D CL
- Q
- CL ; Find all patients in selected clinic
- 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 ; Find all patients in selected ward
- S WDN=$S($D(^DIC(42,WD,0)):$P(^(0),"^"),1:"")
- I WDN]"" S PSGP=0 F S PSGP=$O(^DPT("CN",WDN,PSGP)) Q:'PSGP D
- .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
- PRI ; Find orders with selected Priority
- ; Once a patient is identified in any status index ("I", "N", or "P"), all orders for that patient are checked in the
- ; IF subroutine. To prevent unnecessary duplication of processing, "PSGVBW3" node of ^TMP, sorted by patient, will be
- ; set when a patient's orders are processed, and checked for each status index. If patient exists in the "PSGVBW3" node,
- ; patient has already been processed, so quit.
- N NDP2,PSGALL,ND0,PSGPRIFZ K ^TMP("PSGVBW3",$J)
- S PSGPRIF=1 F STATUS="I","N","P" S PSGP=0 F S PSGP=$O(^PS(53.1,"AS",STATUS,PSGP)) Q:'PSGP Q:($D(^TMP("PSGVBW3",$J,PSGP))) D ^PSJAC,IF
- K ^TMP("PSGVBW3",$J)
- 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.;PSJ*5*241:Changed quit conditions
- W "." I PSJTOO'=1 S ON=0 F S ON=$O(^PS(53.1,"AS","P",PSGP,ON)) Q:'ON!(($G(WDN)="ZZ")&(+$P($G(^PS(53.1,+$G(ON),"DSS")),U,1)'=0)) D
- .Q:(($G(PSGCLF))&('$D(^PS(53.1,"AD",+$G(CL),PSGP,+$G(ON))))) ;PSJ*5*265 - move quit condition inside loop
- .S X=$P($G(^PS(53.1,ON,0)),U,4),IFPRI=0,Y=0 I "FIU"[X D D:Y SET
- ..I $G(PSGPRIF) D Q:'IFPRI
- ...N PRIO S PRIO=$P($G(^PS(53.1,+ON,.2)),"^",4),PRIO=$S(PRIO="S":1,PRIO="A":2,1:3) S IFPRI=$S(PRD=PRIO:1,1:"")
- ..I PSJPAC=3 S Y=1 Q
- ..I PSJPAC=2 S Y=X'="U" Q
- ..I PSJPAC=1 S Y=X="U"
- I PSJTOO=2 D Q
- .I '$G(PSGPRIF),$D(^TMP("PSGVBW2",$J)) D SET2
- ;PSJ*5*422 add PSJXXX to get all orders
- N PRIOAR,PSJXXX,XX
- F X="N","I" I $D(^PS(53.1,"AS",X,PSGP)) S (XX,PSJXXX)=0 D I XX!PSJXXX D SET K ON
- . F ON=0:0 S ON=$O(^PS(53.1,"AS",X,PSGP,ON)) Q:'ON!(($G(WDN)="ZZ")&(+$P($G(^PS(53.1,+$G(ON),"DSS")),U,1)'=0)) D Q:($G(PRD)&$G(XX))
- .. S ND=$P($G(^PS(53.1,ON,0)),U,4),XX=$S(ND="U"&(PSJPAC'=2):1,ND'="U"&(PSJPAC'=1):1,1:0)
- .. S:XX PSJXXX=1 I XX D
- ... S PRIOAR=$P($G(^PS(53.1,+$G(ON),.2)),U,4),PRIOAR=$S(PRIOAR="S":"S",PRIOAR="A":"A",1:"R")
- ... I $G(PRD) S XX=$S(PRD=1&(PRIOAR="S"):1,PRD=2&(PRIOAR="A"):1,PRD=3&(PRIOAR="R"):1,1:0) Q
- ... S PRIOAR(PRIOAR)=ON
- . Q:$G(PRD) S ON=$S($G(PRIOAR("S")):PRIOAR("S"),$G(PRIOAR("A")):PRIOAR("A"),1:$G(PRIOAR("R")))
- 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 D SET
- ;*PSJ*5*241:Expired IV orders must be one-time
- 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 D
- .N SCH,STYPE S STYPE=0,SCH=$P($G(^PS(55,PSGP,"IV",ON,0)),U,9)
- .S:SCH]"" SCH=$O(^PS(51.1,"APPSJ",SCH,STYPE)) S:SCH]"" STYPE=$P($G(^PS(51.1,SCH,0)),U,5)
- .I $D(^PS(55,PSGP,"IV",ON,0)),$P(^(0),"^",17)'["D",'(($P(^(0),"^",17)="E")&($G(STYPE)'="O")) D IFT2 I D SET
- I '$G(PSGPRIF),$D(^TMP("PSGVBW2",$J)) D SET2
- Q
- ;
- IFT ; Loop through active UD orders in ^PS(55 that have not been verified by pharmacist.
- 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 ; Loop through active IV orders in ^PS(55 that have not been verified by pharmacist.
- ;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 ; Set patient specific variables for ^TMP subscripts
- S PRDON=""
- I $G(ON) S PRDON=$P($G(^PS(53.1,+ON,.2)),"^",4),PRDON=$S(PRDON="A":"ASAP",PRDON="S":"STAT",PRDON="R":"ROUTINE",1:"zz")
- S PTPRI=$S(PRDON="STAT":1,PRDON="ASAP":2,PRDON="ROUTINE":3,1:3)
- I $G(PSGPRIF) Q:(PRD'=PTPRI)
- K DIC,X,Y,WDNAME,TMPWD S WDNAME=$G(^DPT(+PSGP,.1)) S X=WDNAME,DIC="^DIC(42,",DIC(0)="BOXZ" D ^DIC S TMPWD=+Y
- S TM=$S(PSJPRB="":"",1:$P($G(^PS(57.7,TMPWD,1,+$O(^PS(57.7,"AWRT",TMPWD,PSJPRB,0)),0)),"^")) S:TM="" TM="zz"
- ;
- SETPN ; If searching for specific priority:
- ; - set patient into ^TMP("PSGBW" sorted by Priority Name, Priority #, Team, Patient Name^IEN^SSN
- ; If not searching for specific priority:
- ; - set patient into ^TMP("PSGVBW2" sorted by 'Patient Name^IEN^SSN', then Priority
- ; - set patient into ^TMP("PSGVBW3" sorted by Patient IEN
- I $G(PSGP(0))="" D DEM^VADPT S PSGP(0)=VADM(1)
- S PN=$P(PSGP(0),"^")_U_PSGP_U_PSJPBID
- Q:PSGSS="P"
- I $G(PSGPRIF) S ^TMP("PSGVBW",$J,WDN,PTPRI,TM,PN)="" Q
- S ^TMP("PSGVBW2",$J,PN,+$G(PTPRI))=WDN_"^"_TM,^TMP("PSGVBW3",$J,+PSGP)=""
- Q
- ;
- SET2 ; If not searching for a specific priority,find the highest priority order associated with patient.
- ; Set the patient into ^TMP("PSGVBW" sorted by highest Priority Name, Priority #, Team, Patient Name^IEN^SSN
- S SETPN="" F S SETPN=$O(^TMP("PSGVBW2",$J,SETPN)) Q:SETPN="" D
- .S PTPRI=$O(^TMP("PSGVBW2",$J,SETPN,0)) Q:'$G(PTPRI)
- .S SUBS=$G(^TMP("PSGVBW2",$J,SETPN,PTPRI)),SETWDN=$P(SUBS,"^"),SETTM=$P(SUBS,"^",2) Q:SETWDN=""!(SETTM="")
- .S ^TMP("PSGVBW",$J,SETWDN,PTPRI,SETTM,SETPN)=""
- K ^TMP("PSGVBW2",$J)
- 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 ; Prompt user for Package
- 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) ; Generic user error message
- W !!,X," not selected, option terminated."
- Q
- ;
- TOH ; Help text
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGVBW 12848 printed Feb 18, 2025@23:29:47 Page 2
- PSGVBW ;BIR/CML,MV - VERIFY ORDERS BY WARD, WARD GROUP, PATIENT, OR PRIORITY ;10/22/98 3:14 PM
- +1 ;;5.0;INPATIENT MEDICATIONS;**5,16,39,59,62,67,58,81,80,110,111,133,139,155,241,243,265,275,304,325,422,407**;DEC 16, 1997;Build 26
- +2 ;
- +3 ; Reference to ^PS(55 is supported by DBIA #2191
- +4 ; Reference to ^PS(51.1 is supported by DBIA #2177
- +5 ; Reference to ^DPT is supported by DBIA #10035
- +6 ;
- +7 NEW PSJNEW,PSGPTMP,PPAGE,CL,CG
- SET PSJNEW=1
- START ; Lookup patient by ward group, ward, priority, or patient; depending on value of PSGSS
- +1 ;
- +2 DO ENCV^PSGSETU
- IF $DATA(XQUIT)
- KILL XQUIT
- QUIT
- +3 DO ^PSIVXU
- IF $DATA(XQUIT)
- KILL XQUIT
- QUIT
- +4 ;P407
- if $GET(DONE)
- QUIT
- +5 DO NOW^%DTC
- SET PSGDT=%
- +6 IF '$DATA(^XTMP("PSJPVNV"))
- Begin DoDot:1
- +7 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Display an Order Summary"
- SET DIR("B")="NO"
- +8 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."
- +9 DO ^DIR
- KILL DIR
- if $DATA(DIRUT)!$DATA(DUOUT)
- QUIT
- IF Y
- DO CNTORDRS^PSGVBWU
- End DoDot:1
- +10 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
- +11 SET PSGSSH="VBW"
- SET PSGPXN=0
- SET PSJPROT=$SELECT($PIECE(PSJSYSU,";",3)=3:3,$GET(PSJRNF):3,$GET(PSJIRNF):3,1:1)
- +12 SET PSGVBWW=$SELECT(PSJTOO=1:"NON-VERIFIED",PSJTOO=2:"PENDING",1:"NON-VERIFIED AND/OR PENDING")
- +13 FOR
- KILL ^TMP("PSJSELECT",$JOB)
- DO PRI^PSGSEL
- if "^"[PSGSS
- QUIT
- FOR
- SET (PSGP,WD,WG)=0
- SET PSGPTMP=0
- SET PPAGE=1
- KILL PSGPRIF
- DO @PSGSS
- if +Y'>0
- QUIT
- DO GO
- +14 ;
- DONE ; Cleanup
- +1 DO DONE2
- +2 KILL SETWDN,PTPRI,SETTM,SETPN,SUBS,TMPWD,STATUS
- +3 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,PSGPRIF,LIDT,WDNAME,IFPRI
- +4 KILL PSGODDD,PSGOEORF,PSJORL,PSJORPCL,PSJORTOU,PSJORVP,PSGTOL,PSJTOO,PSGUOW,PSGONV,PX,PSGOEAV,PSGPX,PSGVBWTO,PSGVBWW,PSJOPC,PSGOENOF,PSJPROT,PSJLM,PSJASK
- +5 KILL PSJPAC,PSJINDEX,PSJCNT,PSIVSN,PSGWORP1,PSGWORP2,PSGVBY,PSGVBWN,PSGVBTM,PSGVBPN,PSGPXN,PSGPRIN,PSGPRD,PSGINWD,PSGINCL,PRDON,PRDNS,PRD,PPN,ORDT
- +6 LOCK -^PS(53.45,PSJSYSP)
- if $GET(PSGPXN)
- GOTO ^PSGPER1
- DO ENKV^PSGSETU
- KILL ND
- QUIT
- +7 ;
- DONE2 ; Partial Cleanup
- +1 KILL ^TMP("PSGVBW",$JOB),^TMP("PSGVBW2",$JOB),^TMP("PSGVBW3",$JOB),^TMP("PSJSELECT",$JOB),^TMP("PSJLIST",$JOB),^TMP("PSJON",$JOB)
- +2 KILL PRD
- +3 QUIT
- +4 ;
- GO ; Find and display matching patients
- +1 DO START^PSIVARH
- +2 IF PSGSS'="P"
- WRITE !,"...a few moments, please..."
- KILL ^TMP("PSGVBW",$JOB),^TMP("PSGVBW2",$JOB)
- DO ARRAY
- KILL CHK,ON,PN,RB,SD,TM,WD,WDN,WG,X,Y
- +3 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",PSGSS="PR":"PRIORITY",1:"WARD"),$SELECT(PSGSS="G":" GROUP",1:"")," SELECTED."
- QUIT
- +4 DO ^PSGVBW0
- DO DONE2
- QUIT
- +5 ;
- G ; Select a Ward Group
- +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
- GDIC ; Ward Group lookup
- +1 KILL DIC
- SET DIC="^PS(57.5,"
- SET DIC(0)="QEMI"
- DO ^DIC
- KILL DIC
- if +Y>0
- SET WG=+Y
- +2 ;PSJ*5*241: Updated help text
- if X["?"
- WRITE !!,"Enter ""^OTHER"" to include all orders from the wards that do not",!,"belong to a ward group, or orders that have neither a ward nor a clinic.",!
- +3 QUIT
- C ; Select a Clinic
- +1 KILL DIR
- SET DIR(0)="FAO"
- SET DIR("A")="Select CLINIC: "
- +2 SET DIR("?")="^D CDIC^PSGVBW"
- WRITE !
- DO ^DIR
- CDIC ; Clinic lookup
- +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 ; Select a Clinic Group
- +1 KILL DIR
- SET DIR(0)="FAO"
- SET DIR("A")="Select CLINIC GROUP: "
- +2 SET DIR("?")="^D LDIC^PSGVBW"
- WRITE !
- DO ^DIR
- LDIC ; Clinic Group lookup
- +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 ; Select a Ward
- +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 ; Ward lookup
- +1 KILL DIC
- SET DIC="^DIC(42,"
- SET DIC(0)="QEMIZ"
- DO ^DIC
- KILL DIC
- if +Y>0
- SET WD=+Y
- +2 if X["?"
- WRITE !!,"Enter ""^OTHER"" for Outpatient IV orders",!
- +3 QUIT
- PR ; Select order priority
- +1 KILL DIR
- SET DIR(0)="SO^1:STAT;2:ASAP;3:ROUTINE"
- +2 SET DIR("A")="Select 1-3 "
- SET DIR("?")=" Choose a Priority."
- +3 SET DIR("?",1)="Enter a PRIORITY to include all patients with orders containing that PRIORITY"
- +4 DO ^DIR
- if Y>0
- SET PRD=+Y
- if +Y>0
- SET WDN=$SELECT(PRD=1:"STAT",PRD=2:"ASAP",3:"ROUTINE")
- +5 QUIT
- P ; Select patient
- +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!(SD'=+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
- 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
- if PSGSS="PR"
- GOTO PRI
- SET WD=0
- FOR
- SET WD=$ORDER(^PS(57.5,"AC",WG,WD))
- if 'WD
- QUIT
- DO WD
- +4 QUIT
- +5 ;
- CG ; Find all clinics in selected clinic group
- +1 SET CL=""
- FOR
- SET CL=$ORDER(^PS(57.8,"AD",CG,CL))
- if CL=""
- QUIT
- DO CL
- +2 QUIT
- CL ; Find all patients in selected clinic
- +1 SET WDN=$SELECT($DATA(^SC(CL,0)):$PIECE(^(0),"^"),1:"")
- +2 SET PSGP=""
- SET PSGCLF=1
- FOR
- SET PSGP=$ORDER(^PS(53.1,"AD",CL,PSGP))
- if PSGP=""
- QUIT
- DO ^PSJAC
- DO IF
- +3 KILL PSGCLF
- +4 QUIT
- WD ; Find all patients in selected ward
- +1 SET WDN=$SELECT($DATA(^DIC(42,WD,0)):$PIECE(^(0),"^"),1:"")
- +2 IF WDN]""
- SET PSGP=0
- FOR
- SET PSGP=$ORDER(^DPT("CN",WDN,PSGP))
- if 'PSGP
- QUIT
- Begin DoDot:1
- +3 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
- End DoDot:1
- +4 QUIT
- PRI ; Find orders with selected Priority
- +1 ; Once a patient is identified in any status index ("I", "N", or "P"), all orders for that patient are checked in the
- +2 ; IF subroutine. To prevent unnecessary duplication of processing, "PSGVBW3" node of ^TMP, sorted by patient, will be
- +3 ; set when a patient's orders are processed, and checked for each status index. If patient exists in the "PSGVBW3" node,
- +4 ; patient has already been processed, so quit.
- +5 NEW NDP2,PSGALL,ND0,PSGPRIFZ
- KILL ^TMP("PSGVBW3",$JOB)
- +6 SET PSGPRIF=1
- FOR STATUS="I","N","P"
- SET PSGP=0
- FOR
- SET PSGP=$ORDER(^PS(53.1,"AS",STATUS,PSGP))
- if 'PSGP
- QUIT
- if ($DATA(^TMP("PSGVBW3",$JOB,PSGP)))
- QUIT
- DO ^PSJAC
- DO IF
- +7 KILL ^TMP("PSGVBW3",$JOB)
- +8 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.;PSJ*5*241:Changed quit conditions
- +1 WRITE "."
- IF PSJTOO'=1
- SET ON=0
- FOR
- SET ON=$ORDER(^PS(53.1,"AS","P",PSGP,ON))
- if 'ON!(($GET(WDN)="ZZ")&(+$PIECE($GET(^PS(53.1,+$GET(ON),"DSS")),U,1)'=0))
- QUIT
- Begin DoDot:1
- +2 ;PSJ*5*265 - move quit condition inside loop
- if (($GET(PSGCLF))&('$DATA(^PS(53.1,"AD",+$GET(CL),PSGP,+$GET(ON)))))
- QUIT
- +3 SET X=$PIECE($GET(^PS(53.1,ON,0)),U,4)
- SET IFPRI=0
- SET Y=0
- IF "FIU"[X
- Begin DoDot:2
- +4 IF $GET(PSGPRIF)
- Begin DoDot:3
- +5 NEW PRIO
- SET PRIO=$PIECE($GET(^PS(53.1,+ON,.2)),"^",4)
- SET PRIO=$SELECT(PRIO="S":1,PRIO="A":2,1:3)
- SET IFPRI=$SELECT(PRD=PRIO:1,1:"")
- End DoDot:3
- if 'IFPRI
- QUIT
- +6 IF PSJPAC=3
- SET Y=1
- QUIT
- +7 IF PSJPAC=2
- SET Y=X'="U"
- QUIT
- +8 IF PSJPAC=1
- SET Y=X="U"
- End DoDot:2
- if Y
- DO SET
- End DoDot:1
- +9 IF PSJTOO=2
- Begin DoDot:1
- +10 IF '$GET(PSGPRIF)
- IF $DATA(^TMP("PSGVBW2",$JOB))
- DO SET2
- End DoDot:1
- QUIT
- +11 ;PSJ*5*422 add PSJXXX to get all orders
- +12 NEW PRIOAR,PSJXXX,XX
- +13 FOR X="N","I"
- IF $DATA(^PS(53.1,"AS",X,PSGP))
- SET (XX,PSJXXX)=0
- Begin DoDot:1
- +14 FOR ON=0:0
- SET ON=$ORDER(^PS(53.1,"AS",X,PSGP,ON))
- if 'ON!(($GET(WDN)="ZZ")&(+$PIECE($GET(^PS(53.1,+$GET(ON),"DSS")),U,1)'=0))
- QUIT
- Begin DoDot:2
- +15 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)
- +16 if XX
- SET PSJXXX=1
- IF XX
- Begin DoDot:3
- +17 SET PRIOAR=$PIECE($GET(^PS(53.1,+$GET(ON),.2)),U,4)
- SET PRIOAR=$SELECT(PRIOAR="S":"S",PRIOAR="A":"A",1:"R")
- +18 IF $GET(PRD)
- SET XX=$SELECT(PRD=1&(PRIOAR="S"):1,PRD=2&(PRIOAR="A"):1,PRD=3&(PRIOAR="R"):1,1:0)
- QUIT
- +19 SET PRIOAR(PRIOAR)=ON
- End DoDot:3
- End DoDot:2
- if ($GET(PRD)&$GET(XX))
- QUIT
- +20 if $GET(PRD)
- QUIT
- SET ON=$SELECT($GET(PRIOAR("S")):PRIOAR("S"),$GET(PRIOAR("A")):PRIOAR("A"),1:$GET(PRIOAR("R")))
- End DoDot:1
- IF XX!PSJXXX
- DO SET
- KILL ON
- +21 SET X1=$PIECE(PSGDT,".")
- SET X2=-2
- DO C^%DTC
- SET PSGODT=X_(PSGDT#1)
- +22 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
- DO SET
- +23 ;*PSJ*5*241:Expired IV orders must be one-time
- +24 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
- Begin DoDot:1
- +25 NEW SCH,STYPE
- SET STYPE=0
- SET SCH=$PIECE($GET(^PS(55,PSGP,"IV",ON,0)),U,9)
- +26 if SCH]""
- SET SCH=$ORDER(^PS(51.1,"APPSJ",SCH,STYPE))
- if SCH]""
- SET STYPE=$PIECE($GET(^PS(51.1,SCH,0)),U,5)
- +27 IF $DATA(^PS(55,PSGP,"IV",ON,0))
- IF $PIECE(^(0),"^",17)'["D"
- IF '(($PIECE(^(0),"^",17)="E")&($GET(STYPE)'="O"))
- DO IFT2
- IF $TEST
- DO SET
- End DoDot:1
- +28 IF '$GET(PSGPRIF)
- IF $DATA(^TMP("PSGVBW2",$JOB))
- DO SET2
- +29 QUIT
- +30 ;
- IFT ; Loop through active UD orders in ^PS(55 that have not been verified by pharmacist.
- +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 ; Loop through active IV orders in ^PS(55 that have not been verified by pharmacist.
- +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 ; Set patient specific variables for ^TMP subscripts
- +1 SET PRDON=""
- +2 IF $GET(ON)
- SET PRDON=$PIECE($GET(^PS(53.1,+ON,.2)),"^",4)
- SET PRDON=$SELECT(PRDON="A":"ASAP",PRDON="S":"STAT",PRDON="R":"ROUTINE",1:"zz")
- +3 SET PTPRI=$SELECT(PRDON="STAT":1,PRDON="ASAP":2,PRDON="ROUTINE":3,1:3)
- +4 IF $GET(PSGPRIF)
- if (PRD'=PTPRI)
- QUIT
- +5 KILL DIC,X,Y,WDNAME,TMPWD
- SET WDNAME=$GET(^DPT(+PSGP,.1))
- SET X=WDNAME
- SET DIC="^DIC(42,"
- SET DIC(0)="BOXZ"
- DO ^DIC
- SET TMPWD=+Y
- +6 SET TM=$SELECT(PSJPRB="":"",1:$PIECE($GET(^PS(57.7,TMPWD,1,+$ORDER(^PS(57.7,"AWRT",TMPWD,PSJPRB,0)),0)),"^"))
- if TM=""
- SET TM="zz"
- +7 ;
- SETPN ; If searching for specific priority:
- +1 ; - set patient into ^TMP("PSGBW" sorted by Priority Name, Priority #, Team, Patient Name^IEN^SSN
- +2 ; If not searching for specific priority:
- +3 ; - set patient into ^TMP("PSGVBW2" sorted by 'Patient Name^IEN^SSN', then Priority
- +4 ; - set patient into ^TMP("PSGVBW3" sorted by Patient IEN
- +5 IF $GET(PSGP(0))=""
- DO DEM^VADPT
- SET PSGP(0)=VADM(1)
- +6 SET PN=$PIECE(PSGP(0),"^")_U_PSGP_U_PSJPBID
- +7 if PSGSS="P"
- QUIT
- +8 IF $GET(PSGPRIF)
- SET ^TMP("PSGVBW",$JOB,WDN,PTPRI,TM,PN)=""
- QUIT
- +9 SET ^TMP("PSGVBW2",$JOB,PN,+$GET(PTPRI))=WDN_"^"_TM
- SET ^TMP("PSGVBW3",$JOB,+PSGP)=""
- +10 QUIT
- +11 ;
- SET2 ; If not searching for a specific priority,find the highest priority order associated with patient.
- +1 ; Set the patient into ^TMP("PSGVBW" sorted by highest Priority Name, Priority #, Team, Patient Name^IEN^SSN
- +2 SET SETPN=""
- FOR
- SET SETPN=$ORDER(^TMP("PSGVBW2",$JOB,SETPN))
- if SETPN=""
- QUIT
- Begin DoDot:1
- +3 SET PTPRI=$ORDER(^TMP("PSGVBW2",$JOB,SETPN,0))
- if '$GET(PTPRI)
- QUIT
- +4 SET SUBS=$GET(^TMP("PSGVBW2",$JOB,SETPN,PTPRI))
- SET SETWDN=$PIECE(SUBS,"^")
- SET SETTM=$PIECE(SUBS,"^",2)
- if SETWDN=""!(SETTM="")
- QUIT
- +5 SET ^TMP("PSGVBW",$JOB,SETWDN,PTPRI,SETTM,SETPN)=""
- End DoDot:1
- +6 KILL ^TMP("PSGVBW2",$JOB)
- +7 QUIT
- 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
- +9 ;
- GTPAC ; Prompt user for Package
- +1 IF ($GET(PSJRNF))&('$GET(PSJIRNF))&(PSJTOO=2)
- SET PSJPAC=1
- QUIT
- +2 IF ($GET(PSJIRNF))&('$GET(PSJRNF))&(PSJTOO=2)
- SET PSJPAC=2
- QUIT
- +3 WRITE !!,"1) Unit Dose Orders",!,"2) IV Orders",!
- +4 KILL DIR
- SET DIR(0)="LAO^1:2"
- SET DIR("A")="Select Package(s) (1-2): "
- SET DIR("?")="^D TOH^PSGVBW"
- WRITE !
- DO ^DIR
- +5 SET PSJPAC=$SELECT($LENGTH(Y)>2:3,1:$PIECE(Y,","))
- +6 QUIT
- EXIT(X) ; Generic user error message
- +1 WRITE !!,X," not selected, option terminated."
- +2 QUIT
- +3 ;
- TOH ; Help text
- +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