Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSJCLOR

PSJCLOR.m

Go to the documentation of this file.
PSJCLOR ;BIR/JCH - FIND ORDERS BY CLINIC, CLINIC GROUP, OR PATIENT ; 2/28/12 9:11am
 ;;5.0;INPATIENT MEDICATIONS;**275**;DEC 16, 1997;Build 157
 ;
 ; 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 clinic or patient, depending on value of PSGSS
 ; 
 N PSJTOO,PSJPAC,PSJBEG,PSJEND,PSGOEAV,PSJTMPED,PSJTMPBG,PSJCLOR,PSGSS S PSJTOO=3,PSJPAC=3,PSJCLOR=1,PSGSS=""
 D ENCV^PSGSETU I $D(XQUIT) K XQUIT Q
 D ^PSIVXU I $D(XQUIT) K XQUIT Q
 D NOW^%DTC S PSGDT=%
 K ^TMP("PSJ",$J) S PSGPXN=0 L +^PS(53.45,PSJSYSP):1 E  D LOCKERR^PSJOE G DONE
 S PSGSSH="VBW",PSGPXN=0,PSJPROT=$S($P(PSJSYSU,";",3)=3:3,1:1)
 S PSGVBWW="ACTIVE AND/OR NON-VERIFIED"
 S PSGOEAV=$P(PSJSYSP0,"^",9)&PSJSYSU
 F  Q:(PSGSS="^")  S PSJVALQ=0 Q:'$$DTRANGE  F  K ^TMP("PSJSELECT",$J) D SELECT Q:(PSGSS["^")!(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,X1,X2,PSJBEG,PSJEND
 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,PSGPRIN,PSGPRD,PSGINWD,PSGINCL,PRDON,PRDNS,PRD,PPN,ORDT
 K %,DTOUT,DUOUT,ND0,PSGSS2,PSGDT,PSJNV,PSJPBID,PSJPAD,%Y,IOP,POP,PSGDICA,PSGH,PSJEXTP,PSJH,PSJHDATE,PSJPAD
 K PSJPAGE,PSJPBID,PSJPCAF,PSJPDD,PSJPDOB,PSJPDX,PSJPPID,PSJPRB,PSJPSEX,PSJPSSN,PSJPTD,PSJPTS,PSJPTSP,PSJPWD,PSJPWDN
 K XQORNOD,XRT0,XRTL,XRTN,ZTSAVE,WRD,WS,TYPE,TMPSEL,TMPNEWSD,TMPDT,TMPCNT,TMPAT,SWD,STOP,STAST,SORT,SM,SEQ,SDW,SCH,RTE,RSLT,RNDT,QX,PSOC,PSJX,PSJVALQ
 K PSJTEAM,PSJPSTO,PSJPINIT,PSJORIFN,PSJORF,PSJORD,PSJONTMP,PSJOL,PSJOCL,PSJO,PSJNOO,PSJMSG,PSJLOOP,PSJLMX,PSJLACT,PSJIVORF,PSJHLMTN,PSJDB,PSJDAY,PSJCOUNT
 K PSJCLIN,PSJBLOOP,PSJBLN,PSJBCID,PSJACNWP,PSJ,PSIVUP,PSIVTYPE,PSIVSTRT,PSIVITE,PSIVRT,PSIVRP,PSIVREA,PSIVPR,PSIVPL,PSIVNOW,PSIVLN,PSIVLIM,PSIVC,PSIVACT
 K PSIVAC,PSGVALG,PSGVADR,PSGSTAT,PSGST,PSGSM,PSGSDN,PSGSCH,PSGS0XT,PSGPRN,PSGPR,PSGPENWS,PSGPEN,PSGPDN,PSGPD,PSGOSTN,PSGOST,PSGOSM,PSGOSI,PSGOSDN,PSGOSCH
 K PSGORD,PSGOPRN,PSGPR,PSGOPDN,PSGOPD,PSGOORD,PSGOMRN,PSGOMR,PSGOL,PSGOINST,PSGOHSM,PSGOFDN,PSGOEPR,PSGOEEWF,PSGOEENO,PSGOEE,PSGODO,PSGOC,PSGOAT,PSGNEFDO
 K PSGLRN,PSGLI,PSGFDX,PSGDFN,PSGF2,PSGEBN,PSGEB,PSGDW,PSGCANFL,PSGAL,PSBSTR,PSBFLAG,PSBCNT,P,PDRG,ORO,OD,OCXSEG,NF,NDP2,ND6,ND4,ND14
 L -^PS(53.45,PSJSYSP) G:$G(PSGPXN) ^PSGPER1 D ENKV^PSGSETU K ND,PSGPXN 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,PSJL,DFN,PSGP
 Q
 ;
