PSGRET ;BIR/CML3-ENTER RETURNS ;17 SEP 97 / 1:41 PM
;;5.0; INPATIENT MEDICATIONS ;**31**;16 DEC 97
;
; Reference to ^PS(50.7 is supported by DBIA# 2180
; Reference to ^PS(51.2 is supported by DBIA #2178
; Reference to ^PS(55 is supported by DBIA# 2191
;
N PSJNEW,PSGPTMP,PPAGE,PSGEFN S PSJNEW=1
D ENCV^PSGSETU Q:$D(XQUIT) S (PSGONNV,PSGRETF)=1 K PSGPRP
;
GP ;
D ENDPT^PSGP G:PSGP'>0 DONE I '$O(^PS(55,PSGP,5,"AUS",+PSJPAD)) W $C(7),!,"(Patient has NO active or old orders.)" G GP
D ENL^PSGOU G:"^N"[PSGOL GP S PSGPTMP=0,PPAGE=1 D ^PSGO G:'PSGON GP S PSGLMT=PSGON,(PSGONC,PSGONR)=0
F W !!,"Select ORDER",$E("S",PSGON>1)," 1-",PSGON,": " R X:DTIME W:'$T $C(7) S:'$T X="^" Q:"^"[X D:X?1."?" H I X'?1."?" D ENCHK^PSGON W:'$D(X) $C(7)," ??" Q:$D(X)
G:"^"[X GP F PSGRET=1:1:PSGODDD F PSGRET1=1:1 S PSGRET2=$P(PSGODDD(PSGRET),",",PSGRET1) Q:'PSGRET2 K DA S (PSGORD)=^TMP("PSJON",$J,PSGRET2) D R G:Y GP
G GP
;
DONE ;
D ENKV^PSGSETU K ^TMP("PSJON",$J),DO,DRG,MR,OD,PSGLMT,PSGODDD,PSGOL,PSGON,PSGONC,PSGONR,PSGONV,PSGONNV,PSGORD,PSGRET,PSGRET1,PSGRET2,PSGRETF,SCH,Y1,Z Q
;
R ;
S MR=$P($G(^PS(55,PSGP,5,+PSGORD,0)),"^",3),Y=$G(^(.2)),SCH=$P($G(^(2)),"^"),DO=$P(Y,"^",2),DRG=$P(Y,"^"),DRG=$S(DRG'=+DRG:"NOT FOUND",'$D(^PS(50.7,DRG,0)):DRG,$P(^(0),"^")]"":$P(^(0),"^"),1:DRG_";PS(50.7,")
S:MR]"" MR=$S(MR'=MR:MR,'$D(^PS(51.2,MR,0)):MR,$P(^(0),"^",3)]"":$P(^(0),"^",3),$P(^(0),"^")]"":$P(^(0),"^"),1:MR_";PS(51.2,") W !!,"----------------------------------------",!,DRG,!,"Give: ",DO," ",MR," ",SCH
I '$O(^PS(55,PSGP,5,+PSGORD,1,0)) D Q
.W !!,"No Dispense drugs have been entered for this order. At least one Dispense drugs",!,"must be associated with an order before dispensing information may be entered.",!!
.N DIR S DIR(0)="E" D ^DIR S Y=$S(Y:0,1:1)
S Y=$O(^PS(55,PSGP,5,+PSGORD,1,0)) I '$O(^(Y)),$D(^(Y,0)) S DRG=$P(^(0),"^"),UD=$P(^(0),"^",2),DRG=$$ENDDN^PSGMI(DRG)
I W !!,"Dispense drug: ",DRG," (U/D: ",$S('UD:1,1:UD),")"
E K DA,DIC S DA(1)=PSGP,DA(2)=+PSGORD,DA=+PSGORD,DIC="^PS(55,"_PSGP_",5,"_+PSGORD_",1,",DIC(0)="AEQM" W ! D ^DIC K DIC Q:Y'>0
K DA,DR S DA=+Y,DA(2)=PSGP,DA(1)=+PSGORD,DIE="^PS(55,"_PSGP_",5,"_+PSGORD_",1,",DR=.08 S:$P($G(^PS(55,PSGP,5,+PSGORD,1,DA,0)),"^",8) $P(^(0),"^",8)="" W ! D ^DIE S Y=$D(DUOUT)!$D(DTOUT)
Q
;
H ;
W !!?2,"Select the orders (by number) for which you want to enter returns." D:X'="?" H2^PSGON Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGRET 2405 printed Sep 23, 2025@19:39:11 Page 2
PSGRET ;BIR/CML3-ENTER RETURNS ;17 SEP 97 / 1:41 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**31**;16 DEC 97
+2 ;
+3 ; Reference to ^PS(50.7 is supported by DBIA# 2180
+4 ; Reference to ^PS(51.2 is supported by DBIA #2178
+5 ; Reference to ^PS(55 is supported by DBIA# 2191
+6 ;
+7 NEW PSJNEW,PSGPTMP,PPAGE,PSGEFN
SET PSJNEW=1
+8 DO ENCV^PSGSETU
if $DATA(XQUIT)
QUIT
SET (PSGONNV,PSGRETF)=1
KILL PSGPRP
+9 ;
GP ;
+1 DO ENDPT^PSGP
if PSGP'>0
GOTO DONE
IF '$ORDER(^PS(55,PSGP,5,"AUS",+PSJPAD))
WRITE $CHAR(7),!,"(Patient has NO active or old orders.)"
GOTO GP
+2 DO ENL^PSGOU
if "^N"[PSGOL
GOTO GP
SET PSGPTMP=0
SET PPAGE=1
DO ^PSGO
if 'PSGON
GOTO GP
SET PSGLMT=PSGON
SET (PSGONC,PSGONR)=0
+3 FOR
WRITE !!,"Select ORDER",$EXTRACT("S",PSGON>1)," 1-",PSGON,": "
READ X:DTIME
if '$TEST
WRITE $CHAR(7)
if '$TEST
SET X="^"
if "^"[X
QUIT
if X?1."?"
DO H
IF X'?1."?"
DO ENCHK^PSGON
if '$DATA(X)
WRITE $CHAR(7)," ??"
if $DATA(X)
QUIT
+4 if "^"[X
GOTO GP
FOR PSGRET=1:1:PSGODDD
FOR PSGRET1=1:1
SET PSGRET2=$PIECE(PSGODDD(PSGRET),",",PSGRET1)
if 'PSGRET2
QUIT
KILL DA
SET (PSGORD)=^TMP("PSJON",$JOB,PSGRET2)
DO R
if Y
GOTO GP
+5 GOTO GP
+6 ;
DONE ;
+1 DO ENKV^PSGSETU
KILL ^TMP("PSJON",$JOB),DO,DRG,MR,OD,PSGLMT,PSGODDD,PSGOL,PSGON,PSGONC,PSGONR,PSGONV,PSGONNV,PSGORD,PSGRET,PSGRET1,PSGRET2,PSGRETF,SCH,Y1,Z
QUIT
+2 ;
R ;
+1 SET MR=$PIECE($GET(^PS(55,PSGP,5,+PSGORD,0)),"^",3)
SET Y=$GET(^(.2))
SET SCH=$PIECE($GET(^(2)),"^")
SET DO=$PIECE(Y,"^",2)
SET DRG=$PIECE(Y,"^")
SET DRG=$SELECT(DRG'=+DRG:"NOT FOUND",'$DATA(^PS(50.7,DRG,0)):DRG,$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:DRG_";PS(50.7,")
+2 if MR]""
SET MR=$SELECT(MR'=MR:MR,'$DATA(^PS(51.2,MR,0)):MR,$PIECE(^(0),"^",3)]"":$PIECE(^(0),"^",3),$PIECE(^(0),"^")]"":$PIECE(^(0),"^"),1:MR_";PS(51.2,")
WRITE !!,"----------------------------------------",!,DRG,!,"Give: ",DO," ",MR," ",SCH
+3 IF '$ORDER(^PS(55,PSGP,5,+PSGORD,1,0))
Begin DoDot:1
+4 WRITE !!,"No Dispense drugs have been entered for this order. At least one Dispense drugs",!,"must be associated with an order before dispensing information may be entered.",!!
+5 NEW DIR
SET DIR(0)="E"
DO ^DIR
SET Y=$SELECT(Y:0,1:1)
End DoDot:1
QUIT
+6 SET Y=$ORDER(^PS(55,PSGP,5,+PSGORD,1,0))
IF '$ORDER(^(Y))
IF $DATA(^(Y,0))
SET DRG=$PIECE(^(0),"^")
SET UD=$PIECE(^(0),"^",2)
SET DRG=$$ENDDN^PSGMI(DRG)
+7 IF $TEST
WRITE !!,"Dispense drug: ",DRG," (U/D: ",$SELECT('UD:1,1:UD),")"
+8 IF '$TEST
KILL DA,DIC
SET DA(1)=PSGP
SET DA(2)=+PSGORD
SET DA=+PSGORD
SET DIC="^PS(55,"_PSGP_",5,"_+PSGORD_",1,"
SET DIC(0)="AEQM"
WRITE !
DO ^DIC
KILL DIC
if Y'>0
QUIT
+9 KILL DA,DR
SET DA=+Y
SET DA(2)=PSGP
SET DA(1)=+PSGORD
SET DIE="^PS(55,"_PSGP_",5,"_+PSGORD_",1,"
SET DR=.08
if $PIECE($GET(^PS(55,PSGP,5,+PSGORD,1,DA,0)),"^",8)
SET $PIECE(^(0),"^",8)=""
WRITE !
DO ^DIE
SET Y=$DATA(DUOUT)!$DATA(DTOUT)
+10 QUIT
+11 ;
H ;
+1 WRITE !!?2,"Select the orders (by number) for which you want to enter returns."
if X'="?"
DO H2^PSGON
QUIT
