PSGVBW0 ;BIR/CML3,MV - SHOW NON-VERFIED ORDERS GATHERED IN PSGVBW ;09/17/97 1:41 PM
;;5.0;INPATIENT MEDICATIONS;**29,39,53,56,95,80,110,127,124,243,304**;DEC 16, 1997;Build 22
;
; Reference to ^PSSLOCK is supported by DBIA #2789
; Reference to ^DIR is supported by DBIA 10026
; Reference to ^VALM is supported by DBIA 10118
;
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
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,PSGWORP1="" F S PSGWORP1=$O(^TMP("PSGVBW",$J,PSGWORP1)) Q:PSGWORP1="" D DISPLAYP
Q
;
DISPLAYP ; Display WORP1 (Ward or Priority)
N PSGPICK
S PSGVBWN=PSGWORP1
D HEADER
S PSGWORP2="" F S PSGWORP2=$O(^TMP("PSGVBW",$J,PSGWORP1,PSGWORP2)) Q:PSGWORP2="" S PSGPRIN=PSGWORP2 D DISPLAYT
I $G(PSJASK),(PSGVBY>0) D ASK
Q
;
DISPLAYT ;
;NEW PSGPICK ;PSGPICK=1-->user selected order, stop display the profile
S PSGPRIN=PSGWORP2
S:$G(PSGPRIF) PSGVBWN=PSGWORP2,PSGPRIN=PSGWORP1
S PSGVBTM="" F S PSGVBTM=$O(^TMP("PSGVBW",$J,PSGWORP1,PSGWORP2,PSGVBTM)) Q:(PSGVBTM=""!$G(PSGPICK)) D V2
I $G(PSJPRIF),$G(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 PSGWORP1,PSGWORP2,CF,DA,LINE,NP,POP,PPN,PR,PSGCANFL,PSGION,PSGOL,PSGOEAV,PSGOENOF,PSGON,PSGONC,PSGONR,PSGLMT,PSGPRIF
K PSGORD,PSGPRF,PSGVBA,PSGVBAF,PSGVBON,PSGVBPN,PSGVBQ,PSGVBQ1,PSGVBSD,PSGVBSS,PSGVBST,PSGVBTM,PSGVBW,PSGVBWN,PSGVBY,QQ,Z
K LIDT,ND,ORDT,PPN,PRD,PRDNS,PSGINCL,PSGINWD,PSGODT,PSGOEA,PSGOEAV,PSGP,PSGPRD,PSGPRIN,PSGPTMP,PSGSS,PSGVBPN,PSGVBTM,PSGVBWN
Q
;
V2 ;
S PSGVBPN="" F S PSGVBPN=$O(^TMP("PSGVBW",$J,PSGWORP1,PSGWORP2,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
S PSGVBWN=PSGWORP1,PSGPRD=PSGWORP2
W !,$J(PSGVBY,4),?6,$S(PSGVBTM'="zz":PSGVBTM,1:"Not Found"),?25,$S(PSGPRD="zz":"Not Found",PSGPRD=1:"STAT",PSGPRD=2:"ASAP",PSGPRD=3:"ROUTINE",1:PSGPRD),?38,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
. 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")," - "
I $G(PSGPRIF) W $S(PRD=1:"STAT",PRD=2:"ASAP",1:"ROUTINE")
I '$G(PSGPRIF) W $S(PSGVBWN="ZZ":"^OTHER",1:PSGVBWN)
W !!," No.",?7,"TEAM",?25,"PRIORITY",?38,"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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGVBW0 5961 printed Sep 11, 2024@02:23:28 Page 2
PSGVBW0 ;BIR/CML3,MV - SHOW NON-VERFIED ORDERS GATHERED IN PSGVBW ;09/17/97 1:41 PM
+1 ;;5.0;INPATIENT MEDICATIONS;**29,39,53,56,95,80,110,127,124,243,304**;DEC 16, 1997;Build 22
+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 ;
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 SET PSJLK=$$L^PSSLOCK($PIECE(PSJPN,U,2),1)
IF 'PSJLK
WRITE !,$CHAR(7),$PIECE(PSJLK,U,2)
QUIT
+3 KILL PSJGOTO
if PSJPN]""
DO GTORDERS
+4 IF PSJLK
DO UL^PSSLOCK($PIECE(PSJPN,U,2))
+5 IF $GET(PSGPXN)
IF $$DEFON^PSGPER1
Begin DoDot:1
+6 SET PSGPXPT=PSGP
+7 NEW DFN,PSGP
SET (PSGP,DFN)=PSGPXPT
DO ^PSGPER
DO ENCV^PSGSETU
DO ^PSIVXU
End DoDot:1
KILL PSGPXPT
SET PSGPXN=0
+8 SET PSGPXN=$GET(PSGPXN)
+9 QUIT
+10 ;
DISPLAYW ; Allow selection of patients on each ward selected.
+1 KILL ^TMP("PSJSELECT",$JOB)
SET PSJCNT=1
SET PSGWORP1=""
FOR
SET PSGWORP1=$ORDER(^TMP("PSGVBW",$JOB,PSGWORP1))
if PSGWORP1=""
QUIT
DO DISPLAYP
+2 QUIT
+3 ;
DISPLAYP ; Display WORP1 (Ward or Priority)
+1 NEW PSGPICK
+2 SET PSGVBWN=PSGWORP1
+3 DO HEADER
+4 SET PSGWORP2=""
FOR
SET PSGWORP2=$ORDER(^TMP("PSGVBW",$JOB,PSGWORP1,PSGWORP2))
if PSGWORP2=""
QUIT
SET PSGPRIN=PSGWORP2
DO DISPLAYT
+5 IF $GET(PSJASK)
IF (PSGVBY>0)
DO ASK
+6 QUIT
+7 ;
DISPLAYT ;
+1 ;NEW PSGPICK ;PSGPICK=1-->user selected order, stop display the profile
+2 SET PSGPRIN=PSGWORP2
+3 if $GET(PSGPRIF)
SET PSGVBWN=PSGWORP2
SET PSGPRIN=PSGWORP1
+4 SET PSGVBTM=""
FOR
SET PSGVBTM=$ORDER(^TMP("PSGVBW",$JOB,PSGWORP1,PSGWORP2,PSGVBTM))
if (PSGVBTM=""!$GET(PSGPICK))
QUIT
DO V2
+5 IF $GET(PSJPRIF)
IF $GET(PSJASK)
IF (PSGVBY>0)
DO ASK
+6 QUIT
+7 ;
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 PSGWORP1,PSGWORP2,CF,DA,LINE,NP,POP,PPN,PR,PSGCANFL,PSGION,PSGOL,PSGOEAV,PSGOENOF,PSGON,PSGONC,PSGONR,PSGLMT,PSGPRIF
+3 KILL PSGORD,PSGPRF,PSGVBA,PSGVBAF,PSGVBON,PSGVBPN,PSGVBQ,PSGVBQ1,PSGVBSD,PSGVBSS,PSGVBST,PSGVBTM,PSGVBW,PSGVBWN,PSGVBY,QQ,Z
+4 KILL LIDT,ND,ORDT,PPN,PRD,PRDNS,PSGINCL,PSGINWD,PSGODT,PSGOEA,PSGOEAV,PSGP,PSGPRD,PSGPRIN,PSGPTMP,PSGSS,PSGVBPN,PSGVBTM,PSGVBWN
+5 QUIT
+6 ;
V2 ;
+1 SET PSGVBPN=""
FOR
SET PSGVBPN=$ORDER(^TMP("PSGVBW",$JOB,PSGWORP1,PSGWORP2,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 SET PSGVBWN=PSGWORP1
SET PSGPRD=PSGWORP2
+3 WRITE !,$JUSTIFY(PSGVBY,4),?6,$SELECT(PSGVBTM'="zz":PSGVBTM,1:"Not Found"),?25,$SELECT(PSGPRD="zz":"Not Found",PSGPRD=1:"STAT",PSGPRD=2:"ASAP",PSGPRD=3:"ROUTINE",1:PSGPRD),?38,PPN," (",$PIECE(PSGVBPN,U,3),")"
SET ^TMP("PSJLIST",$JOB,PSGVBY)=PSGVBWN_U_PSGVBTM_U_PPN_U_PSGP
+4 IF $Y+1>IOSL
IF (PSGVBY>0)
NEW DIR
SET DIR(0)="EA"
SET DIR("A")=" '^' TO QUIT "
DO ^DIR
Begin DoDot:1
+5 IF X="^"
SET PSGPICK=1
QUIT
+6 WRITE @IOF
End DoDot:1
+7 QUIT
+8 ;
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")," - "
+2 IF $GET(PSGPRIF)
WRITE $SELECT(PRD=1:"STAT",PRD=2:"ASAP",1:"ROUTINE")
+3 IF '$GET(PSGPRIF)
WRITE $SELECT(PSGVBWN="ZZ":"^OTHER",1:PSGVBWN)
+4 WRITE !!," No.",?7,"TEAM",?25,"PRIORITY",?38,"PATIENT",!,LINE
KILL PSGVBY
SET PSGVBY=0
QUIT
+5 QUIT
+6 ;
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
+6
