PSGVBW0 ;BIR/CML3,MV-SHOW NON-VERFIED ORDERS GATHERED IN PSGVBW ;29-May-2012 11:03;PLS
;;5.0; INPATIENT MEDICATIONS ;**29,39,53,56,95,80,1014,110,127,124,1015**;16 DEC 97;Build 62
;
; Reference to ^PSSLOCK is supported by DBIA #2789
; Reference to ^DIR is supported by DBIA 10026
; Reference to ^VALM is supported by DBIA 10118
;
; Modified - IHS/MSC/PLS - 05/29/2012 - Line PROCESS1+2
START ;
S (LINE,PSGOEA,PSGOEAV)="",$P(LINE,"-",81)="" S PSGPXN=$G(PSGPXN)
K ^TMP("PSJLIST",$J) D:PSGSS'="P" DISPLAYW Q:'$O(^TMP("PSJSELECT",$J,0))
PROCESS ; Loop through selected patients and display profile/orders.
K DIR,PSJPNV S PSJPNV=1
I $P(PSJSYSU,";")=3 S X=$O(^TMP("PSJSELECT",$J,1)),DIR(0)="Y",DIR("A")="Do you want to print a profile for the"_$S(X:"se",1:"")_" patient"_$S(X:"s",1:""),DIR("B")="NO" D
.D ^DIR K DIR I Y D ^PSJHVARS,^PSGVBWP,RESTORE^PSJHVARS
.W !!,"Select profile type for order processing.",!!
D ENL^PSGOU Q:"SNL"'[PSGOL
F PSJCNT=0:0 S PSJCNT=$O(^TMP("PSJSELECT",$J,PSJCNT)) Q:'PSJCNT D PROCESS1 S PSGOP=PSGP D ENQL^PSGLW:$P(PSJSYSL,"^",2)]"" Q:$G(PSJGOTO)="E" I $D(^TMP("PSJSELECT",$J,+$G(PSJGOTO))) S PSJCNT=PSJGOTO-1
Q
PROCESS1 ;
S PSJPN=$G(^TMP("PSJSELECT",$J,PSJCNT)) K PSJGOTO
D SETPTCX^APSPFUNC($P(PSJPN,U,2)) ;IHS/MSC/PLS - 05/29/2012
S PSJLK=$$L^PSSLOCK($P(PSJPN,U,2),1) I 'PSJLK W !,$C(7),$P(PSJLK,U,2) Q
K PSJGOTO D:PSJPN]"" GTORDERS
I PSJLK D UL^PSSLOCK($P(PSJPN,U,2))
I $G(PSGPXN),$$DEFON^PSGPER1 D K PSGPXPT S PSGPXN=0
.S PSGPXPT=PSGP
.N DFN,PSGP S (PSGP,DFN)=PSGPXPT D ^PSGPER,ENCV^PSGSETU,^PSIVXU
S PSGPXN=$G(PSGPXN)
Q
;
DISPLAYW ; Allow selection of patients on each ward selected.
K ^TMP("PSJSELECT",$J) S PSJCNT=1,PSGVBWN="" F S PSGVBWN=$O(^TMP("PSGVBW",$J,PSGVBWN)) Q:PSGVBWN="" D DISPLAYT
Q
;
DISPLAYT ;
NEW PSGPICK ;PSGPICK=1-->user selected order, stop display the profile
D HEADER S PSGVBTM="",PSGVBY=0 F S PSGVBTM=$O(^TMP("PSGVBW",$J,PSGVBWN,PSGVBTM)) Q:(PSGVBTM=""!$G(PSGPICK)) D V2
I PSJASK,(PSGVBY>0) D ASK
Q
;
GTORDERS ;
S (PSGP,DFN)=$P(PSJPN,U,2) K PSJACNWP D ^PSJAC
I PSGOL'="N" D PROFILE Q
D ENGORD^PSGVBWU
S PSJPRIO="" F S PSJPRIO=$O(^TMP("PSJON",$J,PSJPRIO)) Q:PSJPRIO="" S PSJON="" D
. F S PSJON=$O(^TMP("PSJON",$J,PSJPRIO,PSJON)) Q:PSJON="" D
.. I $P(PSJON,U,2)=+$P(PSJON,U,2) Q:'$$LOCK^PSJOEA(DFN,$P(PSJON,U,2)) D GTORDER2 Q
.. I '$$LS^PSSLOCK(DFN,$P(PSJON,U,2)) D DISPORD(DFN,$P(PSJON,U,2)) Q
.. D DISACTIO^PSJOE(DFN,$P(PSJON,U,2),1) Q:$D(PSJGOTO) D UNL^PSSLOCK(DFN,$P(PSJON,U,2))
Q
;
GTORDER2 ;
N PSJO S PSJO=0 F S PSJO=$O(^PS(53.1,"ACX",$P(PSJON,U,2),PSJO)) Q:'PSJO D
.D DISACTIO^PSJOE(DFN,PSJO_"P",1) Q:$D(PSJGOTO)
I $D(^TMP("PSJCOM",$J)) N PSJORD S PSJORD=$P(PSJON,U,2) D CHK^PSJOEA1
N PSJO S PSJO=0 F S PSJO=$O(^PS(53.1,"ACX",$P(PSJON,U,2),PSJO)) Q:'PSJO D
.D UNL^PSSLOCK(DFN,PSJO_"P") Q:$G(Y)<0
Q
;
PROFILE ; Display the patient's profile and allow order selection.
S PSGP=DFN,PSJOL=PSGOL F D EN^VALM("PSJ LM PNV") Q:'$G(PSJORD)&'$G(PSJNEWOE) S PSJNEWOE=0
Q
;
DONE ;
K ^TMP("PSGVBW",$J),^TMP("PSJON",$J)
K CF,DA,LINE,NP,POP,PPN,PR,PSGCANFL,PSGION,PSGOL,PSGOEAV,PSGOENOF,PSGON,PSGONC,PSGONR,PSGLMT,PSGORD,PSGPRF,PSGVBA,PSGVBAF,PSGVBON,PSGVBPN,PSGVBQ,PSGVBQ1,PSGVBSD,PSGVBSS,PSGVBST,PSGVBTM,PSGVBW,PSGVBWN,PSGVBY,QQ,Z
Q
;
V2 ;
S PSGVBPN="" F S PSGVBPN=$O(^TMP("PSGVBW",$J,PSGVBWN,PSGVBTM,PSGVBPN)) Q:(PSGVBPN=""!$G(PSGPICK)) S PSGP=$P(PSGVBPN,"^",2),PPN=$P(PSGVBPN,"^") S:PPN="" PPN=PSGP_";DPT(" D WRT
Q
;
WRT ;
S PSGVBY=PSGVBY+1,PSJASK=1
W !,$J(PSGVBY,4),?6,$S(PSGVBTM'="zz":PSGVBTM,1:"Not Found"),?27,PPN," (",$P(PSGVBPN,U,3),")" S ^TMP("PSJLIST",$J,PSGVBY)=PSGVBWN_U_PSGVBTM_U_PPN_U_PSGP
I $Y+1>IOSL,(PSGVBY>0) NEW DIR S DIR(0)="EA",DIR("A")=" '^' TO QUIT " D ^DIR D
. I X="^" S PSGPICK=1 Q
. S PSJASK=0 W @IOF
Q
;
ASK ;
N DIR,PSGDFN,PSGASKX S DIR(0)="LOA^1:"_PSGVBY,DIR("A")="Select 1 - "_PSGVBY_": " D ^DIR I $D(DUOUT)!$D(DTOUT) K ^TMP("PSGVBW",$J) Q
S:Y]"" PSGPICK=1
F PSJINDEX=1:1:$L(Y,",")-1 D
. S PSGASKX=$G(^TMP("PSJLIST",$J,$P(Y,",",PSJINDEX))),PSGDFN=$P(PSGASKX,"^",4)_"^"_$P(PSGASKX,"^",3)
. D CHK^PSJDPT(.PSGDFN,1) I PSGDFN=-1 Q
. S:PSGASKX]"" ^TMP("PSJSELECT",$J,PSJCNT)=$P(PSGASKX,U,3,4),^TMP("PSJSELECT",$J,"B",$P(PSGASKX,U,3),PSJCNT)="",PSJCNT=PSJCNT+1
Q
;
H2 ;
W !!?2,"Select patients either singularly separated by commas (1,2,3), by a range of",!,"patients separated by a dash (1-3), or a combination (1,2,4-6). To select all",!,"patients, enter 'ALL' or a dash ('-'). You can also enter '-n' to"
W " select the",!,"first patient through the 'nth' patient or enter 'n-' to select the 'nth'",!,"patient through the last patient. If a patient is selected more than once,"
W !,"only the first selection is used. (Entering '1,2,1' would return '1,2'.)" Q
;
W:$Y @IOF W !,"ORDERS NOT VERIFIED BY A ",$S($P(PSJSYSU,";",3)>1:"PHARMACIST",1:"NURSE")," - ",$S(PSGVBWN="ZZ":"^OTHER",1:PSGVBWN)
W !!," No.",?7,"TEAM",?32,"PATIENT",!,LINE K PSGVBY S PSGVBY=0 Q
Q
;
NP ;
W $C(7) R !!,"ENTER AN '^' TO SELECT ORDERS NOW, OR PRESS THE RETURN KEY TO CONTINUE. ",NP:DTIME E S NP="^"
Q
DISPORD(DFN,ON) ;Display the order that being lock by another user
NEW PSJLINE,PSJOC,X
S PSJLINE=1
D DSPLORDU^PSJLMUT1(DFN,ON)
W ! F X=0:0 S X=$O(PSJOC(ON,X)) Q:'X W !,PSJOC(ON,X)
Q
PSGVBW0 ;BIR/CML3,MV-SHOW NON-VERFIED ORDERS GATHERED IN PSGVBW ;29-May-2012 11:03;PLS
+1 ;;5.0; INPATIENT MEDICATIONS ;**29,39,53,56,95,80,1014,110,127,124,1015**;16 DEC 97;Build 62
+2 ;
+3 ; Reference to ^PSSLOCK is supported by DBIA #2789
+4 ; Reference to ^DIR is supported by DBIA 10026
+5 ; Reference to ^VALM is supported by DBIA 10118
+6 ;
+7 ; Modified - IHS/MSC/PLS - 05/29/2012 - Line PROCESS1+2
START ;
+1 SET (LINE,PSGOEA,PSGOEAV)=""
SET $PIECE(LINE,"-",81)=""
SET PSGPXN=$GET(PSGPXN)
+2 KILL ^TMP("PSJLIST",$JOB)
IF PSGSS'="P"
DO DISPLAYW
IF '$ORDER(^TMP("PSJSELECT",$JOB,0))
QUIT
PROCESS ; Loop through selected patients and display profile/orders.
+1 KILL DIR,PSJPNV
SET PSJPNV=1
+2 IF $PIECE(PSJSYSU,";")=3
SET X=$ORDER(^TMP("PSJSELECT",$JOB,1))
SET DIR(0)="Y"
SET DIR("A")="Do you want to print a profile for the"_$SELECT(X:"se",1:"")_" patient"_$SELECT(X:"s",1:"")
SET DIR("B")="NO"
Begin DoDot:1
+3 DO ^DIR
KILL DIR
IF Y
DO ^PSJHVARS
DO ^PSGVBWP
DO RESTORE^PSJHVARS
+4 WRITE !!,"Select profile type for order processing.",!!
End DoDot:1
+5 DO ENL^PSGOU
IF "SNL"'[PSGOL
QUIT
+6 FOR PSJCNT=0:0
SET PSJCNT=$ORDER(^TMP("PSJSELECT",$JOB,PSJCNT))
IF 'PSJCNT
QUIT
DO PROCESS1
SET PSGOP=PSGP
IF $PIECE(PSJSYSL,"^",2)]""
DO ENQL^PSGLW
IF $GET(PSJGOTO)="E"
QUIT
IF $DATA(^TMP("PSJSELECT",$JOB,+$GET(PSJGOTO)))
SET PSJCNT=PSJGOTO-1
+7 QUIT
PROCESS1 ;
+1 SET PSJPN=$GET(^TMP("PSJSELECT",$JOB,PSJCNT))
KILL PSJGOTO
+2 ;IHS/MSC/PLS - 05/29/2012
DO SETPTCX^APSPFUNC($PIECE(PSJPN,U,2))
+3 SET PSJLK=$$L^PSSLOCK($PIECE(PSJPN,U,2),1)
IF 'PSJLK
WRITE !,$CHAR(7),$PIECE(PSJLK,U,2)
QUIT
+4 KILL PSJGOTO
IF PSJPN]""
DO GTORDERS
+5 IF PSJLK
DO UL^PSSLOCK($PIECE(PSJPN,U,2))
+6 IF $GET(PSGPXN)
IF $$DEFON^PSGPER1
Begin DoDot:1
+7 SET PSGPXPT=PSGP
+8 NEW DFN,PSGP
SET (PSGP,DFN)=PSGPXPT
DO ^PSGPER
DO ENCV^PSGSETU
DO ^PSIVXU
End DoDot:1
KILL PSGPXPT
SET PSGPXN=0
+9 SET PSGPXN=$GET(PSGPXN)
+10 QUIT
+11 ;
DISPLAYW ; Allow selection of patients on each ward selected.
+1 KILL ^TMP("PSJSELECT",$JOB)
SET PSJCNT=1
SET PSGVBWN=""
FOR
SET PSGVBWN=$ORDER(^TMP("PSGVBW",$JOB,PSGVBWN))
IF PSGVBWN=""
QUIT
DO DISPLAYT
+2 QUIT
+3 ;
DISPLAYT ;
+1 ;PSGPICK=1-->user selected order, stop display the profile
NEW PSGPICK
+2 DO HEADER
SET PSGVBTM=""
SET PSGVBY=0
FOR
SET PSGVBTM=$ORDER(^TMP("PSGVBW",$JOB,PSGVBWN,PSGVBTM))
IF (PSGVBTM=""!$GET(PSGPICK))
QUIT
DO V2
+3 IF PSJASK
IF (PSGVBY>0)
DO ASK
+4 QUIT
+5 ;
GTORDERS ;
+1 SET (PSGP,DFN)=$PIECE(PSJPN,U,2)
KILL PSJACNWP
DO ^PSJAC
+2 IF PSGOL'="N"
DO PROFILE
QUIT
+3 DO ENGORD^PSGVBWU
+4 SET PSJPRIO=""
FOR
SET PSJPRIO=$ORDER(^TMP("PSJON",$JOB,PSJPRIO))
IF PSJPRIO=""
QUIT
SET PSJON=""
Begin DoDot:1
+5 FOR
SET PSJON=$ORDER(^TMP("PSJON",$JOB,PSJPRIO,PSJON))
IF PSJON=""
QUIT
Begin DoDot:2
+6 IF $PIECE(PSJON,U,2)=+$PIECE(PSJON,U,2)
IF '$$LOCK^PSJOEA(DFN,$PIECE(PSJON,U,2))
QUIT
DO GTORDER2
QUIT
+7 IF '$$LS^PSSLOCK(DFN,$PIECE(PSJON,U,2))
DO DISPORD(DFN,$PIECE(PSJON,U,2))
QUIT
+8 DO DISACTIO^PSJOE(DFN,$PIECE(PSJON,U,2),1)
IF $DATA(PSJGOTO)
QUIT
DO UNL^PSSLOCK(DFN,$PIECE(PSJON,U,2))
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
GTORDER2 ;
+1 NEW PSJO
SET PSJO=0
FOR
SET PSJO=$ORDER(^PS(53.1,"ACX",$PIECE(PSJON,U,2),PSJO))
IF 'PSJO
QUIT
Begin DoDot:1
+2 DO DISACTIO^PSJOE(DFN,PSJO_"P",1)
IF $DATA(PSJGOTO)
QUIT
End DoDot:1
+3 IF $DATA(^TMP("PSJCOM",$JOB))
NEW PSJORD
SET PSJORD=$PIECE(PSJON,U,2)
DO CHK^PSJOEA1
+4 NEW PSJO
SET PSJO=0
FOR
SET PSJO=$ORDER(^PS(53.1,"ACX",$PIECE(PSJON,U,2),PSJO))
IF 'PSJO
QUIT
Begin DoDot:1
+5 DO UNL^PSSLOCK(DFN,PSJO_"P")
IF $GET(Y)<0
QUIT
End DoDot:1
+6 QUIT
+7 ;
PROFILE ; Display the patient's profile and allow order selection.
+1 SET PSGP=DFN
SET PSJOL=PSGOL
FOR
DO EN^VALM("PSJ LM PNV")
IF '$GET(PSJORD)&'$GET(PSJNEWOE)
QUIT
SET PSJNEWOE=0
+2 QUIT
+3 ;
DONE ;
+1 KILL ^TMP("PSGVBW",$JOB),^TMP("PSJON",$JOB)
+2 KILL CF,DA,LINE,NP,POP,PPN,PR,PSGCANFL,PSGION,PSGOL,PSGOEAV,PSGOENOF,PSGON,PSGONC,PSGONR,PSGLMT,PSGORD,PSGPRF,PSGVBA,PSGVBAF,PSGVBON,PSGVBPN,PSGVBQ,PSGVBQ1,PSGVBSD,PSGVBSS,PSGVBST,PSGVBTM,PSGVBW,PSGVBWN,PSGVBY,QQ,Z
+3 QUIT
+4 ;
V2 ;
+1 SET PSGVBPN=""
FOR
SET PSGVBPN=$ORDER(^TMP("PSGVBW",$JOB,PSGVBWN,PSGVBTM,PSGVBPN))
IF (PSGVBPN=""!$GET(PSGPICK))
QUIT
SET PSGP=$PIECE(PSGVBPN,"^",2)
SET PPN=$PIECE(PSGVBPN,"^")
IF PPN=""
SET PPN=PSGP_";DPT("
DO WRT
+2 QUIT
+3 ;
WRT ;
+1 SET PSGVBY=PSGVBY+1
SET PSJASK=1
+2 WRITE !,$JUSTIFY(PSGVBY,4),?6,$SELECT(PSGVBTM'="zz":PSGVBTM,1:"Not Found"),?27,PPN," (",$PIECE(PSGVBPN,U,3),")"
SET ^TMP("PSJLIST",$JOB,PSGVBY)=PSGVBWN_U_PSGVBTM_U_PPN_U_PSGP
+3 IF $Y+1>IOSL
IF (PSGVBY>0)
NEW DIR
SET DIR(0)="EA"
SET DIR("A")=" '^' TO QUIT "
DO ^DIR
Begin DoDot:1
+4 IF X="^"
SET PSGPICK=1
QUIT
+5 SET PSJASK=0
WRITE @IOF
End DoDot:1
+6 QUIT
+7 ;
ASK ;
+1 NEW DIR,PSGDFN,PSGASKX
SET DIR(0)="LOA^1:"_PSGVBY
SET DIR("A")="Select 1 - "_PSGVBY_": "
DO ^DIR
IF $DATA(DUOUT)!$DATA(DTOUT)
KILL ^TMP("PSGVBW",$JOB)
QUIT
+2 IF Y]""
SET PSGPICK=1
+3 FOR PSJINDEX=1:1:$LENGTH(Y,",")-1
Begin DoDot:1
+4 SET PSGASKX=$GET(^TMP("PSJLIST",$JOB,$PIECE(Y,",",PSJINDEX)))
SET PSGDFN=$PIECE(PSGASKX,"^",4)_"^"_$PIECE(PSGASKX,"^",3)
+5 DO CHK^PSJDPT(.PSGDFN,1)
IF PSGDFN=-1
QUIT
+6 IF PSGASKX]""
SET ^TMP("PSJSELECT",$JOB,PSJCNT)=$PIECE(PSGASKX,U,3,4)
SET ^TMP("PSJSELECT",$JOB,"B",$PIECE(PSGASKX,U,3),PSJCNT)=""
SET PSJCNT=PSJCNT+1
End DoDot:1
+7 QUIT
+8 ;
H2 ;
+1 WRITE !!?2,"Select patients either singularly separated by commas (1,2,3), by a range of",!,"patients separated by a dash (1-3), or a combination (1,2,4-6). To select all",!,"patients, enter 'ALL' or a dash ('-'). You can also enter '-n' to"
+2 WRITE " select the",!,"first patient through the 'nth' patient or enter 'n-' to select the 'nth'",!,"patient through the last patient. If a patient is selected more than once,"
+3 WRITE !,"only the first selection is used. (Entering '1,2,1' would return '1,2'.)"
QUIT
+4 ;
+1 IF $Y
WRITE @IOF
WRITE !,"ORDERS NOT VERIFIED BY A ",$SELECT($PIECE(PSJSYSU,";",3)>1:"PHARMACIST",1:"NURSE")," - ",$SELECT(PSGVBWN="ZZ":"^OTHER",1:PSGVBWN)
+2 WRITE !!," No.",?7,"TEAM",?32,"PATIENT",!,LINE
KILL PSGVBY
SET PSGVBY=0
QUIT
+3 QUIT
+4 ;
NP ;
+1 WRITE $CHAR(7)
READ !!,"ENTER AN '^' TO SELECT ORDERS NOW, OR PRESS THE RETURN KEY TO CONTINUE. ",NP:DTIME
IF '$TEST
SET NP="^"
+2 QUIT
DISPORD(DFN,ON) ;Display the order that being lock by another user
+1 NEW PSJLINE,PSJOC,X
+2 SET PSJLINE=1
+3 DO DSPLORDU^PSJLMUT1(DFN,ON)
+4 WRITE !
FOR X=0:0
SET X=$ORDER(PSJOC(ON,X))
IF 'X
QUIT
WRITE !,PSJOC(ON,X)
+5 QUIT
