| 1 | PSJP ;BIR/CML3-INPATIENT LOOK-UP ; 15 Apr 98 / 9:05 AM
 | 
|---|
| 2 |  ;;5.0; INPATIENT MEDICATIONS ;**10,53,60**;16 DEC 97
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ; Reference to ^PS(55 is supported by DBIA 2191
 | 
|---|
| 5 |  ; Reference to ^%ZIS is supported by DBIA 10086
 | 
|---|
| 6 |  ; Reference to ^DICN is supported by DBIA 10009
 | 
|---|
| 7 |  ; Reference to ^DIR is supported by DBIA 10026
 | 
|---|
| 8 |  ; Reference to ^VADPT is supported by DBIA 10061
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 | ENDPT ; get any patient
 | 
|---|
| 11 |  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
 | 
|---|
| 12 |  D EN^PSJDPT
 | 
|---|
| 13 |  I Y'>0 G ENDPT
 | 
|---|
| 14 |  K DIC
 | 
|---|
| 15 |  ;
 | 
|---|
| 16 | CHK ;
 | 
|---|
| 17 |  S (DFN,PSGP)=+Y,VA200=1 D INP^VADPT
 | 
|---|
| 18 |  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
 | 
|---|
| 19 |  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=""
 | 
|---|
| 20 |  S PSGID=+VAIP(3),X=+VAIP(4)=12!(+VAIP(4)=38),PSGOD=$$ENDTC^PSGMI(PSGID)
 | 
|---|
| 21 |  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
 | 
|---|
| 22 |  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=""
 | 
|---|
| 23 |  ;
 | 
|---|
| 24 | CNV ;
 | 
|---|
| 25 |  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
 | 
|---|
| 26 |  D DEM^VADPT,PID^VADPT,HTWT^PSJAC(DFN)
 | 
|---|
| 27 |  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")
 | 
|---|
| 28 |  F X="PSJPAD","PSJPDOB","PSJPTD" I @X S $P(@X,"^",2)=$$ENDTC^PSGMI(+@X)
 | 
|---|
| 29 |  ;
 | 
|---|
| 30 | WP ; ward parameters
 | 
|---|
| 31 |  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))
 | 
|---|
| 32 |  ; *OLD CODE* S PSJSYSL="",X=$P(PSJSYSU,";",3)>1,PSJSYSL=$P(PSJSYSW0,"^",X*4+12)
 | 
|---|
| 33 |  S PSJSYSL="",X=$P(PSJSYSU,";",3)>1,PSJSYSL=$S(X=0:$P(PSJSYSW0,"^",12),1:$P(PSJSYSW0,"^",16))
 | 
|---|
| 34 |  I PSJSYSL D
 | 
|---|
| 35 |  .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
 | 
|---|
| 36 |  ..S IOP="`"_IOP K %ZIS S %ZIS="NQ" D ^%ZIS S:'POP $P(PSJSYSL,"^",2,3)=ION_"^"_IO D HOME^%ZIS
 | 
|---|
| 37 |  ;
 | 
|---|
| 38 | DONE ;
 | 
|---|
| 39 |  K DA,DIC,NB,ND,NS,PSGID,PSGOD,VA200,VAIP,VAMT,X,Y(0),Y(0,0),QFLG Q
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 | ENCONT ;
 | 
|---|
| 42 |  I $D(PSGH) S %=1 Q
 | 
|---|
| 43 |  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)
 | 
|---|
| 44 |  S:%'=1 Y=-1 Q
 | 
|---|
| 45 |  ;
 | 
|---|
| 46 | CH1 ;
 | 
|---|
| 47 |  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
 | 
|---|
| 48 | CH2 ;
 | 
|---|
| 49 |  W !!?2,"This patient is shown as deceased.  You will not be able to enter orders for",!,"this patient." Q
 | 
|---|
| 50 | CH3 ;
 | 
|---|
| 51 |  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
 | 
|---|
| 52 |  Q
 | 
|---|