SROERRPO ;B'HAM ISC/ADM - ORDER ENTRY ROUTINE ; 8 JULY 1992 10:00 am
;;3.0; Surgery ;;24 Jun 93
S SRSOUT=0 W @IOF,!,"Move Surgical Cases into the ORDER file",!!!
I '$D(^ORD(100.99)) W "OE/RR package has not been installed." D RET G END
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."
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
I 'Y G END
DAYS W !!!,"Add Surgical cases for the last how many days ? " R X:DTIME I '$T!(X["^") G END
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
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)."
S SRDT=SRST-.0001,X=$O(^DIC(19,"B","SR SURGERY REQUEST",0)),SRPCL=X_";DIC(19,",CNT=0
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
W !,CNT," surgical cases have been added to the ORDER file.",!! D REMOVE
END W @IOF K ORIFN,ORPCL,SROERR,SRTN D ^SRSKILL
Q
ORD I '$D(^SRF(SRTN,0)) K ^SRF(SRTN),^SRF("AC",SRDT,SRTN) Q
Q:$P(^SRF(SRTN,0),"^",14) I $P($G(^SRF(SRTN,"NON")),"^")="Y" D NON
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="")
S ORTX=SRSOP_"|>> Case #"_SROERR_" "_SRSTATUS,ORSTRT=SRDT,ORPK=SRTN S:'$D(ORL) ORL=""
D FILE^ORX I 'ORIFN W !!,"Unable to add Surgical cases to ORDER file. Please check ORDER PARAMETERS file." S SRSOUT=1 Q
K DIE,DA,DR S DA=SRTN,DIE=130,DR="100////"_ORIFN D ^DIE
I ORIFN S CNT=CNT+1 W:'(CNT#10) "."
Q
NON S SRL=$P(^SRF(SRTN,"NON"),"^",2),ORL=$S(SRL:SRL_";SC(",1:"")
S ORNP=$P(^SRF(SRTN,"NON"),"^",6)
Q
REMOVE ; remove option from option file
S SRMENU=$O(^DIC(19,"B","SRO PACKAGE MANAGEMENT",0)) I 'SRMENU D RET Q
S SROPT=$O(^DIC(19,"B","SROERR BACKFILL",0)) I 'SROPT D RET Q
S INT=$O(^DIC(19,SRMENU,10,"B",SROPT,0)) I 'INT D RET Q
W !!,"This option will now be removed from your system..."
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
RET W !!,"Press RETURN to continue " R X:DTIME
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROERRPO 2536 printed Dec 13, 2024@02:43:21 Page 2
SROERRPO ;B'HAM ISC/ADM - ORDER ENTRY ROUTINE ; 8 JULY 1992 10:00 am
+1 ;;3.0; Surgery ;;24 Jun 93
+2 SET SRSOUT=0
WRITE @IOF,!,"Move Surgical Cases into the ORDER file",!!!
+3 IF '$DATA(^ORD(100.99))
WRITE "OE/RR package has not been installed."
DO RET
GOTO END
+4 WRITE "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."
+5 WRITE !!
KILL DIR
SET DIR("A")="Are you sure you want to continue "
SET DIR("B")="NO"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO END
+6 IF 'Y
GOTO END
DAYS WRITE !!!,"Add Surgical cases for the last how many days ? "
READ X:DTIME
IF '$TEST!(X["^")
GOTO END
+1 IF X'?1.2N!(X<1)!(X>90)
WRITE !!,"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."
GOTO DAYS
+2 SET SRD=X
SET X="T-"_SRD
DO ^%DT
SET SRST=Y
DO DD^%DT
WRITE !!,"Surgical cases since ",Y," will now be added to the ORDER file (100)."
+3 SET SRDT=SRST-.0001
SET X=$ORDER(^DIC(19,"B","SR SURGERY REQUEST",0))
SET SRPCL=X_";DIC(19,"
SET CNT=0
+4 FOR
SET SRDT=$ORDER(^SRF("AC",SRDT))
if 'SRDT
QUIT
SET SRTN=0
FOR
SET SRTN=$ORDER(^SRF("AC",SRDT,SRTN))
if 'SRTN
QUIT
SET SROERR=SRTN
SET ORPCL=SRPCL
DO ORD
IF SRSOUT
DO RET
GOTO END
+5 WRITE !,CNT," surgical cases have been added to the ORDER file.",!!
DO REMOVE
END WRITE @IOF
KILL ORIFN,ORPCL,SROERR,SRTN
DO ^SRSKILL
+1 QUIT
ORD IF '$DATA(^SRF(SRTN,0))
KILL ^SRF(SRTN),^SRF("AC",SRDT,SRTN)
QUIT
+1 if $PIECE(^SRF(SRTN,0),"^",14)
QUIT
IF $PIECE($GET(^SRF(SRTN,"NON")),"^")="Y"
DO NON
+2 DO STATUS^SROERR0
SET SRSOP=$PIECE($GET(^SRF(SRTN,"OP")),"^")
SET ORVP=$PIECE(^(0),"^")_";DPT("
if '$DATA(ORNP)
SET ORNP=$PIECE($GET(^SRF(SRTN,.1)),"^",4)
if 'ORNP!(SRSOP="")
QUIT
+3 SET ORTX=SRSOP_"|>> Case #"_SROERR_" "_SRSTATUS
SET ORSTRT=SRDT
SET ORPK=SRTN
if '$DATA(ORL)
SET ORL=""
+4 DO FILE^ORX
IF 'ORIFN
WRITE !!,"Unable to add Surgical cases to ORDER file. Please check ORDER PARAMETERS file."
SET SRSOUT=1
QUIT
+5 KILL DIE,DA,DR
SET DA=SRTN
SET DIE=130
SET DR="100////"_ORIFN
DO ^DIE
+6 IF ORIFN
SET CNT=CNT+1
if '(CNT#10)
WRITE "."
+7 QUIT
NON SET SRL=$PIECE(^SRF(SRTN,"NON"),"^",2)
SET ORL=$SELECT(SRL:SRL_";SC(",1:"")
+1 SET ORNP=$PIECE(^SRF(SRTN,"NON"),"^",6)
+2 QUIT
REMOVE ; remove option from option file
+1 SET SRMENU=$ORDER(^DIC(19,"B","SRO PACKAGE MANAGEMENT",0))
IF 'SRMENU
DO RET
QUIT
+2 SET SROPT=$ORDER(^DIC(19,"B","SROERR BACKFILL",0))
IF 'SROPT
DO RET
QUIT
+3 SET INT=$ORDER(^DIC(19,SRMENU,10,"B",SROPT,0))
IF 'INT
DO RET
QUIT
+4 WRITE !!,"This option will now be removed from your system..."
+5 KILL DA,DIK
SET DA(1)=SRMENU
SET DA=INT
SET DIK="^DIC(19,"_DA(1)_",10,"
DO ^DIK
KILL DA,DIK
SET DA=SROPT
SET DIK="^DIC(19,"
DO ^DIK
RET WRITE !!,"Press RETURN to continue "
READ X:DTIME
+1 QUIT
