SRSWLST ;B'HAM ISC/MAM - PRINT SURGERY WAITING LIST ; 17 OCT 89 7:05 AM
;;3.0; Surgery ;;24 Jun 93
S SOPT="",SSOPT="",SRSS=""
N DFN
;
S RH="Surgery Waiting List Reports"
W !!," A Alphabetical Order by Patient",!," T Tentative Date of Operation",!," D Date Entered on the Waiting List"
;
S SRSOUT=0 W !!,"Enter Selection (A,T, or D): " R SOPT:DTIME I '$T!(SOPT["^")!(SOPT="") S SRSOUT=1 W @IOF G END
;
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
;
;
SPEC 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
;
SORTOP 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
S SSOPT=$E(SSOPT)
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
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
;
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
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
;
I "Yy"[SRYN S SRSS="ALL"
FORM ; brief or extended
;
W !!,"Do you want to print the brief form ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRSOUT=1 G END
;
S SRYN=$E(SRYN) I SRYN="" S SRYN="Y"
;
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
;
S SRFORM=$S("Yy"[SRYN:"B",1:"E")
;
;;; Sort by Patient within All Specialties displaying brief form.
I "Aa"[SOPT,SRSS="ALL","Yy"[SSOPT,SRFORM="B" G ^SRSWL6
;;; Sort by Patient within All Specialties displaying extended form.
I "Aa"[SOPT,SRSS="ALL","Yy"[SSOPT G ^SRSWL7
;;; Sort by Patient Only, displaying All Specialties, in brief form.
I "Aa"[SOPT,SRSS="ALL",SRFORM="B" G ^SRSWL8
;;; Sort by Patient Only, displaying All Specialties, extended form.
I "Aa"[SOPT,SRSS="ALL" G ^SRSWL9
;;; Sort by Patient Only, displaying One Specialty, in brief form.
I "Aa"[SOPT,SRSS'="ALL",SRFORM="B" G ^SRSWL10
;;; Sort by Patient Only, displaying One Specialty, in extended form.
I "Aa"[SOPT,SRSS'="ALL" G ^SRSWL11
;;; Sort by Tentative Date of Operation within All Specialties Brief.
I "Tt"[SOPT,SRSS="ALL",SRFORM="B" G ^SRSWL12
;;; Sort by Tentative Date of Operation within All Specialties Extend.
I "Tt"[SOPT,SRSS="ALL" G ^SRSWL13
;;; Sort by Tentative Date of Operation for one Specialty, Brief form.
I "Tt"[SOPT,SRFORM="B" G ^SRSWL14
;;; Sort by Tentative Date of Operation for one Specialty, Extended.
I "Tt"[SOPT G ^SRSWL15
;;; Sort by Date entered on the List with All specailties,brief form.
I "Dd"[SOPT,SRSS="ALL",SRFORM="B" G ^SRSWL1
;;; Sort by Date entered on the List with All specailties, extended.
I "Dd"[SOPT,SRSS="ALL" G ^SRSWL3
;;; Sort by Date entered on the List for one specailty, brief form.
I "Dd"[SOPT,SRFORM="B" G ^SRSWL2
;;; Sort by Date entered on the List for one specialty, extended.
I "Dd"[SOPT G ^SRSWL4
;
END I $E(IOST)="P" S SRSOUT=1 W @IOF
I $D(ZTQUEUED) K ^TMP("SR",$J) Q:$G(ZTSTOP) S ZTREQ="@" Q
I 'SRSOUT W !!,"Press RETURN to continue " R X:DTIME W @IOF
D ^%ZISC,^SRSKILL
K SRTN
Q
OLD ; check for operations by same specialty
;
S SRTN=0 F S SRTN=$O(^SRF("B",DFN,SRTN)) Q:'SRTN S SROLDDT=$P(^SRF(SRTN,0),"^",9) D CHK
Q
CHK ;
S X1=DT,X2=-30 D C^%DTC I SROLDDT<X Q
;
I $D(^SRF(SRTN,.2)),$P(^(.2),"^",12) S Y=SROLDDT D D^DIQ S SROLD("DATE")=$P(Y,"@"),SROLD=SRTN
Q
SRSWLST ;B'HAM ISC/MAM - PRINT SURGERY WAITING LIST ; 17 OCT 89 7:05 AM
+1 ;;3.0; Surgery ;;24 Jun 93
+2 SET SOPT=""
SET SSOPT=""
SET SRSS=""
+3 NEW DFN
+4 ;
+5 SET RH="Surgery Waiting List Reports"
+1 WRITE !!," A Alphabetical Order by Patient",!," T Tentative Date of Operation",!," D Date Entered on the Waiting List"
+2 ;
+3 SET SRSOUT=0
WRITE !!,"Enter Selection (A,T, or D): "
READ SOPT:DTIME
IF '$TEST!(SOPT["^")!(SOPT="")
SET SRSOUT=1
WRITE @IOF
GOTO END
+4 ;
+5 SET SOPT=$EXTRACT(SOPT)
IF "ATDatd"'[SOPT!(SOPT="")
WRITE !!,"Enter one of the letters, A, T, or D or ^ to exit. ",!!,"Press RETURN to continue "
READ X:DTIME
GOTO MENU
+6 ;
+7 ;
SPEC SET SRSOUT=0
WRITE @IOF,!,"Do you want to print the waiting list for all specialties ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
GOTO END
+1 ;
SORTOP IF "Aa"[SOPT
IF "Yy"[SRYN
WRITE !!,"Do you want this alphabetic list to be sorted by surgical specialty ? YES// "
READ SSOPT:DTIME
IF '$TEST!(SSOPT["^")
SET SRSOUT=1
GOTO END
+1 SET SSOPT=$EXTRACT(SSOPT)
+2 IF SSOPT=""
SET SSOPT="Y"
IF "YyNn"'[SSOPT
WRITE !!,"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 "
READ X:DTIME
GOTO SORTOP
+3 SET SRYN=$EXTRACT(SRYN)
IF SRYN=""
SET SRYN="Y"
IF "YyNn"'[SRYN
WRITE !!,"Enter 'YES' if you want to generate the list for all surgical",!,"specialties, or 'NO' to select a specific specialty.",!!,"Press RETURN to continue "
READ X:DTIME
GOTO SPEC
+4 ;
+5 IF "Nn"[SRYN
WRITE !
KILL DIC
SET DIC=133.8
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Surgical Specialty: "
DO ^DIC
IF Y<0
SET SRSOUT=1
GOTO END
+6 IF "Nn"[SRYN
SET SRSS=+Y
SET SRSNM=$PIECE(Y(0),"^")
SET SRSNM=$PIECE(^SRO(137.45,SRSNM,0),"^")
SET ZTSAVE("SRSNM")=SRSNM
SET ZTSAVE("SRSS")=SRSS
+7 ;
+8 IF "Yy"[SRYN
SET SRSS="ALL"
FORM ; brief or extended
+1 ;
+2 WRITE !!,"Do you want to print the brief form ? YES// "
READ SRYN:DTIME
IF '$TEST!(SRYN["^")
SET SRSOUT=1
GOTO END
+3 ;
+4 SET SRYN=$EXTRACT(SRYN)
IF SRYN=""
SET SRYN="Y"
+5 ;
+6 IF "YyNn"'[SRYN
WRITE !!,"Enter 'NO' if you want to print the extended form of the waiting list",!,"containing demographic information, or 'YES' to print the brief form.",!
GOTO FORM
+7 ;
+8 SET SRFORM=$SELECT("Yy"[SRYN:"B",1:"E")
+9 ;
+10 ;;; Sort by Patient within All Specialties displaying brief form.
+11 IF "Aa"[SOPT
IF SRSS="ALL"
IF "Yy"[SSOPT
IF SRFORM="B"
GOTO ^SRSWL6
+12 ;;; Sort by Patient within All Specialties displaying extended form.
+13 IF "Aa"[SOPT
IF SRSS="ALL"
IF "Yy"[SSOPT
GOTO ^SRSWL7
+14 ;;; Sort by Patient Only, displaying All Specialties, in brief form.
+15 IF "Aa"[SOPT
IF SRSS="ALL"
IF SRFORM="B"
GOTO ^SRSWL8
+16 ;;; Sort by Patient Only, displaying All Specialties, extended form.
+17 IF "Aa"[SOPT
IF SRSS="ALL"
GOTO ^SRSWL9
+18 ;;; Sort by Patient Only, displaying One Specialty, in brief form.
+19 IF "Aa"[SOPT
IF SRSS'="ALL"
IF SRFORM="B"
GOTO ^SRSWL10
+20 ;;; Sort by Patient Only, displaying One Specialty, in extended form.
+21 IF "Aa"[SOPT
IF SRSS'="ALL"
GOTO ^SRSWL11
+22 ;;; Sort by Tentative Date of Operation within All Specialties Brief.
+23 IF "Tt"[SOPT
IF SRSS="ALL"
IF SRFORM="B"
GOTO ^SRSWL12
+24 ;;; Sort by Tentative Date of Operation within All Specialties Extend.
+25 IF "Tt"[SOPT
IF SRSS="ALL"
GOTO ^SRSWL13
+26 ;;; Sort by Tentative Date of Operation for one Specialty, Brief form.
+27 IF "Tt"[SOPT
IF SRFORM="B"
GOTO ^SRSWL14
+28 ;;; Sort by Tentative Date of Operation for one Specialty, Extended.
+29 IF "Tt"[SOPT
GOTO ^SRSWL15
+30 ;;; Sort by Date entered on the List with All specailties,brief form.
+31 IF "Dd"[SOPT
IF SRSS="ALL"
IF SRFORM="B"
GOTO ^SRSWL1
+32 ;;; Sort by Date entered on the List with All specailties, extended.
+33 IF "Dd"[SOPT
IF SRSS="ALL"
GOTO ^SRSWL3
+34 ;;; Sort by Date entered on the List for one specailty, brief form.
+35 IF "Dd"[SOPT
IF SRFORM="B"
GOTO ^SRSWL2
+36 ;;; Sort by Date entered on the List for one specialty, extended.
+37 IF "Dd"[SOPT
GOTO ^SRSWL4
+38 ;
END IF $EXTRACT(IOST)="P"
SET SRSOUT=1
WRITE @IOF
+1 IF $DATA(ZTQUEUED)
KILL ^TMP("SR",$JOB)
IF $GET(ZTSTOP)
QUIT
SET ZTREQ="@"
QUIT
+2 IF 'SRSOUT
WRITE !!,"Press RETURN to continue "
READ X:DTIME
WRITE @IOF
+3 DO ^%ZISC
DO ^SRSKILL
+4 KILL SRTN
+5 QUIT
OLD ; check for operations by same specialty
+1 ;
+2 SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("B",DFN,SRTN))
IF 'SRTN
QUIT
SET SROLDDT=$PIECE(^SRF(SRTN,0),"^",9)
DO CHK
+3 QUIT
CHK ;
+1 SET X1=DT
SET X2=-30
DO C^%DTC
IF SROLDDT<X
QUIT
+2 ;
+3 IF $DATA(^SRF(SRTN,.2))
IF $PIECE(^(.2),"^",12)
SET Y=SROLDDT
DO D^DIQ
SET SROLD("DATE")=$PIECE(Y,"@")
SET SROLD=SRTN
+4 QUIT
