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