- 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
