PSJP ;BIR/CML3-INPATIENT LOOK-UP ;25-May-2012 08:29;PLS
;;5.0; INPATIENT MEDICATIONS ;**10,53,60,1014**;16 DEC 97;Build 5
;
; Reference to ^PS(55 is supported by DBIA 2191
; Reference to ^%ZIS is supported by DBIA 10086
; Reference to ^DICN is supported by DBIA 10009
; Reference to ^DIR is supported by DBIA 10026
; Reference to ^VADPT is supported by DBIA 10061
;
; Modified - IHS/MSC/PLS - 05/24/2012 - Line CNV+6
ENDPT ; get any patient
K DIC,PSGP,Y W !!,"Select "_$S($D(PSGDICA):PSGDICA_" ",1:"")_"PATIENT: " R X:DTIME S:'$T X="^" W:'$T $C(7) I "^"[X S (Y,PSGP)=-1 S QFLG=1 G DONE
D EN^PSJDPT
I Y'>0 G ENDPT
K DIC
;
CHK ;
S (DFN,PSGP)=+Y,VA200=1 D INP^VADPT
I VAIN(4) S PSJPCAF=1_"^"_VAIN(1),PSJPWD=+VAIN(4),PSJPWDN=$P(VAIN(4),"^",2),PSJPTS=+VAIN(3),PSJPTSP=+VAIN(2),PSJPRB=VAIN(5),PSJPAD=+VAIN(7),PSJPDX=VAIN(9),PSJPTD=$S($D(^PS(55,PSGP,5.1)):$P(^(5.1),"^",4),1:""),PSJPDD="" G CNV
S PSJPCAF="",VAIP("D")="L" D IN5^VADPT I 'VAIP(13,1) W $C(7),!!?3,"PATIENT HAS NEVER BEEN ADMITTED." D ENCONT G:%'=1 ENDPT S PSJPDD=""
S PSGID=+VAIP(3),X=+VAIP(4)=12!(+VAIP(4)=38),PSGOD=$$ENDTC^PSGMI(PSGID)
I $S(X:1,1:VAIP(13,1)) W $C(7),!!?3,"PATIENT IS FOUND TO BE ",$P("DISCHARGED^DECEASED","^",X+1)," AS OF ",PSGOD,"." S PSJH=$S(X:2,1:3),PSJPDD=PSGID_"^"_PSGOD S:X PSJPDD=PSJPDD_"^1" D ENCONT G:%'=1 ENDPT
S PSJPAD=VAIP(13,1),PSJPWD=+VAIP(5),PSJPWDN=$P(VAIP(5),"^",2),PSJPRB=$P(VAIP(6),"^",2),PSJPTSP=+VAIP(7),PSJPTS=+VAIP(8),PSJPDX=VAIP(9),PSJPTD=""
;
CNV ;
I $D(PSJEXTP) W ! K DIR S DIR(0)="DO",DIR("A")="Date to start searching from (optional)",DIR("?")="Enter a date to start searching from, or <RETURN> for all orders" D ^DIR S PSJHDATE=Y K DIR
D DEM^VADPT,PID^VADPT,HTWT^PSJAC(DFN)
S PSGP(0)=VADM(1),PSJPSSN=VADM(2),PSJPDOB=+VADM(3),PSJPAGE=VADM(4),PSJPSEX=$S(VADM(5)]"":VADM(5),1:"?^____"),PSJPPID=VA("PID"),PSJPBID=VA("BID")
F X="PSJPAD","PSJPDOB","PSJPTD" I @X S $P(@X,"^",2)=$$ENDTC^PSGMI(+@X)
;
D SETPTCX^APSPFUNC(DFN) ;IHS/MSC/PLS - 05/25/2012
WP ; ward parameters
S PSJSYSW0="",PSJSYSW=0 I $G(PSJPWD) S PSJSYSW=+$O(^PS(59.6,"B",PSJPWD,0)) I PSJSYSW S PSJSYSW0=$G(^PS(59.6,PSJSYSW,0))
; *OLD CODE* S PSJSYSL="",X=$P(PSJSYSU,";",3)>1,PSJSYSL=$P(PSJSYSW0,"^",X*4+12)
S PSJSYSL="",X=$P(PSJSYSU,";",3)>1,PSJSYSL=$S(X=0:$P(PSJSYSW0,"^",12),1:$P(PSJSYSW0,"^",16))
I PSJSYSL D
.S:X X='$P(PSJSYSP0,"^",10) S IOP=$S($P(PSJSYSP0,"^",13)]"":$P(PSJSYSP0,"^",13),$P(PSJSYSW0,"^",19+X)]"":$P(PSJSYSW0,"^",19+X),1:"") I IOP]"" D
..S IOP="`"_IOP K %ZIS S %ZIS="NQ" D ^%ZIS S:'POP $P(PSJSYSL,"^",2,3)=ION_"^"_IO D HOME^%ZIS
;
DONE ;
K DA,DIC,NB,ND,NS,PSGID,PSGOD,VA200,VAIP,VAMT,X,Y(0),Y(0,0),QFLG Q
;
ENCONT ;
I $D(PSGH) S %=1 Q
F FQ=0:0 W !!,"Do you wish to continue with this patient" S %=0 D YN^DICN Q:% W:%Y'?1."?" $C(7) W " (A 'YES' or 'NO' response is required.)" D:%Y?1."?" @("CH"_PSJH)
S:%'=1 Y=-1 Q
;
CH1 ;
W !!?2,"The patient selected has never been admitted to this medical facility. You",!,"will be able to enter IV orders for this patient but NOT Unit Dose orders." Q
CH2 ;
W !!?2,"This patient is shown as deceased. You will not be able to enter orders for",!,"this patient." Q
CH3 ;
W !!?2,"This patient is shown to be currently discharged. You will be able to enter",!,"IV orders for this patient but NOT Unit Dose orders." Q
Q
PSJP ;BIR/CML3-INPATIENT LOOK-UP ;25-May-2012 08:29;PLS
+1 ;;5.0; INPATIENT MEDICATIONS ;**10,53,60,1014**;16 DEC 97;Build 5
+2 ;
+3 ; Reference to ^PS(55 is supported by DBIA 2191
+4 ; Reference to ^%ZIS is supported by DBIA 10086
+5 ; Reference to ^DICN is supported by DBIA 10009
+6 ; Reference to ^DIR is supported by DBIA 10026
+7 ; Reference to ^VADPT is supported by DBIA 10061
+8 ;
+9 ; Modified - IHS/MSC/PLS - 05/24/2012 - Line CNV+6
ENDPT ; get any patient
+1 KILL DIC,PSGP,Y
WRITE !!,"Select "_$SELECT($DATA(PSGDICA):PSGDICA_" ",1:"")_"PATIENT: "
READ X:DTIME
IF '$TEST
SET X="^"
IF '$TEST
WRITE $CHAR(7)
IF "^"[X
SET (Y,PSGP)=-1
SET QFLG=1
GOTO DONE
+2 DO EN^PSJDPT
+3 IF Y'>0
GOTO ENDPT
+4 KILL DIC
+5 ;
CHK ;
+1 SET (DFN,PSGP)=+Y
SET VA200=1
DO INP^VADPT
+2 IF VAIN(4)
SET PSJPCAF=1_"^"_VAIN(1)
SET PSJPWD=+VAIN(4)
SET PSJPWDN=$PIECE(VAIN(4),"^",2)
SET PSJPTS=+VAIN(3)
SET PSJPTSP=+VAIN(2)
SET PSJPRB=VAIN(5)
SET PSJPAD=+VAIN(7)
SET PSJPDX=VAIN(9)
SET PSJPTD=$SELECT($DATA(^PS(55,PSGP,5.1)):$PIECE(^(5.1),"^",4),1:"")
SET PSJPDD=""
GOTO CNV
+3 SET PSJPCAF=""
SET VAIP("D")="L"
DO IN5^VADPT
IF 'VAIP(13,1)
WRITE $CHAR(7),!!?3,"PATIENT HAS NEVER BEEN ADMITTED."
DO ENCONT
IF %'=1
GOTO ENDPT
SET PSJPDD=""
+4 SET PSGID=+VAIP(3)
SET X=+VAIP(4)=12!(+VAIP(4)=38)
SET PSGOD=$$ENDTC^PSGMI(PSGID)
+5 IF $SELECT(X:1,1:VAIP(13,1))
WRITE $CHAR(7),!!?3,"PATIENT IS FOUND TO BE ",$PIECE("DISCHARGED^DECEASED","^",X+1)," AS OF ",PSGOD,"."
SET PSJH=$SELECT(X:2,1:3)
SET PSJPDD=PSGID_"^"_PSGOD
IF X
SET PSJPDD=PSJPDD_"^1"
DO ENCONT
IF %'=1
GOTO ENDPT
+6 SET PSJPAD=VAIP(13,1)
SET PSJPWD=+VAIP(5)
SET PSJPWDN=$PIECE(VAIP(5),"^",2)
SET PSJPRB=$PIECE(VAIP(6),"^",2)
SET PSJPTSP=+VAIP(7)
SET PSJPTS=+VAIP(8)
SET PSJPDX=VAIP(9)
SET PSJPTD=""
+7 ;
CNV ;
+1 IF $DATA(PSJEXTP)
WRITE !
KILL DIR
SET DIR(0)="DO"
SET DIR("A")="Date to start searching from (optional)"
SET DIR("?")="Enter a date to start searching from, or <RETURN> for all orders"
DO ^DIR
SET PSJHDATE=Y
KILL DIR
+2 DO DEM^VADPT
DO PID^VADPT
DO HTWT^PSJAC(DFN)
+3 SET PSGP(0)=VADM(1)
SET PSJPSSN=VADM(2)
SET PSJPDOB=+VADM(3)
SET PSJPAGE=VADM(4)
SET PSJPSEX=$SELECT(VADM(5)]"":VADM(5),1:"?^____")
SET PSJPPID=VA("PID")
SET PSJPBID=VA("BID")
+4 FOR X="PSJPAD","PSJPDOB","PSJPTD"
IF @X
SET $PIECE(@X,"^",2)=$$ENDTC^PSGMI(+@X)
+5 ;
+6 ;IHS/MSC/PLS - 05/25/2012
DO SETPTCX^APSPFUNC(DFN)
WP ; ward parameters
+1 SET PSJSYSW0=""
SET PSJSYSW=0
IF $GET(PSJPWD)
SET PSJSYSW=+$ORDER(^PS(59.6,"B",PSJPWD,0))
IF PSJSYSW
SET PSJSYSW0=$GET(^PS(59.6,PSJSYSW,0))
+2 ; *OLD CODE* S PSJSYSL="",X=$P(PSJSYSU,";",3)>1,PSJSYSL=$P(PSJSYSW0,"^",X*4+12)
+3 SET PSJSYSL=""
SET X=$PIECE(PSJSYSU,";",3)>1
SET PSJSYSL=$SELECT(X=0:$PIECE(PSJSYSW0,"^",12),1:$PIECE(PSJSYSW0,"^",16))
+4 IF PSJSYSL
Begin DoDot:1
+5 IF X
SET X='$PIECE(PSJSYSP0,"^",10)
SET IOP=$SELECT($PIECE(PSJSYSP0,"^",13)]"":$PIECE(PSJSYSP0,"^",13),$PIECE(PSJSYSW0,"^",19+X)]"":$PIECE(PSJSYSW0,"^",19+X),1:"")
IF IOP]""
Begin DoDot:2
+6 SET IOP="`"_IOP
KILL %ZIS
SET %ZIS="NQ"
DO ^%ZIS
IF 'POP
SET $PIECE(PSJSYSL,"^",2,3)=ION_"^"_IO
DO HOME^%ZIS
End DoDot:2
End DoDot:1
+7 ;
DONE ;
+1 KILL DA,DIC,NB,ND,NS,PSGID,PSGOD,VA200,VAIP,VAMT,X,Y(0),Y(0,0),QFLG
QUIT
+2 ;
ENCONT ;
+1 IF $DATA(PSGH)
SET %=1
QUIT
+2 FOR FQ=0:0
WRITE !!,"Do you wish to continue with this patient"
SET %=0
DO YN^DICN
IF %
QUIT
IF %Y'?1."?"
WRITE $CHAR(7)
WRITE " (A 'YES' or 'NO' response is required.)"
IF %Y?1."?"
DO @("CH"_PSJH)
+3 IF %'=1
SET Y=-1
QUIT
+4 ;
CH1 ;
+1 WRITE !!?2,"The patient selected has never been admitted to this medical facility. You",!,"will be able to enter IV orders for this patient but NOT Unit Dose orders."
QUIT
CH2 ;
+1 WRITE !!?2,"This patient is shown as deceased. You will not be able to enter orders for",!,"this patient."
QUIT
CH3 ;
+1 WRITE !!?2,"This patient is shown to be currently discharged. You will be able to enter",!,"IV orders for this patient but NOT Unit Dose orders."
QUIT
+2 QUIT
