Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROERRPO

SROERRPO.m

Go to the documentation of this file.
  1. SROERRPO ;B'HAM ISC/ADM - ORDER ENTRY ROUTINE ; 8 JULY 1992 10:00 am
  1. ;;3.0; Surgery ;;24 Jun 93
  1. S SRSOUT=0 W @IOF,!,"Move Surgical Cases into the ORDER file",!!!
  1. I '$D(^ORD(100.99)) W "OE/RR package has not been installed." D RET G END
  1. 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."
  1. 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
  1. I 'Y G END
  1. DAYS W !!!,"Add Surgical cases for the last how many days ? " R X:DTIME I '$T!(X["^") G END
  1. 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
  1. 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)."
  1. S SRDT=SRST-.0001,X=$O(^DIC(19,"B","SR SURGERY REQUEST",0)),SRPCL=X_";DIC(19,",CNT=0
  1. 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
  1. W !,CNT," surgical cases have been added to the ORDER file.",!! D REMOVE
  1. END W @IOF K ORIFN,ORPCL,SROERR,SRTN D ^SRSKILL
  1. Q
  1. ORD I '$D(^SRF(SRTN,0)) K ^SRF(SRTN),^SRF("AC",SRDT,SRTN) Q
  1. Q:$P(^SRF(SRTN,0),"^",14) I $P($G(^SRF(SRTN,"NON")),"^")="Y" D NON
  1. 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="")
  1. S ORTX=SRSOP_"|>> Case #"_SROERR_" "_SRSTATUS,ORSTRT=SRDT,ORPK=SRTN S:'$D(ORL) ORL=""
  1. D FILE^ORX I 'ORIFN W !!,"Unable to add Surgical cases to ORDER file. Please check ORDER PARAMETERS file." S SRSOUT=1 Q
  1. K DIE,DA,DR S DA=SRTN,DIE=130,DR="100////"_ORIFN D ^DIE
  1. I ORIFN S CNT=CNT+1 W:'(CNT#10) "."
  1. Q
  1. NON S SRL=$P(^SRF(SRTN,"NON"),"^",2),ORL=$S(SRL:SRL_";SC(",1:"")
  1. S ORNP=$P(^SRF(SRTN,"NON"),"^",6)
  1. Q
  1. REMOVE ; remove option from option file
  1. S SRMENU=$O(^DIC(19,"B","SRO PACKAGE MANAGEMENT",0)) I 'SRMENU D RET Q
  1. S SROPT=$O(^DIC(19,"B","SROERR BACKFILL",0)) I 'SROPT D RET Q
  1. S INT=$O(^DIC(19,SRMENU,10,"B",SROPT,0)) I 'INT D RET Q
  1. W !!,"This option will now be removed from your system..."
  1. 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
  1. RET W !!,"Press RETURN to continue " R X:DTIME
  1. Q