| 1 | SROERRPO ;B'HAM ISC/ADM - ORDER ENTRY ROUTINE ; 8 JULY 1992 10:00 am
|
|---|
| 2 | ;;3.0; Surgery ;;24 Jun 93
|
|---|
| 3 | S SRSOUT=0 W @IOF,!,"Move Surgical Cases into the ORDER file",!!!
|
|---|
| 4 | I '$D(^ORD(100.99)) W "OE/RR package has not been installed." D RET G END
|
|---|
| 5 | W "This option is used to 'back fill' the ORDER file with existing Surgical cases.",!!,"NOTE: Upon the completion of the running of this process, this option will",!,?6,"be deleted from your system."
|
|---|
| 6 | W !! K DIR S DIR("A")="Are you sure you want to continue ",DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) G END
|
|---|
| 7 | I 'Y G END
|
|---|
| 8 | DAYS W !!!,"Add Surgical cases for the last how many days ? " R X:DTIME I '$T!(X["^") G END
|
|---|
| 9 | I X'?1.2N!(X<1)!(X>90) W !!,"Enter a number between 1 and 90, inclusive. This is the number of days in the",!,"past for which Surgical cases should be added to the ORDER file (100) for the",!,"OE/RR package." G DAYS
|
|---|
| 10 | S SRD=X,X="T-"_SRD D ^%DT S SRST=Y D DD^%DT W !!,"Surgical cases since ",Y," will now be added to the ORDER file (100)."
|
|---|
| 11 | S SRDT=SRST-.0001,X=$O(^DIC(19,"B","SR SURGERY REQUEST",0)),SRPCL=X_";DIC(19,",CNT=0
|
|---|
| 12 | F S SRDT=$O(^SRF("AC",SRDT)) Q:'SRDT S SRTN=0 F S SRTN=$O(^SRF("AC",SRDT,SRTN)) Q:'SRTN S SROERR=SRTN,ORPCL=SRPCL D ORD I SRSOUT D RET G END
|
|---|
| 13 | W !,CNT," surgical cases have been added to the ORDER file.",!! D REMOVE
|
|---|
| 14 | END W @IOF K ORIFN,ORPCL,SROERR,SRTN D ^SRSKILL
|
|---|
| 15 | Q
|
|---|
| 16 | ORD I '$D(^SRF(SRTN,0)) K ^SRF(SRTN),^SRF("AC",SRDT,SRTN) Q
|
|---|
| 17 | Q:$P(^SRF(SRTN,0),"^",14) I $P($G(^SRF(SRTN,"NON")),"^")="Y" D NON
|
|---|
| 18 | D STATUS^SROERR0 S SRSOP=$P($G(^SRF(SRTN,"OP")),"^"),ORVP=$P(^(0),"^")_";DPT(" S:'$D(ORNP) ORNP=$P($G(^SRF(SRTN,.1)),"^",4) Q:'ORNP!(SRSOP="")
|
|---|
| 19 | S ORTX=SRSOP_"|>> Case #"_SROERR_" "_SRSTATUS,ORSTRT=SRDT,ORPK=SRTN S:'$D(ORL) ORL=""
|
|---|
| 20 | D FILE^ORX I 'ORIFN W !!,"Unable to add Surgical cases to ORDER file. Please check ORDER PARAMETERS file." S SRSOUT=1 Q
|
|---|
| 21 | K DIE,DA,DR S DA=SRTN,DIE=130,DR="100////"_ORIFN D ^DIE
|
|---|
| 22 | I ORIFN S CNT=CNT+1 W:'(CNT#10) "."
|
|---|
| 23 | Q
|
|---|
| 24 | NON S SRL=$P(^SRF(SRTN,"NON"),"^",2),ORL=$S(SRL:SRL_";SC(",1:"")
|
|---|
| 25 | S ORNP=$P(^SRF(SRTN,"NON"),"^",6)
|
|---|
| 26 | Q
|
|---|
| 27 | REMOVE ; remove option from option file
|
|---|
| 28 | S SRMENU=$O(^DIC(19,"B","SRO PACKAGE MANAGEMENT",0)) I 'SRMENU D RET Q
|
|---|
| 29 | S SROPT=$O(^DIC(19,"B","SROERR BACKFILL",0)) I 'SROPT D RET Q
|
|---|
| 30 | S INT=$O(^DIC(19,SRMENU,10,"B",SROPT,0)) I 'INT D RET Q
|
|---|
| 31 | W !!,"This option will now be removed from your system..."
|
|---|
| 32 | K DA,DIK S DA(1)=SRMENU,DA=INT,DIK="^DIC(19,"_DA(1)_",10," D ^DIK K DA,DIK S DA=SROPT,DIK="^DIC(19," D ^DIK
|
|---|
| 33 | RET W !!,"Press RETURN to continue " R X:DTIME
|
|---|
| 34 | Q
|
|---|
