source: WorldVistAEHR/trunk/r/SURGERY-SR/SROERRPO.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1SROERRPO ;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
8DAYS 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
14END W @IOF K ORIFN,ORPCL,SROERR,SRTN D ^SRSKILL
15 Q
16ORD 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
24NON S SRL=$P(^SRF(SRTN,"NON"),"^",2),ORL=$S(SRL:SRL_";SC(",1:"")
25 S ORNP=$P(^SRF(SRTN,"NON"),"^",6)
26 Q
27REMOVE ; 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
33RET W !!,"Press RETURN to continue " R X:DTIME
34 Q
Note: See TracBrowser for help on using the repository browser.