- ECBEN ;BIR/MAM,JPW-New Batch Entry ;12 Feb 96
- ;;2.0; EVENT CAPTURE ;**4,5,10,17,42,54,76**;8 May 96;Build 6
- S ECOUT=0
- LOCA ; get location
- D ^ECL K LOC I '$D(ECL) G END
- UNIT ; get DSS unit
- I $D(^XUSEC("ECALLU",DUZ)) K DIC S DIC=724,DIC("A")="Select DSS Unit: ",DIC(0)="QEAMZ",DIC("S")="I $D(^ECJ(""AP"",ECL,+Y))" D ^DIC K DIC G:Y<0 END S ECD=+Y,ECDN=$P(Y,"^",2),NODE=Y(0) D SETU G:'$D(ECD) UNIT D ^ECBEN1A G CHK
- S (X,CNT)=0 F S X=$O(^VA(200,DUZ,"EC",X)) Q:'X S CNT=CNT+1,UNIT=$P(^VA(200,DUZ,"EC",X,0),"^"),UNIT(CNT)=UNIT_"^"_$P(^ECD(UNIT,0),"^")
- I '$D(UNIT(1)) W !!,"You do not have access to any DSS Units. Contact your Event Capture",!,"Package Coordinator if you are responsible for entering procedures for ",!,"a DSS Unit. ",!!,"Press <RET> to continue " R X:DTIME G END
- I '$D(UNIT(2)) S ECD=+$P(UNIT(1),"^"),ECDN=$P(^ECD(ECD,0),"^"),NODE=$G(^ECD(ECD,0)) D SETU G:'$D(ECD) UNIT D ^ECBEN1A G CHK
- SELU S X=0 W @IOF,!,"DSS Units: ",! F S X=$O(UNIT(X)) Q:'X W !,X_".",?5,$P(UNIT(X),"^",2)
- W !!,"Select Number: " R X:DTIME S:"^"[X ECOUT=1 I '$T!("^"[X) G END
- I '$D(UNIT(X)) W !!,"Select the number that corresponds with the DSS unit for which you would like",!,"to enter procedures.",!!,"Press <RET> to continue " R X:DTIME G SELU
- S ECD=+$P(UNIT(X),"^"),ECDN=$P(UNIT(X),"^",2),NODE=$G(^ECD(ECD,0)) D SETU G:'$D(ECD) UNIT D ^ECBEN1A
- CHK ;check to ask unit again
- I ECOUT=2 D S ECOUT=0 G UNIT
- .K EC4,ECC,ECCN,ECD,ECDDT,ECDT,ECDN,ECM,ECMN,ECO,ECON,ECP,ECPN,ECPROS
- .K ECS,ECSN,ECTWO,ECU,ECU2,ECU3,ECUN,ECUN2,ECUN3,ECUC,ECUC2,ECUC3,ECV
- .K ECYN,ECYNZ,NATN,NODE,SYN,^TMP("ECPRO",$J),ECAO,ECIR,ECSC,ECCPT,ECDX
- .K ECDXN,ECINP,ECVST,ECZEC,ECID,ECPTSTAT,ECMST,ECHNC,ECCV,ECSHAD
- END D ^ECKILL K ^TMP("ECLKUP",$J),^TMP("ECPRO",$J) W @IOF
- Q
- SETU ;set DSS Unit info
- S MSG1=0
- I '$D(NODE) D MSG K ECD,ECDN,NODE S ECOUT=0 Q
- I $P(NODE,"^",8)'=1 S MSG1=3 D MSG K ECD,ECDN,NODE S (ECOUT,MSG1)=0 Q
- I $P(NODE,"^",6) S MSG1=2 D MSG K ECD,ECDN,NODE S (ECOUT,MSG1)=0 Q
- S ECPCE="U~"_$S($P(NODE,"^",14)]"":$P(NODE,"^",14),1:"N")
- I $O(^ECJ("AP",ECL,ECD,""))']"" S MSG1=1 D MSG K ECC,ECCN,ECD,ECDDT,ECDN,ECM,ECMN,ECPCL,ECS,ECSN,ECYN,NODE,^TMP("ECPRO",$J) S (ECOUT,MSG1)=0 Q
- S ECS=+$P(NODE,"^",2),ECM=+$P(NODE,"^",3),ECDDT=$P(NODE,"^",12),ECDDT=$S(ECDDT="T":"NOW",ECDDT="N":"NOW",1:"")
- S ECSN=$S($P($G(^DIC(49,ECS,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN"),ECMN=$S($P($G(^ECC(723,ECM,0)),"^")]"":$P(^(0),"^"),1:"UNKNOWN")
- S ECYNZ=+$P(NODE,"^",11)
- Q
- MSG ;unit msg
- W !!,"The DSS Unit ",ECDN," that you selected within ",ECLN
- W !,$S(MSG1=3:"is not defined for Event Capture use",MSG1=2:"is inactive",MSG1=1:"has no procedures defined",1:"is missing information"),"."
- W " Please select another DSS Unit."
- W !!,"Press <RET> to continue " R X:DTIME
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECBEN 2786 printed Feb 18, 2025@23:23:12 Page 2
- ECBEN ;BIR/MAM,JPW-New Batch Entry ;12 Feb 96
- +1 ;;2.0; EVENT CAPTURE ;**4,5,10,17,42,54,76**;8 May 96;Build 6
- +2 SET ECOUT=0
- LOCA ; get location
- +1 DO ^ECL
- KILL LOC
- IF '$DATA(ECL)
- GOTO END
- UNIT ; get DSS unit
- +1 IF $DATA(^XUSEC("ECALLU",DUZ))
- KILL DIC
- SET DIC=724
- SET DIC("A")="Select DSS Unit: "
- SET DIC(0)="QEAMZ"
- SET DIC("S")="I $D(^ECJ(""AP"",ECL,+Y))"
- DO ^DIC
- KILL DIC
- if Y<0
- GOTO END
- SET ECD=+Y
- SET ECDN=$PIECE(Y,"^",2)
- SET NODE=Y(0)
- DO SETU
- if '$DATA(ECD)
- GOTO UNIT
- DO ^ECBEN1A
- GOTO CHK
- +2 SET (X,CNT)=0
- FOR
- SET X=$ORDER(^VA(200,DUZ,"EC",X))
- if 'X
- QUIT
- SET CNT=CNT+1
- SET UNIT=$PIECE(^VA(200,DUZ,"EC",X,0),"^")
- SET UNIT(CNT)=UNIT_"^"_$PIECE(^ECD(UNIT,0),"^")
- +3 IF '$DATA(UNIT(1))
- WRITE !!,"You do not have access to any DSS Units. Contact your Event Capture",!,"Package Coordinator if you are responsible for entering procedures for ",!,"a DSS Unit. ",!!,"Press <RET> to continue "
- READ X:DTIME
- GOTO END
- +4 IF '$DATA(UNIT(2))
- SET ECD=+$PIECE(UNIT(1),"^")
- SET ECDN=$PIECE(^ECD(ECD,0),"^")
- SET NODE=$GET(^ECD(ECD,0))
- DO SETU
- if '$DATA(ECD)
- GOTO UNIT
- DO ^ECBEN1A
- GOTO CHK
- SELU SET X=0
- WRITE @IOF,!,"DSS Units: ",!
- FOR
- SET X=$ORDER(UNIT(X))
- if 'X
- QUIT
- WRITE !,X_".",?5,$PIECE(UNIT(X),"^",2)
- +1 WRITE !!,"Select Number: "
- READ X:DTIME
- if "^"[X
- SET ECOUT=1
- IF '$TEST!("^"[X)
- GOTO END
- +2 IF '$DATA(UNIT(X))
- WRITE !!,"Select the number that corresponds with the DSS unit for which you would like",!,"to enter procedures.",!!,"Press <RET> to continue "
- READ X:DTIME
- GOTO SELU
- +3 SET ECD=+$PIECE(UNIT(X),"^")
- SET ECDN=$PIECE(UNIT(X),"^",2)
- SET NODE=$GET(^ECD(ECD,0))
- DO SETU
- if '$DATA(ECD)
- GOTO UNIT
- DO ^ECBEN1A
- CHK ;check to ask unit again
- +1 IF ECOUT=2
- Begin DoDot:1
- +2 KILL EC4,ECC,ECCN,ECD,ECDDT,ECDT,ECDN,ECM,ECMN,ECO,ECON,ECP,ECPN,ECPROS
- +3 KILL ECS,ECSN,ECTWO,ECU,ECU2,ECU3,ECUN,ECUN2,ECUN3,ECUC,ECUC2,ECUC3,ECV
- +4 KILL ECYN,ECYNZ,NATN,NODE,SYN,^TMP("ECPRO",$JOB),ECAO,ECIR,ECSC,ECCPT,ECDX
- +5 KILL ECDXN,ECINP,ECVST,ECZEC,ECID,ECPTSTAT,ECMST,ECHNC,ECCV,ECSHAD
- End DoDot:1
- SET ECOUT=0
- GOTO UNIT
- END DO ^ECKILL
- KILL ^TMP("ECLKUP",$JOB),^TMP("ECPRO",$JOB)
- WRITE @IOF
- +1 QUIT
- SETU ;set DSS Unit info
- +1 SET MSG1=0
- +2 IF '$DATA(NODE)
- DO MSG
- KILL ECD,ECDN,NODE
- SET ECOUT=0
- QUIT
- +3 IF $PIECE(NODE,"^",8)'=1
- SET MSG1=3
- DO MSG
- KILL ECD,ECDN,NODE
- SET (ECOUT,MSG1)=0
- QUIT
- +4 IF $PIECE(NODE,"^",6)
- SET MSG1=2
- DO MSG
- KILL ECD,ECDN,NODE
- SET (ECOUT,MSG1)=0
- QUIT
- +5 SET ECPCE="U~"_$SELECT($PIECE(NODE,"^",14)]"":$PIECE(NODE,"^",14),1:"N")
- +6 IF $ORDER(^ECJ("AP",ECL,ECD,""))']""
- SET MSG1=1
- DO MSG
- KILL ECC,ECCN,ECD,ECDDT,ECDN,ECM,ECMN,ECPCL,ECS,ECSN,ECYN,NODE,^TMP("ECPRO",$JOB)
- SET (ECOUT,MSG1)=0
- QUIT
- +7 SET ECS=+$PIECE(NODE,"^",2)
- SET ECM=+$PIECE(NODE,"^",3)
- SET ECDDT=$PIECE(NODE,"^",12)
- SET ECDDT=$SELECT(ECDDT="T":"NOW",ECDDT="N":"NOW",1:"")
- +8 SET ECSN=$SELECT($PIECE($GET(^DIC(49,ECS,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
- SET ECMN=$SELECT($PIECE($GET(^ECC(723,ECM,0)),"^")]"":$PIECE(^(0),"^"),1:"UNKNOWN")
- +9 SET ECYNZ=+$PIECE(NODE,"^",11)
- +10 QUIT
- MSG ;unit msg
- +1 WRITE !!,"The DSS Unit ",ECDN," that you selected within ",ECLN
- +2 WRITE !,$SELECT(MSG1=3:"is not defined for Event Capture use",MSG1=2:"is inactive",MSG1=1:"has no procedures defined",1:"is missing information"),"."
- +3 WRITE " Please select another DSS Unit."
- +4 WRITE !!,"Press <RET> to continue "
- READ X:DTIME
- +5 QUIT