GO ; Find and display matching patients
 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 SELECTED ",$S(PSGSS="P":"PATIENT",PSGSS="L":"CLINIC GROUP",PSGSS="C":"CLINIC",PSGSS="PR":"PRIORITY",1:"WARD"),$S(PSGSS="G":" GROUP",1:"") Q
 D ^PSJCLOR1,DONE2 Q
 ;
C ; Select a Clinic
 K CL,DIC,PSJCLNAR,PSJCDONE
 F  Q:$G(PSJCDONE)  K DIR S DIR(0)="FAO",DIR("A")="Select CLINIC: ",DIR("?")="^D ENCD^PSJCLOR" W ! D ^DIR S:$G(DUOUT) PSJCDONE=2 S:(Y="") PSJCDONE=1 D CDIC
 Q
CDIC ; Clinic lookup
 I $G(PSJCDONE) S:($O(PSJCLNAR(0))&'$G(DUOUT)) Y=+$O(PSJCLNAR(0)) Q
 S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC I Y>0 S CL=+Y,PSJCLNAR(+Y)=""
 I Y="" S PSJCDONE=1 Q
 I $G(DTOUT)!$G(DUTOUT) S PSJCDONE=1 Q
 W:X["?" !!,"Enter the clinic you want to use to select patients for processing.",!
 I '$G(DUOUT),($G(Y)<0),($G(X)'="") S X="?"
 I X["?" W !!,"Enter the name of the clinic to use to select patients for processing." G C
 Q:'$G(CL)
DTRANGE() ; Enter Date Range
 K PSJBEG,PSJEND
 D BEGDT I ($G(PSJBEG)<1) S Y=0 Q 0
 D ENDDT(PSJBEG) I ($G(PSJEND)<1) S Y=0 Q 0
 Q Y
BEGDT ; begin date
 W !!?5,"Search for Active and Non-Verified CLINIC Medication Orders"
 W !?5,"that fall within the date range selected below: "
 W ! K %DT S %DT("A")="Begin Search Date: ",%DT="TAE",%DT("B")="TODAY"
 D ^%DT Q:Y<0!($D(DTOUT))  S (%DT(0),PSJBEG,PSJTMPBG)=Y
 N YRONLY,FMTX S YRONLY=+$G(PSJBEG) I $L(YRONLY)=7 S:'$E(YRONLY,4,5) $E(YRONLY,4,5)="01" S:'$E(YRONLY,6,7) $E(YRONLY,6,7)="01" S PSJBEG=YRONLY S FMTX=$$FMTE^XLFDT(PSJBEG,1) W " ",FMTX
 Q
ENDDT(BEG) ; end date
 N YRONLY,FMTX
 W ! K DIR S DIR(0)="DA^"_BEG_"::TAE",DIR("A")="End Search Date: ",DIR("B")=$P($$FMTE^XLFDT(BEG,1),"@") D ^DIR
 S PSJEND=$S($G(Y):Y,1:BEG) I '$P(PSJEND,".",2) S PSJEND=Y_".24",PSJTMPED=PSJEND
 I '$E(PSJEND,4,7) S YRONLY=+$G(PSJEND) S:'$E(YRONLY,4,5) $E(YRONLY,4,5)="01" S:'$E(YRONLY,6,7) $E(YRONLY,6,7)="01" D
 .S PSJEND=YRONLY S FMTX=$$FMTE^XLFDT(PSJEND,1) W " ",FMTX
 Q
L ; Select a Clinic Group
 K DIR,PSJCLNAR 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
 I $G(CG) N TMPCNT,TMPCL S TMPCNT=0 F  S TMPCNT=$O(^PS(57.8,+CG,1,TMPCNT)) Q:'TMPCNT  S TMPCL=$G(^(TMPCNT,0)) I TMPCL S PSJCLNAR(TMPCL)=""
 I '$G(DUOUT),($G(Y)<0),($G(X)'="") S X="?"
 I X["?" W !!,"Enter the name of the clinic group to use to select patients for processing." G L
 Q
P ; Select patient
 N PSJCLNAR,STOPD,TMPSTRT,ON2,BEGDTR,ENDTR,PSJSTAT S (PSJBEG,BEGDTR)=$S($G(PSJBEG):PSJBEG,1:$$FMADD^XLFDT(PSGDT,-365)),(PSJEND,ENDTR)=$S($G(PSJEND):PSJEND,1:$$FMADD^XLFDT(PSGDT,365)) S PSJCLNAR=""
 K ^TMP("PSJSELECT",$J) S PSJCNT=1 F  D ^PSJP Q:PSGP<0  D
 .I $G(PSJTMPBG)&$G(PSJTMPED) S PSJBEG=+PSJTMPBG,PSJEND=+PSJTMPED K PSJTMPBG,PSJTMPED
 .S PSJNV=0 Q:$D(^TMP("PSJSELECT",$J,"C",PSGP))
 .NEW ON,XX S ON=0 F  S ON=$O(^PS(53.1,"AS","N",PSGP,ON)) Q:'ON!$G(PSJNV)  D
 ..N TMPSTRT,TMPSTP S TMPSTRT=$P($G(^PS(53.1,+ON,2)),"^",2) Q:(TMPSTRT>PSJEND)  S TMPSTP=$P($G(^PS(53.1,+ON,2)),"^",4) Q:(TMPSTP<PSJBEG)
 ..N ND S ND=$G(^PS(53.1,+ON,0)) Q:((",D,E,")[(","_($E($P(ND,"^",9)))_","))  S PSJNV=+$G(^PS(53.1,ON,"DSS"))
 .I 'PSJNV D ^PSJAC D
 ..I '$D(PSGDT) D NOW^%DTC S PSGDT=$E(%,1,12)
 ..S STOPD=PSGDT F  S STOPD=$O(^PS(55,"AUDC",STOPD)) Q:'STOPD!$G(PSJNV)  S CL=0 F  S CL=$O(^PS(55,"AUDC",STOPD,CL)) Q:'CL!$G(PSJNV)  S ON2=0 F  S ON2=$O(^PS(55,"AUDC",STOPD,CL,PSGP,ON2)) Q:'ON2!$G(PSJNV)  D
 ...N ND S ND=$G(^PS(55,PSGP,5,+ON2,0)) S TMPSTRT=$P($G(^PS(55,PSGP,5,+ON2,2)),"^",2) Q:(TMPSTRT>ENDTR)!'$P(^PS(55,PSGP,5,+ON2,8),"^",2)
 ...Q:((",D,E,")[(","_($E($P(ND,"^",9)))_","))  S ON=+$G(ON2)_"U" S PSJNV=CL
 ..S SD=$$FMADD^XLFDT(PSJBEG,,,-1) F  S SD=$O(^PS(55,PSGP,"IV","AIS",SD)) Q:'SD  D
 ...F ON=0:0 S ON=$O(^PS(55,PSGP,"IV","AIS",SD,ON)) Q:'ON  S PSJSTAT=$P($G(^PS(55,PSGP,"IV",ON,0)),"^",17) I (",E,D,")'[(","_$E(PSJSTAT)_",") D IFT2 Q
 .I PSJNV D ^PSJAC,SET S PN=$G(PSGP(0))_U_PSGP_U_PSJPBID S ^TMP("PSJSELECT",$J,PSJCNT)=PN,^TMP("PSJSELECT",$J,"B",$P(PN,U),PSJCNT)="",PSJCNT=PSJCNT+1,^TMP("PSJSELECT",$J,"C",+PSGP)="" Q
 .W !!?3,"No ",PSGVBWW," Clinic Orders found for this patient."
 S:$D(^TMP("PSJSELECT",$J)) Y=1
 I $G(PSJTMPBG)&$G(PSJTMPED) S PSJBEG=+PSJTMPBG,PSJEND=+PSJTMPED K PSJTMPBG,PSJTMPED
 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="ACTIVE AND/OR NON-VERIFIED" I PSGSS="P" D IF S:$T ^TMP("PSGVBW",$J)=$P(PSGP(0),"^")_"^"_PSGP Q
 G CL:PSGSS="C"
 G CG:PSGSS="L"
 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
 N BEGDTR,ENDTR,STOPD,ON2,TMPSTRT,TMPSTOP S BEGDTR=$$FMADD^XLFDT(PSJBEG,,-1),ENDTR=$$FMADD^XLFDT(PSJEND,,1)
 I PSGSS="C" D  Q
 .S CL="" F  S CL=$O(PSJCLNAR(CL)) Q:CL=""  D CL1 I $G(CL) N CLINAME S CLINAME=$P($G(^SC(+$G(CL),0)),"^") Q:CLINAME=""  D
 ..N I,J S (I,J)="" F  S I=$O(PSJCLNAR(I)) Q:'I  S J=J+1
 ..I (J>1),'$D(^TMP("PSGVBW",$J,CLINAME)) W !!,$C(7),"NO ",PSGVBWW," ORDERS FOR ",CLINAME,! D CONT^PSJOE0
 I PSGSS="L" D CL1
 Q
CL1 ; Check each clinic for valid clinic orders
 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
 S STOPD=PSGDT F  S STOPD=$O(^PS(55,"AUDC",STOPD)) Q:'STOPD  S PSGP=0 F  S PSGP=$O(^PS(55,"AUDC",STOPD,CL,PSGP)) Q:'PSGP  S ON2=0 F  S ON2=$O(^PS(55,"AUDC",STOPD,CL,PSGP,ON2)) Q:'ON2  D
 .S TMPSTRT=$P($G(^PS(55,PSGP,5,+ON2,2)),"^",2),TMPSTOP=$P($G(^PS(55,PSGP,5,+ON2,2)),"^",4)
 .I TMPSTRT<ENDTR,(TMPSTOP>BEGDTR) Q:$E($P($G(^PS(55,PSGP,5,+ON2,0)),"^",9))="D"  S ON=+$G(ON2)_"U" D ^PSJAC,SET
 S STOPD=PSGDT F  S STOPD=$O(^PS(55,"AIVC",STOPD)) Q:'STOPD  S PSGP=0 F  S PSGP=$O(^PS(55,"AIVC",STOPD,CL,PSGP)) Q:'PSGP  S ON2=0 F  S ON2=$O(^PS(55,"AIVC",STOPD,CL,PSGP,ON2)) Q:'ON2  D
 .S TMPSTRT=$P($G(^PS(55,PSGP,"IV",+ON2,0)),"^",2),TMPSTOP=$P($G(^PS(55,PSGP,"IV",+ON2,0)),"^",3)
 .I TMPSTRT<ENDTR,(TMPSTOP>BEGDTR) Q:$E($P($G(^PS(55,PSGP,"IV",+ON2,0)),"^",17))="D"  S ON=+$G(ON2)_"V" D ^PSJAC,SET
 K PSGCLF,TMPSTRT
 Q
IF ; If called from CL subroutine and the order Doesn't exist for that Clinic, then QUIT.
 N PSJSTAT,ON2
 I $D(^PS(53.1,"AS","N",PSGP)) NEW XX S XX=0 S ON2=0 F  S ON2=$O(^PS(53.1,"AS","N",PSGP,ON2)) Q:'ON2  N CLIN S CLIN=+$G(^PS(53.1,+$G(ON2),"DSS")) Q:'CLIN   D
 .S XX=$S(PSGSS'="P"&$D(PSJCLNAR(+CLIN)):CLIN,1:CLIN) S ND=$P($G(^PS(53.1,ON2,0)),U,4),TMPSTRT=$P($G(^PS(53.1,ON2,2)),U,2),TMPSTP=$P($G(^PS(53.1,ON2,2)),U,4) I $G(XX) D
 ..Q:TMPSTRT>$S($G(ENDTR):ENDTR,1:$G(PSJEND))  Q:TMPSTP<$S($G(BEGDTR):BEGDTR,1:$G(PSJBEG))
 ..S PSJSTAT=$P($G(^PS(53.1,ON2,0)),"^",9) Q:PSJSTAT'="N"
 ..N ON S ON=ON2_"P" D ^PSJAC,SET
 S PSGODT=$P(PSJBEG,".")
 I PSJPAC'=2 F ST="C","O","OC","P","R" S SD=PSGODT F  S SD=$O(^PS(55,PSGP,5,"AU",ST,SD)) Q:'SD  S ON2=0 F  S ON2=$O(^PS(55,PSGP,5,"AU",ST,SD,ON2)) Q:'ON2  S PSJSTAT=$P($G(^PS(55,PSGP,5,ON2,0)),"^",9) D
 .I (PSJSTAT]"")&((",D,E,"'[(","_$E(PSJSTAT)_","))) S ON=ON2_"U" D SET
 ;*PSJ*5*241:Expired IV orders must be one-time
 I PSJPAC'=1 S SD=$$FMADD^XLFDT(PSJBEG,,,-1) F  S SD=$O(^PS(55,PSGP,"IV","AIS",SD)) Q:'SD  S ON2=0 F  S ON2=$O(^PS(55,PSGP,"IV","AIS",SD,ON2)) Q:'ON2  D
 .N SCH,STYPE S STYPE=0,SCH=$P($G(^PS(55,PSGP,"IV",ON2,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)
 .S PSJSTAT=$P($G(^PS(55,PSGP,"IV",+ON2,0)),"^",17)
 .I ",D,E,"'[(","_$E(PSJSTAT)_",") I ($G(STYPE)'="O") S ON=ON2_"V" D IFT2,SET
 K TMPSTRT
 Q
IFT2 ; Loop through active IV orders in ^PS(55
 N CL,TMPSTRT,TMPSTP S CL=+$G(^PS(55,+$G(PSGP),"IV",+$G(ON),"DSS"))
 S ND0=$G(^PS(55,PSGP,"IV",+ON,0)) S TMPSTRT=$P(ND0,"^",2),TMPSTP=$P(ND0,"^",3) Q:((TMPSTRT>PSJEND)!(TMPSTP<PSJBEG))
 Q:((",D,E,")[(","_($E($P(ND0,"^",17)))_","))
 S PSJNV=CL
 Q
SET ; Set patient specific variables for ^TMP subscripts
 K DIC,X,Y,WDNAME,TMPWD
 N PSJSTAT,TMPSTRT,TMPSTP S TMPSTRT=$S($G(ON)["P":$P($G(^PS(53.1,ON,2)),U,2),$G(ON)["U":$P($G(^PS(55,PSGP,5,+ON,2)),"^",2),$G(ON)["V":$P($G(^PS(55,PSGP,"IV",+ON,0)),"^",2),1:"")
 S TMPSTP=$S($G(ON)["P":$P($G(^PS(53.1,+ON,2)),U,4),$G(ON)["U":$P($G(^PS(55,PSGP,5,+ON,2)),"^",4),$G(ON)["V":$P($G(^PS(55,PSGP,"IV",+ON,0)),"^",3),1:"")
 Q:TMPSTRT>$S($G(ENDTR):ENDTR,1:$G(PSJEND))  Q:TMPSTP<$S($G(BEGDTR):BEGDTR,1:$G(PSJBEG))
 S PSJSTAT=$S($G(ON)["P":$P($G(^PS(53.1,+ON,0)),"^",9),$G(ON)["U":$P($G(^PS(55,PSGP,5,+ON,0)),"^",9),$G(ON)["V":$P($G(^PS(55,PSGP,"IV",+ON,0)),"^",17),1:"")
 Q:PSJSTAT=""  Q:(",D,E,")[(","_$E(PSJSTAT)_",")
 S X=$S($G(ON)["P":$G(^PS(53.1,+ON,"DSS")),$G(ON)["U":$G(^PS(55,PSGP,5,+ON,8)),$G(ON)["V":$G(^PS(55,PSGP,"IV",+ON,"DSS")),1:"")
 Q:'X  Q:'$P(X,"^",2)  S X=+X
 S X="`"_+X,DIC="^SC(",DIC(0)="BOXZ" D ^DIC S TMPWD=+Y,(WDN,WDNAME)=$P(Y,"^",2)
 I $G(PSGSS)'="P",$G(TMPWD),'$D(PSJCLNAR(+TMPWD)) Q
 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 Clnic, Patient Name^IEN^SSN
 ; If not searching for specific priority:
 ;            - set patient into ^TMP("PSGVBW2" sorted by 'Patient Name^IEN^SSN',
 ;            - set patient into ^TMP("PSGVBW3" sorted by Patient IEN
 S PN=$P(PSGP(0),"^")_U_PSGP_U_PSJPBID
 S ^TMP("PSGVBW",$J,WDN,1,TM,PN)=$S($G(TMPWD):TMPWD,1:"")
 S ^TMP("PSGVBW2",$J,PN,1)=WDN_"^"_TM,^TMP("PSGVBW3",$J,WDN,+PSGP)=TMPWD
 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,1,SETTM,SETPN)=""
 K ^TMP("PSGVBW2",$J)
 Q
 ;
EXIT(X) ; Generic user error message
 W !!,X," not selected, option terminated."
 Q
 ;
SELECT ; give user choice to select search method
 S PSJVALQ=0
 S:'$D(PSGSSH) PSGSSH="GENERIC"
 ;
 N PSJCLNAR
 F  W !!,"Search by CLINIC (C), CLINIC GROUP (G), or PATIENT (P) : " R PSGSS:DTIME W:'$T $C(7) S:'$T!(PSGSS="") PSGSS="^" Q:"^"[PSGSS  D CHK I ",C,P,L,"[(","_PSGSS_",") Q
 ;
 K PSGSSA Q
 ;
CHK ;
 N Q
 S PSGSSA="" F Q=1:1:$L(PSGSS) S PSGSSA=PSGSSA_$S($E(PSGSS,Q)'?1L:$E(PSGSS,Q),1:$C($A(PSGSS,Q)-32))
 F X="CLINIC","PATIENT","GROUP" I $P(X,PSGSSA)="" W $P(X,PSGSSA,2,99) S PSGSS=$S(($E(PSGSSA)="G"):"L",1:$E(PSGSSA)) Q
 Q:$T  I PSGSS'?1."?" W $C(7),"  ??" S PSGSS="Z" Q
 W ! D @PSGSSH W !!?2,"To leave this option, press the RETURN key or enter '^'." Q
 ;
CHK2 ;
 N Q
 S PSGSSA="" F Q=1:1:$L(PSGSS2) S PSGSSA=PSGSSA_$S($E(PSGSS2,Q)'?1L:$E(PSGSS2,Q),1:$C($A(PSGSS2,Q)-32))
 F X="WARD","CLINIC","GROUP" I $P(X,PSGSSA)="" W $P(X,PSGSSA,2,99) S PSGSS2=$S(($E(PSGSSA)="G"):"L",1:$E(PSGSSA)) Q
 Q:$T  I PSGSS2'?1."?" W $C(7),"  ??" S PSGSS2="Z" Q
 W ! D @PSGSSH W !!?2,"To leave this option, press the RETURN key or enter  '^'." Q
 ;
HELP ; the following are the help text messages for the various options
 ;
GENERIC W !!,?2,"To run this option for an entire CLINIC, enter 'C'.  To run this option for a single PATIENT, enter 'P'." Q
 ;
VBW W !!?2,"To process orders in a single CLINIC, enter 'C'."
 W !,"To process orders for a single PATIENT, enter 'P'."
 Q
 ;
ENCD ;edit Clinic Definitions file
 I X["?" W !,"Enter a clinic from the CLINIC DEFINITION file."
 K DIC S DIC="^PS(53.46,",DIC(0)="QEMIZ" D ^DIC K DIC ; S:(Y>0) Y=+$G(^PS(53.46,+Y,0))
 W !,"You may also select a clinic from the HOSPITAL LOCATION file."
 K DIC S DIC="^SC(",DIC(0)="QEMIZ" D ^DIC K DIC
 Q