source: FOIAVistA/trunk/r/INPATIENT_MEDICATIONS-PSJ-PSIV-PSG--PSGW/PSGSEL.m@ 631

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1PSGSEL ;BIR/CML3-SELECT ORDERS BY WARD, WARD GROUP, OR PATIENT ; 15 May 98 / 9:26 AM
2 ;;5.0; INPATIENT MEDICATIONS ;**3,111,145**;16 DEC 97;Build 17
3SELECT ; give user choice to select by
4 S:'$D(PSGSSH) PSGSSH="GENERIC"
5 F R !!,"Select by GROUP (G), WARD (W), CLINIC (C), or PATIENT (P): ",PSGSS:DTIME W:'$T $C(7) S:'$T PSGSS="^" Q:"^"[PSGSS D CHK I "CGPW"[PSGSS Q
6 ;
7 N PSGPRMT
8 S PSGPRMT=$P(XQY0,U,1)
9 ;DAM 5-01-07 Adding new prompt. If user selects to print by WARD, he is prompted to "Include Clinic Orders?" If user selects to print by CLINIC, he is prompted to "Include Ward Orders?"
10 S PSGINCL=""
11 I PSGSS["W" D
12 . I (PSGPRMT'["MAR") Q
13 . N DIR,DUOUT,DIRUT,DTOUT,X,Y
14 . S DIR(0)="Y"
15 . W !
16 . S DIR("A")="Include Clinic Orders"
17 . D ^DIR
18 . I Y=1 S PSGINCL=1
19 . I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)) S Y=0
20 ;
21 S PSGINWD=""
22 I PSGSS["C" D
23 . I (PSGPRMT'["MAR") Q
24 . N DIR,DUOUT,DIRUT,DTOUT,X,Y
25 . S DIR(0)="Y"
26 . W !
27 . S DIR("A")="Include Ward Orders"
28 . D ^DIR
29 . I Y=1 S PSGINWD=1
30 . I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)) S Y=0
31 ;End DAM 5-01-07
32 ;
33 K PSGSSA Q:PSGSS'="G"
34 F R !!,"Select by WARD GROUP (W) or CLINIC GROUP (C): ",PSGSS2:DTIME W:'$T $C(7) S:'$T PSGSS2="^" Q:"^"[PSGSS2 D CHK2 I "CW"[PSGSS2 Q
35 G SELECT:PSGSS2="" S PSGSS=$S(PSGSS2="C":"L",1:"G")
36 ;
37 ;DAM 5-01-07 Adding new prompt. If user selects to print by WARD GROUP, he is prompted to "Include Clinic Orders?" If user selects to print by CLINIC GROUP, he is prompted to "Include Ward Orders?"
38 S PSGINCLG=""
39 I PSGSS2["W" D
40 . I (PSGPRMT'["MAR") Q
41 . N DIR,DUOUT,DIRUT,DTOUT,X,Y
42 . S DIR(0)="Y"
43 . W !
44 . S DIR("A")="Include Clinic Orders"
45 . D ^DIR
46 . I Y=1 S PSGINCLG=1
47 . I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)) S Y=0
48 ;
49 S PSGINWDG=""
50 I PSGSS2["C" D
51 . I (PSGPRMT'["MAR") Q
52 . N DIR,DUOUT,DIRUT,DTOUT,X,Y
53 . S DIR(0)="Y"
54 . W !
55 . S DIR("A")="Include Ward Orders"
56 . D ^DIR
57 . I Y=1 S PSGINWDG=1
58 . I ($D(DTOUT)!$D(DUOUT)!$D(DIRUT)) S Y=0
59 ;End DAM 5-01-07
60 ;
61 K PSGSSA Q
62 ;
63CHK ;
64 ;I PSGSS=" ",$D(^DISV(DUZ,"PSGSEL")) S PSGSS=^("PSGSEL") W $S(PSGSS="P":"PATIENT",PSGSS="W":"WARD",PSGSS="G":"GROUP",1:"") Q:PSGSS]""&("GPW"[PSGSS)
65 I PSGSS=" " W $S(PSGSS="P":"PATIENT",PSGSS="W":"WARD",PSGSS="G":"GROUP",PSGSS="C":"CLINIC",1:"") Q:PSGSS]""&("GPWC"[PSGSS)
66 S PSGSSA="" F Q=1:1:$L(PSGSS) S PSGSSA=PSGSSA_$S($E(PSGSS,Q)'?1L:$E(PSGSS,Q),1:$C($A(PSGSS,Q)-32))
67 F X="CLINIC","GROUP","WARD","PATIENT" I $P(X,PSGSSA)="" W $P(X,PSGSSA,2,99) S PSGSS=$E(PSGSSA) Q
68 Q:$T I PSGSS'?1."?" W $C(7)," ??" S PSGSS="Z" Q
69 W ! D @PSGSSH W !!?2,"To leave this option, press the RETURN key or enter an '^'." Q
70 ;
71CHK2 ;
72 S PSGSSA="" F Q=1:1:$L(PSGSS2) S PSGSSA=PSGSSA_$S($E(PSGSS2,Q)'?1L:$E(PSGSS2,Q),1:$C($A(PSGSS2,Q)-32))
73 F X="WARD","CLINIC" I $P(X,PSGSSA)="" W $P(X,PSGSSA,2,99) S PSGSS2=$E(PSGSSA) Q
74 Q:$T I PSGSS2'?1."?" W $C(7)," ??" S PSGSS2="Z" Q
75 W ! D @PSGSSH W !!?2,"To leave this option, press the RETURN key or enter an '^'." Q
76 ;
77HELP ; the following are the help text messages for the various options
78 ;
79GENERIC W !!,?2,"To run this option for an entire WARD GROUP, enter a 'G'. To run this option for a single WARD, enter a 'W'. To run this option for a single PATIENT, enter a 'P'." Q
80 ;
81VBW W !!?2,"To verify all of the orders in an entire WARD GROUP, enter a 'G'. To verify all of the orders in an entire CLNIC GROUP, enter 'CG'."
82 W " To verify all of the orders in a single WARD, enter a 'W'. To verify all of the orders in a single CLINIC, enter a 'C'."
83 W "To verify all of the orders for a single PATIENT, enter a 'P'." Q
84 ;
85EXP W !?2,"To print STOP ORDER NOTICES for an entire WARD GROUP, enter a 'G'. To print notices for a single WARD, enter a 'W'. To print notices for a single PATIENT, enter a 'P'." Q
86 ;
87MAR W !?2,"To run a Medication Administration Record (MAR or CMR) for an entire WARD",!,"GROUP, enter a 'G'. To run an MAR for a single WARD, enter a 'W'. To run an MAR for a single PATIENT, enter a 'P'." Q
88 ;
89LBL W !?2,"To print labels for all of the orders in an entire WARD GROUP, enter a 'G'. To print labels for all of the orders in a WARD, enter a 'W'. To print the",!,"labels for a single PATIENT, enter a 'P'." Q
90 ;
91TCR W !?2,"To run a TOTAL COST REPORT for an entire WARD GROUP, enter a 'G'. To run the report for a single WARD, enter a 'W'. To run the report for a single PATIENT,",!,"or a set of PATIENTS, enter a 'P'." Q
92 ;
93PPR W !?2,"To print PATIENT PROFILES for an entire WARD GROUP, enter a 'G'. To print profiles for a single WARD, enter a 'W'. To print a profile for a single",!,"PATIENT, enter a 'P'." Q
94 ;
95AP W !?2,"To print ACTION PROFILES for an entire WARD GROUP, enter a 'G'. To print",!,"ACTION PROFILES for a single WARD, enter a 'W'. To print an ACTION PROFILE",!,"for a single patient, enter a 'P'. PLEASE NOTE that only patients"
96 W " with active",!,"orders are selectable, and that only patients with active orders will print for",!,"a ward or ward group." Q
97ORVC W !?2,"To complete orders for an entire WARD GROUP, enter a 'G'. To complete orders for an entire CLINIC GROUP, enter 'CG'"
98 W "To complete orders for a single WARD, enter a 'W'. To complete orders for a single PATIENT, enter",!,"a 'P'." Q
Note: See TracBrowser for help on using the repository browser.