- 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
- 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