| 1 | PSJPDIR ;BIR/MLM-PATIENT PROFILE CALLS ;10 MAY 96 / 9:56 AM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**53,111**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^DIC is supported by DBIA 10006
|
|---|
| 5 | ; Reference to ^DIR is supported by DBIA 10026
|
|---|
| 6 | ; Reference to ^VADPT is supported by DBIA 10061
|
|---|
| 7 | ;
|
|---|
| 8 | GWP ; Ask for seletion by WARD GROUP,WARD or PATIENT.
|
|---|
| 9 | K PSJSEL,DIR S PSJSTOP="",DIR(0)="SAO^G:Ward Group;W:Ward;P:Patient",DIR("A")="Select by WARD GROUP (G), WARD (W), or PATIENT (P): "
|
|---|
| 10 | S DIR("?")="To select by PATIENT, enter a 'P'."
|
|---|
| 11 | S DIR("?",1)="To select the entire WARD GROUP, enter a 'G'."
|
|---|
| 12 | S DIR("?",2)="To select a single WARD, enter a 'W'."
|
|---|
| 13 | W !! D ^DIR K DIR S PSJSTOP=$S(Y="":1,Y<0:1,$$STOP:1,1:0)
|
|---|
| 14 | I 'PSJSTOP S PSJSEL("SELECT")=Y D @Y Q:($G(PSJSEL("WG"))="^OTHER") G:PSJSTOP GWP D:PSJSEL("SELECT")'="P" RBPPN G:PSJSTOP GWP
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | P ;*** Select by Patient
|
|---|
| 18 | N PSJACNWP,PSGDICA,PSGPAT S PSJACNWP=""
|
|---|
| 19 | F PFLG=0:1 S:PFLG PSGDICA="another" D ^PSJP Q:PSGP<0 S PSJSEL("P",PSGP(0),PSGP)="" S:'$G(PSJPWDO) (PSGWD,PSJPWDO)=PSJPWD S PSGWD=$S('$G(PSGWD):0,PSJPWDO=PSJPWD:PSJPWD,1:0)
|
|---|
| 20 | S PSJSTOP=$S($D(DTOUT):1,$D(DUOUT):1,(Y<0)&'$D(PSGDICA):1,1:0)
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | W ;*** Select by WARD
|
|---|
| 24 | K DIC S DIC="^DIC(42,",DIC(0)="QEAMIZ",DIC("A")="Select a Ward: " W !! D ^DIC
|
|---|
| 25 | S PSJSTOP=$S(Y="":1,Y<0:1,$$STOP:1,1:0)
|
|---|
| 26 | I 'PSJSTOP S PSJSEL("W")=Y D ADMTM
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | G ;***Select by WARD GROUP
|
|---|
| 30 | K DIC S DIC="^PS(57.5,",DIC(0)="QEAMI",DIC("A")="Select a Ward Group: " W !! D ^DIC
|
|---|
| 31 | S PSJSTOP=$S(X="^OTHER":2,Y="":1,Y<0:1,$$STOP:1,1:0)
|
|---|
| 32 | ;I PSJSTOP=2 S PSJSTOP=0,PSJSEL("WG")="^OTHER" Q
|
|---|
| 33 | I PSJSTOP=2 S PSJSEL("WG")="^OTHER" Q
|
|---|
| 34 | I 'PSJSTOP S PSJSEL("WG")=Y
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | ADMTM ;*** Askif user want to sort by admin team
|
|---|
| 38 | N DIR S DIR(0)="YO",DIR("A")="Do you want to sort by Administration Team (Y/N)",DIR("B")="NO",DIR("?")="Enter ""YES"" to sort this report by Administration Team." W !! D ^DIR Q:$$STOP!'+Y
|
|---|
| 39 | ;
|
|---|
| 40 | ;*** Because "ALL" is not a team, must use DIR to include "ALL"
|
|---|
| 41 | ; default and then call DIC to look up the selected team
|
|---|
| 42 | ;
|
|---|
| 43 | F Q:$$STOP!(X="")!$D(PSJSEL("TM","ALL")) D ADMTM2
|
|---|
| 44 | Q
|
|---|
| 45 | ADMTM2 ;
|
|---|
| 46 | K DIR S DIR(0)="FAO",DIR("A")="Select Administration Team: ",DIR("B")="ALL",DIR("?")="^D TM2HLP^PSJPDIR,DICTM^PSJPDIR"
|
|---|
| 47 | W !! D ^DIR Q:$$STOP I Y="ALL" S PSJSEL("TM","ALL")="" Q
|
|---|
| 48 | D DICTM
|
|---|
| 49 | S PSJSTOP=$S($D(DTOUT):1,$D(DUOUT):1,(Y<0)&'$D(PFLG):1,1:0)
|
|---|
| 50 | Q
|
|---|
| 51 | TM2HLP W !!,"Enter the name of an Administration Team that you want",!,"to include on the report."," Enter ""ALL"" (or accept the",!,"default) to include all teams on the report.",!
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | DICTM ;*** LooK up a team.
|
|---|
| 55 | ;
|
|---|
| 56 | K DIC S DIC="^PS(57.7,"_+PSJSEL("W")_",1,",DIC(0)="QEMIZ"
|
|---|
| 57 | F PFLG=0:1 D ^DIC Q:Y<0 I PFLG S DIC(0)=DIC(0)_"A",DIC("A")="Select another Administration Team: " S PSJSEL("TM",+Y)=Y(0,0)
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | RBPPN ;*** Sort by ROOM-BED or PATIENT
|
|---|
| 61 | ;
|
|---|
| 62 | K DIR S DIR(0)="SAO^R:Room-Bed;P:Patient",DIR("A")="Do you wish to sort by Room-Bed (R), Patient (P): ",DIR("B")="Patient"
|
|---|
| 63 | W !! D ^DIR Q:$$STOP S PSJSEL("RBP")=Y
|
|---|
| 64 | Q
|
|---|
| 65 | ENL ;
|
|---|
| 66 | F W !!,"SHORT, LONG, or NO Profile? ",$S('$D(PSJPWD):"SHORT",PSJPWD:"SHORT",1:"LONG"),"// " R PSJOL:DTIME W:'$T $C(7) S:'$T PSJOL="^" Q:PSJOL="^" D LCHK Q:"^SLN"[PSJOL&($L(PSJOL)=1)
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | LCHK ;
|
|---|
| 70 | I PSJOL?1."?" D LM Q
|
|---|
| 71 | I PSJOL="" S PSJOL=$S('$D(PSJPWD):"S",PSJPWD:"S",1:"L") W $P(" SHORT^ LONG","^",PSJOL="L"+1) Q
|
|---|
| 72 | I PSJOL?.ANP,PSJOL?.E1L.E F Q=1:1:$L(PSJOL) I $E(PSJOL,Q)?.L S PSJOL=$E(PSJOL,1,Q-1)_$C($A(PSJOL,Q)-32)_$E(PSJOL,Q+1,$L(PSJOL))
|
|---|
| 73 | I PSJOL?.ANP F X="NO PROFILE","LONG","SHORT" I $P(X,PSJOL)="" W $P(X,PSJOL,2) S PSJOL=$E(PSJOL) Q
|
|---|
| 74 | W:'$T $C(7)," ??" Q
|
|---|
| 75 | ;
|
|---|
| 76 | LM ;Profile Type
|
|---|
| 77 | W !!?2,"Enter 'SHORT' (or 'S', or press the RETURN key) to exclude this patient's",!,"discontinued and expired orders in the following profile. Enter 'LONG' (or 'L') to include those orders."
|
|---|
| 78 | W " Enter 'NO' (or 'N') to bypass the profile com-",!,"pletely. Enter '^' if you wish to go no further with this patient." Q
|
|---|
| 79 | ENDPT ;*** get patient ***
|
|---|
| 80 | K DIC,PSGP,Y W !!,"Select "_$S($D(PSGDICA):PSGDICA_" ",1:"")_"PATIENT: " R X:DTIME I "^"[X S (Y,PSGP)=-1 G DONE
|
|---|
| 81 | D EN^PSJDPT
|
|---|
| 82 | I Y'>0 G ENDPT
|
|---|
| 83 | K DIC
|
|---|
| 84 | ;
|
|---|
| 85 | CHK ;*** Check patient status ***
|
|---|
| 86 | S PPN=$P(Y,U,2),(DFN,PSGP)=+Y,VA200=1 D INP^VADPT Q:VAIN(4)
|
|---|
| 87 | S PSJPCAF="",VAIP("D")="L" D IN5^VADPT I 'VAIP(13,1) W $C(7),!!?3,"PATIENT HAS NEVER BEEN ADMITTED." G ENDPT
|
|---|
| 88 | S X=+VAIP(4)=12!(+VAIP(4)=38) W $C(7),!!?3,"PATIENT IS FOUND TO BE D",$P("ISCHARG^ECEAS",U,X+1),"ED AS OF ",$$ENDTC^PSGMI(+VAIP(3)),"." G ENDPT
|
|---|
| 89 | Q
|
|---|
| 90 | ;
|
|---|
| 91 | STOP() ;
|
|---|
| 92 | ;
|
|---|
| 93 | S PSJSTOP=$S($D(DTOUT):1,$D(DUOUT):1,$D(DIRUT):1,1:0)
|
|---|
| 94 | Q PSJSTOP
|
|---|
| 95 | ;
|
|---|
| 96 | DONE ;
|
|---|
| 97 | K DA,DIC,DIK
|
|---|
| 98 | Q
|
|---|
