source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSJPDIR.m@ 1429

Last change on this file since 1429 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.4 KB
Line 
1PSJPDIR ;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 ;
8GWP ; 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 ;
17P ;*** 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 ;
23W ;*** 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 ;
29G ;***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 ;
37ADMTM ;*** 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
45ADMTM2 ;
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
51TM2HLP 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 ;
54DICTM ;*** 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 ;
60RBPPN ;*** 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
65ENL ;
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 ;
69LCHK ;
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 ;
76LM ;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
79ENDPT ;*** 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 ;
85CHK ;*** 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 ;
91STOP() ;
92 ;
93 S PSJSTOP=$S($D(DTOUT):1,$D(DUOUT):1,$D(DIRUT):1,1:0)
94 Q PSJSTOP
95 ;
96DONE ;
97 K DA,DIC,DIK
98 Q
Note: See TracBrowser for help on using the repository browser.