source: WorldVistAEHR/trunk/r/SURGERY-SR/SRSWLST.m@ 862

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1SRSWLST ;B'HAM ISC/MAM - PRINT SURGERY WAITING LIST ; 17 OCT 89 7:05 AM
2 ;;3.0; Surgery ;;24 Jun 93
3 S SOPT="",SSOPT="",SRSS=""
4 N DFN
5 ;
6 S RH="Surgery Waiting List Reports"
7MENU W @IOF,!!,?(IOM-$L(RH)\2),RH,!!,"Print Report By:"
8 W !!," A Alphabetical Order by Patient",!," T Tentative Date of Operation",!," D Date Entered on the Waiting List"
9 ;
10 S SRSOUT=0 W !!,"Enter Selection (A,T, or D): " R SOPT:DTIME I '$T!(SOPT["^")!(SOPT="") S SRSOUT=1 W @IOF G END
11 ;
12 S SOPT=$E(SOPT) I "ATDatd"'[SOPT!(SOPT="") W !!,"Enter one of the letters, A, T, or D or ^ to exit. ",!!,"Press RETURN to continue " R X:DTIME G MENU
13 ;
14 ;
15SPEC S SRSOUT=0 W @IOF,!,"Do you want to print the waiting list for all specialties ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
16 ;
17SORTOP I "Aa"[SOPT,"Yy"[SRYN W !!,"Do you want this alphabetic list to be sorted by surgical specialty ? YES// " R SSOPT:DTIME I '$T!(SSOPT["^") S SRSOUT=1 G END
18 S SSOPT=$E(SSOPT)
19 S:SSOPT="" SSOPT="Y" I "YyNn"'[SSOPT W !!,"Enter YES to generate the list sorted first by surgical specialty ",!,"and then alphabetic by patient name. Enter NO to sort only by patient name.",!!,"Press RETURN to continue " R X:DTIME G SORTOP
20 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y" I "YyNn"'[SRYN W !!,"Enter 'YES' if you want to generate the list for all surgical",!,"specialties, or 'NO' to select a specific specialty.",!!,"Press RETURN to continue " R X:DTIME G SPEC
21 ;
22 I "Nn"[SRYN W ! K DIC S DIC=133.8,DIC(0)="QEAMZ",DIC("A")="Select Surgical Specialty: " D ^DIC I Y<0 S SRSOUT=1 G END
23 I "Nn"[SRYN S SRSS=+Y,SRSNM=$P(Y(0),"^") S SRSNM=$P(^SRO(137.45,SRSNM,0),"^") S ZTSAVE("SRSNM")=SRSNM,ZTSAVE("SRSS")=SRSS
24 ;
25 I "Yy"[SRYN S SRSS="ALL"
26FORM ; brief or extended
27 ;
28 W !!,"Do you want to print the brief form ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
29 ;
30 S SRYN=$E(SRYN) I SRYN="" S SRYN="Y"
31 ;
32 I "YyNn"'[SRYN W !!,"Enter 'NO' if you want to print the extended form of the waiting list",!,"containing demographic information, or 'YES' to print the brief form.",! G FORM
33 ;
34 S SRFORM=$S("Yy"[SRYN:"B",1:"E")
35 ;
36 ;;; Sort by Patient within All Specialties displaying brief form.
37 I "Aa"[SOPT,SRSS="ALL","Yy"[SSOPT,SRFORM="B" G ^SRSWL6
38 ;;; Sort by Patient within All Specialties displaying extended form.
39 I "Aa"[SOPT,SRSS="ALL","Yy"[SSOPT G ^SRSWL7
40 ;;; Sort by Patient Only, displaying All Specialties, in brief form.
41 I "Aa"[SOPT,SRSS="ALL",SRFORM="B" G ^SRSWL8
42 ;;; Sort by Patient Only, displaying All Specialties, extended form.
43 I "Aa"[SOPT,SRSS="ALL" G ^SRSWL9
44 ;;; Sort by Patient Only, displaying One Specialty, in brief form.
45 I "Aa"[SOPT,SRSS'="ALL",SRFORM="B" G ^SRSWL10
46 ;;; Sort by Patient Only, displaying One Specialty, in extended form.
47 I "Aa"[SOPT,SRSS'="ALL" G ^SRSWL11
48 ;;; Sort by Tentative Date of Operation within All Specialties Brief.
49 I "Tt"[SOPT,SRSS="ALL",SRFORM="B" G ^SRSWL12
50 ;;; Sort by Tentative Date of Operation within All Specialties Extend.
51 I "Tt"[SOPT,SRSS="ALL" G ^SRSWL13
52 ;;; Sort by Tentative Date of Operation for one Specialty, Brief form.
53 I "Tt"[SOPT,SRFORM="B" G ^SRSWL14
54 ;;; Sort by Tentative Date of Operation for one Specialty, Extended.
55 I "Tt"[SOPT G ^SRSWL15
56 ;;; Sort by Date entered on the List with All specailties,brief form.
57 I "Dd"[SOPT,SRSS="ALL",SRFORM="B" G ^SRSWL1
58 ;;; Sort by Date entered on the List with All specailties, extended.
59 I "Dd"[SOPT,SRSS="ALL" G ^SRSWL3
60 ;;; Sort by Date entered on the List for one specailty, brief form.
61 I "Dd"[SOPT,SRFORM="B" G ^SRSWL2
62 ;;; Sort by Date entered on the List for one specialty, extended.
63 I "Dd"[SOPT G ^SRSWL4
64 ;
65END I $E(IOST)="P" S SRSOUT=1 W @IOF
66 I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q
67 I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME W @IOF
68 D ^%ZISC,^SRSKILL
69 K SRTN
70 Q
71OLD ; check for operations by same specialty
72 ;
73 S SRTN=0 F S SRTN=$O(^SRF("B",DFN,SRTN)) Q:'SRTN S SROLDDT=$P(^SRF(SRTN,0),"^",9) D CHK
74 Q
75CHK ;
76 S X1=DT,X2=-30 D C^%DTC I SROLDDT<X Q
77 ;
78 I $D(^SRF(SRTN,.2)),$P(^(.2),"^",12) S Y=SROLDDT D D^DIQ S SROLD("DATE")=$P(Y,"@"),SROLD=SRTN
79 Q
Note: See TracBrowser for help on using the repository browser.