source: WorldVistAEHR/trunk/r/SURGERY-SR/SRSCHC1.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1SRSCHC1 ;B'HAM ISC/MAM - SCHEDULE CONCURRENT CASES ; [ 04/26/97 3:03 PM ]
2 ;;3.0; Surgery ;**3,67**;24 Jun 93
3 W @IOF,!,"Enter information related to the "_$S(SRSCON=1:"first",1:"second")_" concurrent case.",!
4OPER D ^SROPROC I SRSOUT Q
5 S SRSCON(SRSCON,"OP")=SRSOP
6CPT W ! K SRSCPT,DIC S DIC=81,DIC(0)="QEAM",DIC("A")="Select the Principal Operation Code (CPT): " D ^DIC K DIC I Y>0 S SRSCPT=+Y I $P(^ICPT(+Y,0),"^",4) W !!,"This is an inactive code. Please make another selection.",! G CPT
7SPEC W ! K DIC S DIC=137.45,DIC(0)="QEAMZ",DIC("A")="Select the Surgical Specialty: ",DIC("S")="I '$P(^(0),""^"",3)" D ^DIC I Y<0 D HELP I SRSOUT Q
8 S SRSS=+Y,SRSCON(SRSCON,"SS")=$P(Y(0),"^"),(SRSDOC,SRSCON(SRSCON,"DOC"))=""
9DOC W ! K DIC S DIC=200,DIC(0)="QEAMZ",DIC("A")="Enter the Surgeon's Name: " D ^DIC I $D(DUOUT) S SRSOUT=1 Q
10 I Y<0 S SRSOUT=1 Q
11 S SRSDOC=+Y,SRSCON(SRSCON,"DOC")=$P(Y(0),"^")
12 K DA,DIC,DIE,DO,DD,DINUM,SRTN S X=SRSDFN,DIC="^SRF(",DIC(0)="L",DLAYGO=130 D FILE^DICN K DIC,DLAYGO S (SRTN,SRSCON(SRSCON))=+Y
13 K DIE,DR,DIC S DA=SRTN,DIE=130,DR=".09////"_SRSDATE_";.04////"_SRSS_";.14////"_SRSDOC D ^DIE K DR
14 S DIE=130,DA=SRTN,DR="26////"_SRSOP_";68////"_SRSOP D ^DIE K DR
15 K DR,DA S DR="[SRO-NOCOMP]",DA=SRTN,DIE=130 D ^DIE K DR
16IND W ! S DIE=130,DR="55T" D ^DIE I '$O(^SRF(SRTN,40,0)) D ^SRSIND S:'$D(SRTN) SRSOUT=1 Q:SRSOUT G IND
17 W ! K DR S DR="60T",DIE=130,DA=SRTN D ^DIE
18 W ! K DR,Y S DA=SRTN,DIE=130,DR=".42T",DR(2,130.16)=".01T;1T;3T" W !!,"Other Operative Procedures by the same Surgical Specialty: ",! D ^DIE K DR I $D(Y) S SRSAVG="",SRDUOUT=1 Q
19 I $D(SRSCPT) K DR S DR="27////"_SRSCPT,DIE=130,DA=SRTN D ^DIE K DR
20 S ^SRF(SRTN,8)=SRSITE("DIV") D ^SROXRET
21 I SRSCON=2 S DA=SRTN,DIE=130,DR="35////"_SRSCON(1) D ^DIE S DA=SRSCON(1),DIE=130,DR="35////"_SRSCON(2) D ^DIE K DR
22 D ^SROERR
23 Q
24HELP ; surgical specialty help message
25 W !!,"The Surgical Specialty must be entered when scheduling a surgery case."
26 I SRSCON=1 W !,"If you do not know the surgical specialty, this entry cannot be completed."
27 I SRSCON=2 W !,"Without entering a specialty, this case cannot be scheduled."
28SP W !!,"Do you want to re-enter a Surgical specialty for this procedure ? YES// " R SRYN:DTIME I '$T!(SRYN["^") S SRYN="N"
29 S SRYN=$E(SRYN) S:SRYN="" SRYN="Y"
30 I "YyNn"'[SRYN W !!,"Enter RETURN if you want to enter a specialty and continue entering information,",!,"or 'NO' to delete this case." G SP
31 I "Yy"'[SRYN S SRSOUT=1
32 Q
Note: See TracBrowser for help on using the repository browser.